11-14-2024
05:32 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-14-2024
05:32 AM
Issue with PDF Export Macro in Autodesk Inventor for Revision Handling in VBA
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