Plot all related files to PDF from an assembly (no vault).

[binuvarkey]

My attempt to plot all related files form an ".iam" resulted with the following code. If anyone interested in cleaning/updating/modifying please post back here. The code as is working for us. We use an eight digit number for file name. Plotted PDF will have revision added to file name. I am a self taught programmer and I am sure someone from this forum will be able to simplify the code and post back here for others.

Any chance of making an addin or iLogic code for similar functionality?

Private PDFPATH As String

'FOLLOWING CODE USES CODE FROM http://www.mcadforums.com/forums/viewtopic.php?f=15&t=10687
'AND OTHER PLACES INCLUDING INVENTOR HELP.
Public Sub PrintRefFiles() 'BOMQuery()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim ASSYIDW As String
    ASSYIDW = oDoc.FullFileName
    ASSYIDW = Replace(ASSYIDW, Right(ASSYIDW, 4), ".idw")
    If Dir(ASSYIDW) <> "" Then
        'Debug.Print strDisplay
        Dim oDrawDoc As drawingDocument
        Set oDrawDoc = ThisApplication.Documents.Open(ASSYIDW)
        oDrawDoc.Activate
        Debug.Print ThisApplication.ActiveDocument
        SaveAsPDFto
        oDrawDoc.Close True
    End If
    
    'GET 8 DIGIT FILE NAME WITH .IDW. ASSUMES C:\TEMP EXISTS. ELSE CREATE MANUALLY.
    PDFPATH = "C:\TEMP\" & Right(oDoc.FullFileName, 12)
    PDFPATH = Left(PDFPATH, Len(PDFPATH) - 4) 'REMOVES .IDW
    CreateFolder 'CHECKS AND CREATES FOLDER IF NOT EXIST

    Dim FirstLevelOnly As Boolean
    If MsgBox("First level only?", vbYesNo) = vbYes Then
        FirstLevelOnly = True
    Else
        FirstLevelOnly = False
    End If
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.componentDefinition.BOM
    ' Set whether first level only or all levels.
    If FirstLevelOnly Then
        oBOM.StructuredViewFirstLevelOnly = True
    Else
        oBOM.StructuredViewFirstLevelOnly = False
    End If
    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True
    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Structured")
    'Initialize the tab for ItemNumber
    Dim ItemTab As Long
    ItemTab = -3
    Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long)
    ItemTab = ItemTab + 3
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.Count
        ' Get the current row.
        Dim oRow As BOMRow
        Set oRow = oBOMRows.Item(i)
        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As componentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
        
        Dim strDisplay As String
        strDisplay = oRow.ReferencedFileDescriptor.FullFileName
        'Debug.Print strDisplay
        strDisplay = Replace(strDisplay, "\\FTE-DRAFT\drawings$", "H:")
        strDisplay = Left(strDisplay, Len(strDisplay) - 4) & ".idw"
        If Dir(strDisplay) <> "" Then
            'Debug.Print strDisplay
            Dim oDrawDoc As drawingDocument
            Set oDrawDoc = ThisApplication.Documents.Open(strDisplay)
            oDrawDoc.Activate
            Debug.Print ThisApplication.ActiveDocument
            SaveAsPDFto
            oDrawDoc.Close True
        End If
        
        Dim oPartNumProperty As Property
        Dim oDescripProperty As Property
        If TypeOf oCompDef Is VirtualComponentDefinition Then
    
        Else
            If Not oRow.ChildRows Is Nothing Then
                Call QueryBOMRowProperties(oRow.ChildRows, ItemTab)
            End If
        End If
    Next
    ItemTab = ItemTab - 3
End Sub

Private Sub SaveAsPDFto()
  ' Get the PDF translator Add-In.
    Dim oPDFTrans As TranslatorAddIn
    Set oPDFTrans = ThisApplication.ApplicationAddIns.ItemById( _
                            "{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    If oPDFTrans Is Nothing Then
      MsgBox "Could not access PDF translator."
      Exit Sub
    End If
    Dim oDoc As Document
    Dim oFileName As String
    Dim sPath As String
    Set oDoc = ThisApplication.ActiveDocument
    oFileName = oDoc.FullFileName
    Dim oPtDoc As Document
    Set oPtDoc = oDoc.ActiveSheet.DrawingViews(1).ReferencedFile.ReferencedDocument
    'Debug.Print oPtDoc.FullFileName
    'GET THE REVISION NUMBER FROM REFERENCED FILE (NOT IDW REVISION - AS OUR STD)
    Dim oPtSumInfo As PropertySet
    Set oPtSumInfo = oPtDoc.PropertySets.Item("Inventor Summary Information")
    Dim oPtRev As Property
    Set oPtRev = oPtSumInfo.Item("Revision Number")
    sPath = Right(oFileName, 12)
    sPath = Replace(sPath, Right(oFileName, 4), oPtRev.Value & ".pdf") '(oFileName, Right(oFileName, 4), oPtRev.Value & ".pdf")
    sPath = PDFPATH & "\" & sPath '& Right(sPath, 12)
    'Debug.Print spath
    ' Create some objects that are used to pass information to the translator Add-In.
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    If oPDFTrans.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, _
                                              oContext, oOptions) Then
        ' Set to print all sheets.  This can also have the value
        ' kPrintCurrentSheet or kPrintSheetRange. If kPrintSheetRange
        ' is used then you must also use the CustomBeginSheet and
        ' Custom_End_Sheet to define the sheet range.
        oOptions.Value("Sheet_Range") = kPrintAllSheets
        
        ' Other possible options...
        'oOptions.Value("Custom_Begin_Sheet") = 1
        'oOptions.Value("Custom_End_Sheet") = 5
        'oOptions.Value("All_Color_AS_Black") = True
        'oOptions.Value("Remove_Line_Weights") = True
        'oOptions.Value("Vector_Resolution") = 200
        
        ' Define various settings and input to provide the translator.
        oContext.Type = kFileBrowseIOMechanism
        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.filename = sPath  '"C:\temp\test.pdf"
        'MSG = MsgBox("Will add Rev automaticaly (if any)." & vbCrLf & vbCrLf & "PRINTING AS PDF TO:" & vbCrLf & vbCrLf & sPath, vbOKCancel)
        'If MSG = vbOK Then
          ' Call the translator.
          Call oPDFTrans.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
            'Dim r As Long
            'r = ShellExecute(0, "open", oData.filename, 0, 0, 1)
            'If r < 32 Then MsgBox ("Couldn't start your PDF-reader")
        'End If 'MSG = VBOK
    End If
End Sub

Sub CreateFolder()
    Dim fso
    Dim fol As String
    fol = PDFPATH ' "c:\MyFolder" ' change to match the folder path
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fol) Then
        fso.CreateFolder (fol)
    Else
        'MsgBox fol & " already exists!", vbExclamation, "Folder Exists"
    End If
End Sub

[binuvarkey]

After 29 views, no one wants comment?

Come on friends, give me some feedback on the code.

Anyone got a better solution?

Any chance of converting this to an add-in?

Thank you.

[karthur1]

Here is the code that I use.http://forums.autodesk.com/t5/Autodesk-Inventor-Customization/Printing-all-drawings-of-an-assembly-f...

It is the code that was posted by Brendan Henderson.  Looks like it works similar to yours.  I like this one cause it used the system printer.  I use a program called PDF Creator and have it setup to save the pdf as the filename.  Works pretty slick and is pretty fast.