Macro Help: Get Independent Sheet Revision as String

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