I have this bit of code I found and modified.
It will create a .pdf of all the oRefDoc in the current assembly, as well as create a .stp file of the model, but it will also open all the oRefDoc that are set to Reference.
I also need it to skip all the files that are in a sub assembly that is marked Reference.
I think if it would only look at parts only and structured section of the BOM would work.
but it might not get all the sub assemblies that way.
If anyone has a suggestion or some sample code, or even better yet would be a revised code, would be great.
Sub Main()
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from an assembly file.", "WCD Drawing Helps")
Exit Sub
docmodel = ThisDoc.ModelDocument
'docmodel.Rebuild()
End If
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
Dim oOptions As NameValueMap
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
numFiles = 0
Dim Process As String
Dim PDFAddIn As TranslatorAddIn
Dim oContext As TranslationContext
'Dim oOptions As NameValueMap
Dim oDataMedium As DataMedium
Call ConfigurePDFAddinSettings(PDFAddIn, oContext, oOptions, oDataMedium)
Dim oAModelPN As String
oAModelPN = oAsmDoc.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
Dim oFolder As String = "C:\Inventor PDF" 'The target folder for export
If Not System.IO.Directory.Exists(oFolder) Then System.IO.Directory.CreateDirectory(oFolder)
'Define the active document as an assembly file
'Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim oAsmPN As String = oAsmDoc.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
'Get user input
Dim RUsure As DialogResult = MessageBox.Show ("This will save a .pdf of all the Ref drawings, and .stp of all related models" _
& vbLf & " " _
& vbLf & "Are you sure you want to proceed with creating these files?" _
& vbLf & "This could take a while!" _
& vbLf & " " _
& vbLf & "We will let you know when this process is finished!", "WCD Drawing Helps", MessageBoxButtons.YesNo,MessageBoxIcon.Question)
If RUsure <> vbYes Then Exit Sub
numFiles = 0
'Look at the files referenced by the assembly and work the referenced models
For Each oRefDoc In oRefDocs 'As Document In oAsmDoc.AllReferencedDocuments
'On Error Goto NoProp
iLogicVb.UpdateWhenDone = True
Try
'Catch
oProp = oRefDoc.PropertySets("Inventor User Defined Properties").Item("Process").Value
Catch
End Try
If oProp Like "*Laser*" Or oProp Like "*Plasma*" Or oProp Like "*Torch*" Or oProp Like "*Cut*" Or oProp Like "*Water*" Or oProp Like "*Weld*" Or oProp Like "*Assem*" Or oProp Like "*Mach*" Or oProp Like "*Purchas*"
oFolder = ("C:\Inventor PDF\"&"\"& oAModelPN &"\" & oProp &"\")
If Not System.IO.Directory.Exists(oFolder) Then System.IO.Directory.CreateDirectory(oFolder)
If oRefDoc.ComponentDefinition.BOMStructure <> BOMStructureEnum.kNormalBOMStructure Then Continue For
Dim oModelPN As String
oModelPN = oRefDoc.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
oRefDoc.SaveAs(oFolder & "\" & oModelPN & ".stp", True)
dwgPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "dwg"
If System.IO.File.Exists(dwgPathName) Then
numFiles = numFiles + 1
Dim oDrawDoc As DrawingDocument
Dim oSheet As Sheet
oDrawDoc = ThisApplication.Documents.Open(dwgPathName, True)
oDrawDoc.Activate
oDataMedium.FileName = oFolder & "\" & oModelPN & ".pdf"
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
oDrawDoc.Close(True)
'Catch ex As Exception
'MessageBox.Show("Error processing " & oCurFileName & vbNewLine & ex.Message, "ilogic")
'End Try
End If
End If
Next
NoProp:
If Err.Number <> 0 Then
MessageBox.Show("Process iProp does not exist for: " & vbLf & oRefDoc.FullFileName,"WCD Model Helps",MessageBoxButtons.OK,MessageBoxIcon.Warning)
'MsgBox("Process iProp does not exist for: " & vbLf & oRefDoc.FullFileName,"WCD Helps")
Err.Clear
End If
'Show the folder
If numFiles = 0
MessageBox.Show("There are no drawings with " & oProcess & " to create pdf drawings from!", "WCD Model Helps",MessageBoxButtons.OK,MessageBoxIcon.Exclamation)
End If
Exit Sub
MessageBox.Show("Thanks for being efficient!" _
& vbLf & "There are (" & numFiles &") - (" & oProcess & ") files created!", "WCD Model Helps",MessageBoxButtons.OK,MessageBoxIcon.Exclamation)
'Open the folder containing the new files
'Shell("explorer.exe " & oFolder,vbNormalFocus)
End Sub
Sub ConfigurePDFAddinSettings(ByRef PDFAddIn As TranslatorAddIn, ByRef oContext As TranslationContext, ByRef oOptions As NameValueMap, ByRef oDataMedium As DataMedium)
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 2000
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
oOptions.Value("Custom_Begin_Sheet") = 1
oOptions.Value("Custom_End_Sheet") = 1
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
End Sub
