Hi,
I'm working on a simple macro to save the active drawing sheet as pdf. I currently have it set to save using the sheet name as the file name. However, I would like to append the active sheet revision to the file name.
For example:
sheet name - '12345-01 DRAWING SHEET 1'
independent sheet revision - 'Z'
current file name - '12345-01 DRAWING SHEET 1.PDF'
target file name - '12345-01 DRAWING SHEET 1 revZ.PDF'
Here's my current file:
' ******************************************************************************
' C:\Users\pdailey\AppData\Local\Temp\swx2040\Macro1.swb - macro recorded on 04/22/19 by pdailey
' ******************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
' Dim swCustProp As SldWorks.CustomPropertyManager
Dim swDrawing As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swSheetVar As Variant
' Dim swRevTable As SldWorks.RevisionTableAnnotation
' Dim swSheetRev As String
' Dim resolvedValOut As String
' Dim revTag As String
Dim swExportData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim filePath As String
Dim lErrors As Long
Dim lWarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No current document", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "This macro only works on SW Drawings", vbCritical
End
End If
Set swDrawing = swModel
Set swSheet = swDrawing.GetCurrentSheet
Set swSheetVar = swSheet
Set swModelDocExt = swModel.Extension
Set swExportData = swApp.GetExportFileData(swExportPdfData)
filePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
filePath = filePath & swSheet.GetName
' Get Revision Attempt 1
' returns 'A' when no sheets have revision 'A'
' swSheetRev = swSheet.RevisionTable.CurrentRevision
' Get Revision Attempt 2
' Set swCustProp = swModelDocExt.CustomPropertyManager("")
' boolstatus = swCustProp.Get4("Revision", False, revTag, resolvedValOut)
' filePath = filePath & " rev" & swModel.CustomInfo("Revision")
If filePath = "" Then
MsgBox "Please save the file first & try again", vbCritical
End
End If
'Save drawing
' ***********************************************************************************
' boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
' boolstatus = swModelDocExt.SaveAs(filePath, 0, 0, swExportData, lErrors, lWarnings)
' If boolstatus Then
' MsgBox "Drawing save successful" & vbNewLine & filePath
' Else
' MsgBox "Drawing save failed, Error code:" & lErrors
' End If
' ***********************************************************************************
'Save as PDF
' ***********************************************************************************
' disabled save all sheets
' boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
boolstatus = swExportData.SetSheets(swExportData_ExportSpecifiedSheets, swSheetVar)
boolstatus = swModelDocExt.SaveAs(filePath & ".PDF", 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
MsgBox "Save as PDF successful" & vbNewLine & filePath
Else
MsgBox "Save as PDF failed, Error code:" & lErrors
End If
' ***********************************************************************************
'Save as DXF
' ***********************************************************************************
' boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
' boolstatus = swModelDocExt.SaveAs(filePath & ".DXF", 0, 0, swExportData, lErrors, lWarnings)
' If boolstatus Then
' MsgBox "Save as DXF successful" & vbNewLine & filePath
' Else
' MsgBox "Save as DXF failed, Error code:" & lErrors
' End If
' ***********************************************************************************
End Sub
Hello Patrick Dailey,
Form Where you getting the sheet Revision ? i
Please refer following Code(i have modified your code) ,i have tested and it worked for me. you need to Rev Custome property in Sheet then use the code.
Precondition:-
Sheet Having Custome property as Rev
Postcondition:-
Pdf with rev saved.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swDrawing As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swSheetVar As Variant
Dim swExportData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim filePath As String
Dim lErrors As Long
Dim lWarnings As Long
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim names As Variant
Dim name As Variant
Dim textexp As String
Dim evalval As String
Dim RevNo As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
names = swCustPropMgr.GetNames
For Each name In names
swCustPropMgr.Get2 name, textexp, evalval
If name = "Rev" Then
RevNo = evalval
' MsgBox RevNo
End If
Next name
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No current document", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "This macro only works on SW Drawings", vbCritical
End
End If
Set swDrawing = swModel
Set swSheet = swDrawing.GetCurrentSheet
Set swSheetVar = swSheet
Set swModelDocExt = swModel.Extension
Set swExportData = swApp.GetExportFileData(swExportPdfData)
filePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
filePath = filePath & swSheet.GetName
If filePath = "" Then
MsgBox "Please save the file first & try again", vbCritical
End
End If
boolstatus = swExportData.SetSheets(swExportData_ExportSpecifiedSheets, swSheetVar)
boolstatus = swModelDocExt.SaveAs(filePath & "rev" & RevNo & ".PDF", 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
MsgBox "Save as PDF successful" & vbNewLine & filePath
Else
MsgBox "Save as PDF failed, Error code:" & lErrors
End If
' ***********************************************************************************
'Save as DXF
' **********************************************************************************
' boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
' boolstatus = swModelDocExt.SaveAs(filePath & ".DXF", 0, 0, swExportData, lErrors, lWarnings)
' If boolstatus Then
' MsgBox "Save as DXF successful" & vbNewLine & filePath
' Else
' MsgBox "Save as DXF failed, Error code:" & lErrors
' End If
' ***********************************************************************************
End Sub
Thank You