AnsweredAssumed Answered

Macro for Save As with custom file name and location.

Question asked by Tamas Kozma on Jul 13, 2018
Latest reply on Mar 28, 2019 by Jesper Davidsen

Hi All,


I would like to make a macro for 2 things.

1: I would like to save my drawings into PDF and DWG. This is the easy part, the more complex part that I would like to insert some static characters into the file name and a dynamic part, which should come from one of the custom properties fields of the model shows on the drawings. Like this: Original file name: pn.sldprt or pn.sldasm and pn.slddrw, created files: "pn REV A.pdf" and "pn REV A.dwg". The "A" should come from the "Revision" field of the custom properties of the PART or ASSEMBLY, which is shown on the drawing.

If I using the

  1. 'Get Revision 
  2. Revision = swModel.CustomInfo("Revision")

syntax, it gives me the Revision from the custom properties field of the drawing file, not from the inserted model. Somehow I need to manage to receive this information from the part or assembly file.


2: The other thing is to save these files into a sub-folder. File structure like this:

...(static part)\(dynamic, job-specific part)\Drawings(static obviously)

The SolidWorks files could be in the "Drawings" folder, or anywhere else in sub-folders under the "Drawings". I need to save the pdf and dwg files into the ...(static part)\(dynamic, job-specific part)\Drawings\DWG Folder.

Because of the job-specific, dynamic part, it can't be hard-wired, and because of the possible dynamic structure under the "Drawings" it can't be a "describing path (go up x levels, go into the \DWG". My idea is to investigate the folder path, use everything from the start until the fixed "\Drawings" character string and add the "\DWG" string to the location.


Any ideas?


This is my latest code, I stopped at the revision infor, and not even started the location part... BTW, I'm quite bad in programming...


Option Explicit

    Dim swApp               As SldWorks.SldWorks

    Dim swModel             As SldWorks.ModelDoc2

    Dim swPart              As SldWorks.PartDoc

    Dim swView              As SldWorks.View

    Dim swModelDocExt       As SldWorks.ModelDocExtension

    Dim swExportData        As SldWorks.ExportPdfData

    Dim boolstatus          As Boolean

    Dim filename            As String

    Dim swCi                As String

    Dim rev                 As String

    Dim lErrors             As Long

    Dim lWarnings           As Long



Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swView = swModel.GetFirstView

    Set swCi = swView.ReferencedDocument 'Stops here with "object required...

    If swModel Is Nothing Then

        MsgBox "No current document", vbCritical


    End If

    If swModel.GetType <> swDocDRAWING Then

        MsgBox "This Macro only works on Drawings", vbCritical


    End If

    Set swModelDocExt = swModel.Extension

    Set swExportData = swApp.GetExportFileData(swExportPDFData)

    filename = swModel.GetPathName

    If filename = "" Then

        MsgBox "Please save the file first and try again", vbCritical


    End If


    'Get Revision

    rev = swCi.CustomInfo("Revision")


    'Add revision info and create dwg file

    filename = Strings.Left(filename, Len(filename) - 7) & " REV " & rev & ".dwg"

    boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)


    'Create pdf file

    filename = Strings.Left(filename, Len(filename) - 3) & "PDF"

    boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)

    If boolstatus Then

        MsgBox "Save as DWG and PDF with revision successful" & vbNewLine & filename


        MsgBox "Save as failed, Error code:" & lErrors

    End If

End Sub