Hi
Just thought I would upload the version I'm using that works with 2025 for people that come across this. I export my PDFs into a sub folder and always run this rule from the first drawing of the set which contains a drawing register so I've added a bit to name the PDF using the drawing register DWG iProperties for the file name and to also save the mergred PDF in the PDF folder.
AddReference "C:\Users\Public\global references\itextsharp.dll"
AddReference "System.IO"
AddReference "System.Private.Uri"
'This rule requires a itextsharp.dll file to be at the local in line one.
Sub Main()
'set the path of the folder contaiing all of the pdfs
Dim _Path As String = ThisDoc.Path &"\PDF Folder"
'set the name of the new pdf you want to create without the extension
Dim _Name As String = ThisDoc.FileName'
'Set revision
Dim _Rev As String = ThisDoc.Document.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Value
'get the result, it will be either the path of the PDF or FALSE
Dim MakePDF As New MergePDF(_Path, _Name, _Rev)
'get the PDF result
Dim OpenPDF As String = MakePDF.GetPDF
'open on condition to the result
Select Case OpenPDF
Case "FALSE"
MsgBox("No PDF was generated",MessageBoxIcon.Error,"Error")
Case Else
Process.Start(New ProcessStartInfo(OpenPDF) With {.UseShellExecute = True })
End Select
End Sub
Public Class MergePDF
#Region "PRIVATE PROPERTIES"
Private Property _Folder_Path As String = String.Empty
Private Property _PDF_Name As String = Nothing
Private Property _GetPDF As String = String.Empty
#End Region
#Region "FRIEND PROPERTIES THAT YOU CALL BACK"
Friend Property GetPDF As String
Set(value As String)
_GetPDF = value
End Set
Get
Return _GetPDF
End Get
End Property
#End Region
#Region "CONSTRUCTORS"
Public Sub New(ByVal _folderpath As String, ByVal _pdfname As String, ByVal _Rev As String)
'set the pdf Folder path
_Folder_Path = _folderpath
'set the pdf name
_PDF_Name = _pdfname
_PDF_Name =_PDF_Name & "_" & _Rev & "_Set.pdf"
'create the PDF and set the path
_GetPDF = CreatePDF(_Folder_Path)
End Sub
#End Region
#Region "HELPERS"
Private Function CreatePDF(ByVal sFolderPath) As String
Dim bOutputfileAlreadyExists As Boolean = False
Dim sOutFilePath As String = IO.Path.Combine(sFolderPath, _PDF_Name)
'sdet up return for a successful pdf. ret changes to FALSE if any errors occur for qualifying purposes
Dim ret As String = sOutFilePath
If IO.File.Exists(sOutFilePath) Then
Try
IO.File.Delete(sOutFilePath)
Catch ex As Exception
bOutputfileAlreadyExists = True
End Try
End If
Dim iPageCount As Integer = GetPageCount(sFolderPath)
If iPageCount > 0 And bOutputfileAlreadyExists = False Then
Dim oFiles As String() = IO.Directory.GetFiles(sFolderPath)
Dim oPdfDoc As New iTextSharp.text.Document()
Dim oPdfWriter As iTextSharp.text.pdf.PdfWriter = iTextSharp.text.pdf.PdfWriter.GetInstance(oPdfDoc, New IO.FileStream(sOutFilePath, IO.FileMode.Create))
oPdfDoc.Open()
System.Array.Sort(Of String)(oFiles)
For i As Integer = 0 To oFiles.Length - 1
Dim sFromFilePath As String = oFiles(i)
Dim oFileInfo As New IO.FileInfo(sFromFilePath)
Dim sFileType As String = "PDF"
Dim sExt As String = PadExt(oFileInfo.Extension)
Try
AddPdf(sFromFilePath, oPdfDoc, oPdfWriter)
Catch ex As Exception
ret = "FALSE"
End Try
Next
Try
oPdfDoc.Close()
oPdfWriter.Close()
Catch ex As Exception
Try
IO.File.Delete(sOutFilePath)
Catch ex2 As Exception
End Try
End Try
End If
Dim oFolders As String() = IO.Directory.GetDirectories(sFolderPath)
For i As Integer = 0 To oFolders.Length - 1
Dim sChildFolder As String = oFolders(i)
Dim iPos As Integer = sChildFolder.LastIndexOf("\")
Dim sFolderName As String = sChildFolder.Substring(iPos + 1)
CreatePDF(sChildFolder)
Next
Return ret
End Function
Private Sub AddPdf(ByVal sInFilePath As String, ByRef oPdfDoc As iTextSharp.text.Document, ByRef oPdfWriter As iTextSharp.text.pdf.PdfWriter)
Dim oDirectContent As iTextSharp.text.pdf.PdfContentByte = oPdfWriter.DirectContent
Dim oPdfReader As iTextSharp.text.pdf.PdfReader = New iTextSharp.text.pdf.PdfReader(sInFilePath)
Dim iNumberOfPages As Integer = oPdfReader.NumberOfPages
Dim iPage As Integer = 0
Do While (iPage < iNumberOfPages)
iPage += 1
oPdfDoc.SetPageSize(oPdfReader.GetPageSizeWithRotation(iPage))
oPdfDoc.NewPage()
Dim oPdfImportedPage As iTextSharp.text.pdf.PdfImportedPage = oPdfWriter.GetImportedPage(oPdfReader, iPage)
Dim iRotation As Integer = oPdfReader.GetPageRotation(iPage)
If (iRotation = 90) Or (iRotation = 270) Then
oDirectContent.AddTemplate(oPdfImportedPage, 0, -1.0F, 1.0F, 0, 0, oPdfReader.GetPageSizeWithRotation(iPage).Height)
Else
oDirectContent.AddTemplate(oPdfImportedPage, 1.0F, 0, 0, 1.0F, 0, 0)
End If
Loop
End Sub
Private Function PadExt(ByVal s As String) As String
s = UCase(s)
If s.Length > 3 Then
s = s.Substring(1, 3)
End If
Return s
End Function
Private Function GetPageCount(ByVal sFolderPath As String) As Integer
Dim iRet As Integer = 0
Dim oFiles As String() = IO.Directory.GetFiles(sFolderPath)
For i As Integer = 0 To oFiles.Length - 1
Dim sFromFilePath As String = oFiles(i)
Dim oFileInfo As New IO.FileInfo(sFromFilePath)
Dim sFileType As String = "PDF"
Dim sExt As String = PadExt(oFileInfo.Extension)
iRet += 1
Next
Return iRet
End Function
#End Region
End Class
