【宏】多页工程图分页保存PDF - iCAx开思网

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim part As SldWorks.ModelDoc2
Dim swSheet As SldWorks.Sheet
Dim vSheetNames As Variant
Dim swExportPDFData As SldWorks.ExportPdfData
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim SheetCount As Integer
Dim boolstatus As Boolean
Dim i As Long
Dim Foldname As String
Dim PDFname As String
Dim lErrors As Long
Dim lWarnings As Long
Dim AllSheetName
Dim SheetProperty
Sub main()
Foldname = "C:\test"
'指定PDF保存目录手动改写
Set swApp = Application.SldWorks
swApp.Visible = True
Set part = swApp.ActiveDoc
Set swModelDocExt = part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
SheetCount = part.GetSheetCount
AllSheetName = part.GetSheetNames
For i = 0 To SheetCount - 1
part.ActivateSheet (AllSheetName(i))
Set swSheet = part.GetCurrentSheet
SheetProperty = swSheet.GetProperties
PDFname = Foldname & AllSheetName(i) & ".pdf"
vSheetNames = AllSheetName
boolstatus = swExportPDFData.SetSheets(swExportData_ExportCurrentSheet, vSheetNames)
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(PDFname, 0, 0, swExportPDFData, lErrors, lWarnings)
Next i
End Sub

复制代码