AnsweredAssumed Answered

Macro Help: Get Independent Sheet Revision as String

Question asked by Patrick Dailey on Apr 23, 2019
Latest reply on Apr 24, 2019 by Josh Brady

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

Outcomes