Hello
We can check the document BOM structure and skip these documents. But, if you override this document setting by right clicking an occurrence in your assembly and set the Reference BOM structure, this is not recognized.
Option Explicit on
Sub Main()
Dim oAsmDoc As Document
oAsmDoc = ThisDoc.Document
Dim oAsmDocName As String = System.IO.Path.GetDirectoryName(oAsmDoc.FullFileName) & "\" & System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName)
If Not (oAsmDoc.DocumentType = kAssemblyDocumentObject Or oAsmDoc.DocumentType = kDrawingDocumentObject) Then
MessageBox.Show("Please run this rule from the assembly or drawing files.", "iLogic")
Exit Sub
End If
'get user input
If MessageBox.Show ( _
"This will create a PDF file for all of the files referenced by this document that have drawings files." _
& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
& vbLf & " " _
& vbLf & "Are you sure you want to create PDF Drawings for all of the referenced documents?" _
& vbLf & "This could take a while.", "iLogic - Batch Output PDFs ",MessageBoxButtons.YesNo) = vbNo Then
Exit Sub
End If
Dim PDFAddIn As TranslatorAddIn
Dim oContext As TranslationContext
Dim oOptions As NameValueMap
Dim oDataMedium As DataMedium
Call ConfigurePDFAddinSettings(PDFAddIn, oContext, oOptions, oDataMedium)
Dim oFolder As String = oAsmDocName & " PDF Files"
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
'- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
Dim oRefColl As New List(Of String)
Dim oRefDoc As Document
For Each oRefdoc In oAsmDoc.ReferencedDocuments
oRefColl.Add(oRefDoc.FullFileName)
Next
Dim oDrawDoc As DrawingDocument
Dim oNoDwgString As String
For Each oRefDoc In oAsmDoc.ReferencedDocuments
If oRefDoc.ComponentDefinition.BOMStructure = BOMStructureEnum.kPhantomBOMStructure Then
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
ProcessPhantomChilds(oRefDoc, oRefColl, PDFAddIn, oContext, oOptions, oDataMedium, oFolder)
End If
ElseIf Not oRefDoc.ComponentDefinition.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
Dim oBaseName As String = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.FullFileName)
Dim oPathAndName As String = System.IO.Path.GetDirectoryName(oRefDoc.FullFileName) & "\" & oBaseName
If(System.IO.File.Exists(oPathAndName & ".dwg")) Then
oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".dwg", False)
oDataMedium.FileName = oFolder & "\" & oBaseName & ".pdf"
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
oDrawDoc.Close
Else
oNoDwgString = oNoDwgString & vbLf & oRefDoc.FullFileName 'dwgPathName
End If
If(System.IO.File.Exists(oPathAndName & ".idw")) Then
oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".idw", False)
oDataMedium.FileName = oFolder & "\" & oBaseName & ".pdf"
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
oDrawDoc.Close
Else
oNoDwgString = oNoDwgString & vbLf & oRefDoc.FullFileName 'idwPathName
End If
End If
Next
'- - - - - - - - - - - - -
'- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
' oBaseName = System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName)
' oPathAndName = System.IO.Path.GetDirectoryName(oAsmDoc.FullFileName) & "\" & oBaseName
' oDataMedium.FileName = oFolder & "\" & oBaseName & ".pdf"
' If oAsmDoc.DocumentType = kAssemblyDocumentObject Then
' oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".dwg", False)
' Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
' oDrawDoc.Close
' ElseIf oAsmDoc.DocumentType = kDrawingDocumentObject Then
' Call PDFAddIn.SaveCopyAs(oAsmDoc, oContext, oOptions, oDataMedium)
' End If
'- - - - - - - - - - - - -
MessageBox.Show("New Files Created in: " & vbLf & oFolder, "iLogic")
MsgBox("Files found without drawings: " & vbLf & oNoDwgString)
Shell("explorer.exe " & oFolder,vbNormalFocus)
End Sub
Private Sub ProcessPhantomChilds(ByVal oAsmDoc As AssemblyDocument, ByVal oRefColl As List(Of String), ByRef PDFAddIn As TranslatorAddIn, ByVal oContext As TranslationContext, ByVal oOptions As NameValueMap, ByRef oDataMedium As DataMedium , ByVal oFolder As String)
Dim oRefDoc As Document
Dim oDrawDoc As DrawingDocument
Dim oNoDwgString As String
For Each oRefDoc In oAsmDoc.ReferencedDocuments
If Not oRefColl.Contains(oRefDoc.FullFileName) Then
If Not oRefDoc.ComponentDefinition.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
' Uncomment these lines if phantom assemblies should be recursive traversed
'If oRefDoc.ComponentDefinition.BOMStructure = BOMStructureEnum.kPhantomBOMStructure Then
' If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
' ProcessPhantomChilds(oRefDoc, oDataMedium, PDFAddIn)
' End If
'Else
Dim oBaseName As String = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.FullFileName)
Dim oPathAndName As String = System.IO.Path.GetDirectoryName(oRefDoc.FullFileName) & "\" & oBaseName
If(System.IO.File.Exists(oPathAndName & ".dwg")) Then
oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".dwg", False)
oDataMedium.FileName = oFolder & "\" & oBaseName & ".pdf"
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
oDrawDoc.Close
Else
oNoDwgString = oNoDwgString & vbLf & oRefDoc.FullFileName' dwgPathName
End If
If(System.IO.File.Exists(oPathAndName & ".idw")) Then
oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".idw", False)
oDataMedium.FileName = oFolder & "\" & oBaseName & ".pdf"
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
oDrawDoc.Close
Else
oNoDwgString = oNoDwgString & vbLf & oRefDoc.FullFileName 'idwPathName
End If
'End if
End If
End If
Next
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") = 1
oOptions.Value("Remove_Line_Weights") = 0
oOptions.Value("Vector_Resolution") = 400
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
R. Krieg
RKW Solutions
www.rkw-solutions.com