Message 1 of 4
Issue with PDF Export Macro in Autodesk Inventor for Revision Handling in VBA
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
This PDF export macro for Autodesk Inventor, created using Visual Basic for Applications (VBA), functions correctly by referencing the properties of linked documents. For revisions with a value of 0, the macro performs as expected. However, for revisions with a value of 1, the macro initially fails to work as intended, but functions correctly on the second attempt. This issue persists across other revision values as well. I am getting the values from part or assembly which ever is inserted in the drawing sheet.
Private Function ExportPDF(oDoc As Document) As String
' Create PDF filename and path
Dim basePath As String
Dim pdfPath As String
pdfPath = "C:\INV\Macros\"
Dim pdfAddin As TranslatorAddIn
Dim oContext As TranslationContext
Dim oOptions As NameValueMap
Dim oDataMedium As DataMedium
Set pdfAddin = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
If pdfAddin.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
' Default options
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 0
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = kPrintAllSheets
End If
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
Dim pdfFileName As String
' Remove .dwg or .idw from the filename
Dim baseFileName As String
baseFileName = Left(oDoc.DisplayName, InStrRev(oDoc.DisplayName, ".") - 1)
' Get the description property
Dim Description As String
Description = GetDescription(oDoc)
' Get the Revision Number property
Dim RevisionNumber As String
RevisionNumber = GetRevisionNumber(oDoc)
' Get the Part Number property
Dim PartNumber As String
PartNumber = GetPartNumber(oDoc)
pdfFileName = PartNumber & "_" & RevisionNumber & "_" & Description & ".pdf"
oDataMedium.filename = pdfPath & pdfFileName
On Error Resume Next
Call pdfAddin.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
ExportPDF = pdfFileName
If Err.Number <> 0 Then
MsgBox "Error exporting PDF: " & Err.Description, vbExclamation
Else
'MsgBox "PDF exported successfully!", vbInformation
End If
On Error GoTo 0
End Function
Private Function GetDescription(drawingDoc As Document) As String
On Error Resume Next
If Not TypeOf drawingDoc Is DrawingDocument Then
GetDescription = "NoDescription"
Exit Function
End If
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = drawingDoc
' Get the referenced document
Dim referencedDoc As Document
Set referencedDoc = oDrawDoc.ReferencedDocuments.Item(1)
If Not referencedDoc Is Nothing Then
' Try to get description from Design Tracking Properties
Dim propSet As PropertySet
Set propSet = referencedDoc.PropertySets("Design Tracking Properties")
If Not propSet Is Nothing Then
GetDescription = CStr(propSet.Item("Description").Value)
If Err.Number = 0 And Len(Trim(GetDescription)) > 0 Then
Exit Function
End If
End If
' If not found, try Summary Information
Err.Clear
Set propSet = referencedDoc.PropertySets("Inventor Summary Information")
If Not propSet Is Nothing Then
GetDescription = CStr(propSet.Item("Title").Value)
If Err.Number = 0 And Len(Trim(GetDescription)) > 0 Then
Exit Function
End If
End If
End If
GetDescription = "NoDescription"
On Error GoTo 0
End Function
Private Function GetRevisionNumber(drawingDoc As Document) As String
On Error Resume Next
If Not TypeOf drawingDoc Is DrawingDocument Then
GetRevisionNumber = "0"
Exit Function
End If
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = drawingDoc
' Try to get the referenced document directly
Dim referencedDoc As Document
Set referencedDoc = oDrawDoc.ReferencedDocuments.Item(1)
If Not referencedDoc Is Nothing Then
Err.Clear
' Get the PropertySet - now using "Inventor Summary Information"
Dim propSet As PropertySet
Set propSet = referencedDoc.PropertySets("Inventor Summary Information")
If Not propSet Is Nothing Then
Dim revValue As String
revValue = CStr(propSet.Item("Revision Number").Value)
If Err.Number = 0 And Len(Trim(revValue)) > 0 Then
GetRevisionNumber = revValue
Exit Function
End If
End If
End If
GetRevisionNumber = "0"
On Error GoTo 0
End Function
Private Function GetPartNumber(drawingDoc As Document) As String
On Error Resume Next
If Not TypeOf drawingDoc Is DrawingDocument Then
GetPartNumber = "NoPartNumber"
Exit Function
End If
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = drawingDoc
' Get the referenced document
Dim referencedDoc As Document
Set referencedDoc = oDrawDoc.ReferencedDocuments.Item(1)
If Not referencedDoc Is Nothing Then
' First try Design Tracking Properties
Dim propSet As PropertySet
Set propSet = referencedDoc.PropertySets("Design Tracking Properties")
If Not propSet Is Nothing Then
GetPartNumber = CStr(propSet.Item("Part Number").Value)
If Err.Number = 0 And Len(Trim(GetPartNumber)) > 0 Then
Exit Function
End If
End If
' If not found, try Summary Information
Err.Clear
Set propSet = referencedDoc.PropertySets("Inventor Summary Information")
If Not propSet Is Nothing Then
GetPartNumber = CStr(propSet.Item("Part Number").Value)
If Err.Number = 0 And Len(Trim(GetPartNumber)) > 0 Then
Exit Function
End If
End If
End If
GetPartNumber = "NoPartNumber"
On Error GoTo 0
End Function
@WCrihfield, @jnowel , @Michael.Navara , @Curtis_Waguespack , @Andrii_Humeniuk , @JelteDeJong , @J-Camper , @A.Acheson , @bradeneuropeArthur
