- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello forum readers,
I am currently working on a macro that will take an assembly drawing, print a pdf of it and pdf's of all the drawings for the parts within its BOM, and combine those PDF's into one pdf. I have successfully completed everything up to combining the pdf files into one file. I haven't had much experience trying to open and operate other programs within the inventor VBA environment and haven't had much luck in my google searches either. I have found a reference manual for using VBA code with Foxit Phantom, but the example codes have not worked for me (reference manual attached). My code is shown below and everything is fine until after the comment "Combine the files". Any help is appreciated with defining the variables properly and calling the program to combine the files. Thanks!
Sub Redline_Package()
Dim idwpathname As String
Dim pdfpathname As String
Dim newFolderPath As String
Dim combinedFolderPath As String
Dim combinedName As String
Dim oDoc As DrawingDocument
Dim oPrintMgr As PrintManager
Dim oRefDocs As DocumentsEnumerator
Dim oRefDoc As Document
Dim oPrtDoc As PartDocument
Dim numFiles As Integer
'Dim oNumberRefDocs As Integer
Dim oOpenDoc As Document
Set oPrintMgr = ThisApplication.ActiveDocument.PrintManager
Dim oDrgPrintMgr As DrawingPrintManager
Dim filelist As String ' list of open files
Dim FileName As String 'truncated filename
Dim MyTimeEnd, MytimeStart As String
Dim msg As Variant
'initialize variables
filelist = ""
numFiles = 1
' Sets variables based on file type
If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
Set oDoc = ThisApplication.ActiveDocument
Set oRefDocs = oDoc.AllReferencedDocuments
' oNumberRefDocs = oRefDocs.count
'
' 'Subtract one because array numbering starts at 0 instead of 1
' oNumberRefDocs = oNumberRefDocs - 1
Else
msg = MsgBox("Not a valid file.", vbOKOnly, "Invalid")
Exit Sub
End If
On Error Resume Next
' Record list of open files
For Each oOpenDoc In ThisApplication.Documents.VisibleDocuments
filelist = filelist + ThisApplication.Documents.VisibleDocuments.Item(numFiles).FullDocumentName
numFiles = numFiles + 1
Next
'Create new folder path
newFolderPath = "P:\Lean Improvements\VBA Code\New Folder"
'Check if the folder exists, if it does then don't make one
If Dir(folderPath, vbDirectory) = "" Then
'Folder does not exist, so create it
MkDir newFolderPath
End If
'reinitialize variable
'numFiles = -1
''Create array for file names
'Dim nameArray() As Variant
'ReDim nameArray(oNumberRefDocs)
'Loop through assembly and parts and create redline package
For Each oRefDoc In oRefDocs
idwpathname = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "idw"
If fileExists(idwpathname) Then
Set oDoc = ThisApplication.Documents.Open(idwpathname, True)
oDoc.Activate
idwpathname = oDoc.FullDocumentName
idwpathname = Right(idwpathname, Len(idwpathname) - InStrRev(idwpathname, "\"))
idwpathname = Left(idwpathname, Len(idwpathname) - 4)
pdfpathname = newFolderPath & "\" & idwpathname & ".pdf"
'Creating string of filenames for combining later
combinedFolderPath = combinedFolderPath & "|" & pdfpathname
' 'place path name in array
' nameArray(numFiles) = pdfpathname
If fileExists(pdfpathname) Then ' ask if file should be overwritten
If MsgBox("File " & pdfpathname & " exists. Do you want to replace this file?", vbOKCancel, "Overwrite?") = vbCancel Then
' Me.Hide ' hide the form
' Unload Me
Exit Sub ' exit
Else
FileLock = IsFileLocked(pdfpathname)
Do While FileLock = True
a = MsgBox("File " & pdfpathname & " is locked and cannot be replaced. Check that it is not open in another application.", vbRetryCancel)
If a = vbCancel Then
' Me.Hide
' Unload Me
Exit Sub
End If
If IsFileLocked(pdfpathname) = False Then
FileLock = False
Exit Do
Else
FileLock = True
End If
Loop
End If
End If
'Save Copy of Part Drawing As a pdf
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
'Set a reference to the active document (the document to be published).
Set oPDFContext = ThisApplication.TransientObjects.CreateTranslationContext
oPDFContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Set oPDFOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Set oPDFDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDoc, oPDFContext, oPDFOptions) Then
' Options for drawings...
oPDFOptions.Value("All_Color_AS_Black") = 0
oPDFOptions.Value("Remove_Line_Weights") = 0
'oPDFOptions.Value("Vector_Resolution") = 400
oPDFOptions.Value("Sheet_Range") = kPrintAllSheets
'oPDFOptions.Value("Custom_Begin_Sheet") = 2
'oPDFOptions.Value("Custom_End_Sheet") = 4
End If
'Set the destination file name
oPDFDataMedium.FileName = pdfpathname
'Publish document.
Call PDFAddIn.SaveCopyAs(oDoc, oPDFContext, oPDFOptions, oPDFDataMedium)
idwpathname = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "idw"
FileName = Right(idwpathname, Len(idwpathname) - InStrRev(idwpathname, "\"))
If InStr(1, filelist, FileName, 1) = 0 Then ' If file was open at start, do not close it.
oDoc.Close (True) ' close lower level drawings
End If
End If
Next
'Create Combined File Name
combinedName = "Redline Package"
'Combine the files
Dim phCreator As FoxitPhantomPDF.Creator
Set phCreator = CreateObject("FoxitExch.Creator")
Call phCreator.CombineFiles(combinedFolderPath, newFolderPath & "\" & combinedName, COMBINE_ADD_CONTENTS)
End Sub
Solved! Go to Solution.