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
SolidworksApi/macros