Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
in reply to: ThomasB44

Hi @ThomasB44

 

Thank you very much :slightly_smiling_face:

 

it work fine !!!

 

here is the modified code that works for me

 

 

 

 

Sub Main()
    Dim oAsmDoc As AssemblyDocument
    oAsmDoc = ThisApplication.ActiveDocument
    oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
    
    'check that the active document is an assembly file
    If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
        MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
        Exit Sub
    End If
    
    'get user input
    If MessageBox.Show ( _
        "This will create a PDF file for all of the asembly components 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 assembly components?" _
        & 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)
    
    oPath = ThisDoc.Path
    oFolder = oPath & "\" & oAsmName & " PDF Files"
    
    If Not System.IO.Directory.Exists(oFolder) Then
        System.IO.Directory.CreateDirectory(oFolder)
    End If
    
    '- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -'look at the files referenced by the assembly
    Dim oRefDoc As Document
    
'    For Each oRefDoc In oRefDocs = oAsmDoc.AllReferencedDocuments
    For Each oRefDoc In oAsmDoc.AllReferencedDocuments
        idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentNaMe) - 3) & "idw"

        If(System.IO.File.Exists(idwPathName)) Then
            Dim oDrawDoc As DrawingDocument
            oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
            oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) -3)

            On Error Resume Next
                oDataMedium.FileName = oFolder & "\" & oFileName & "pdf"
                Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
                oDrawDoc.Close
            On Error Goto 0
        End If
    Next
    '- - - - - - - - - - - - -
    
    '- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
    Dim oAsmDrawingDoc As DrawingDocument
    oAsmDrawingDocName = ThisDoc.PathAndFileName(False) & ".idw"
    
    If(System.IO.File.Exists(oAsmDrawingDocName)) Then
    oAsmDrawingDoc = ThisApplication.Documents.Open(ThisDoc.ChangeExtension(".idw"), True)
    oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawingDocName, True) 
    oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName) -3) 
    
    On Error Resume Next 
        oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & "pdf" 
        Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
        oAsmDrawingDoc.Close 
    End If 

End Sub

Sub ConfigurePDFAddinSettings(ByRef PDFAddIn As TranslatorAddIn, ByRef oContext As TranslationContext, ByRef oOptions As NameValueMap, ByRef oDataMedium As DataMedium)

    oPath = ThisDoc.Path
    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