6 Replies Latest reply on Aug 1, 2018 11:41 PM by Danniel Sims

    Macro for Save As with custom file name and location.

    Tamas Kozma

      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

          End If

          If swModel.GetType <> swDocDRAWING Then

              MsgBox "This Macro only works on Drawings", vbCritical

              End

          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

          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

          Else

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

          End If

      End Sub

        • Re: Macro for Save As with custom file name and location.
          Nilesh Patel

          Point 1:

           

          IView:: ReferencedDocument returns pointer to IModelDoc2 not string and therefore you are getting an error on line 'Set swCi = swView.ReferencedDocument'.

           

          Have a look at the following thread: Saving a drawing as PDF and DXF in the same directory in a different folder . It will help you getting the revision value.

           

          Point 2:

          I am struggling to understand your second point. You probably need to use some string manipulation functions and File System Object to achieve the result you want.

          • Re: Macro for Save As with custom file name and location.
            Tamas Kozma

            Hi All,

             

            The final, working solution is the one below. Finally, I didn't implement the sub-folder thing, because copying manually gives us a little extra safety to not to overwrite the original file in case to forgat to increase the revision in the custom properties field.

             

            Thank you for the help!

             

            '--------------------------------------------------------------------------------------------------------------------------

            'Macro Created by Nilesh Patel on 14/09/2017, modified by Tamas Kozma on 31/07/2018.

            '--------------------------------------------------------------------------------------------------------------------------

            'Disclamer: The macro is provided as is and should be used as reference only.

            'No claims, support, refund, safety net or warranties are expressed or implied.

            'In no event shall the author be liable for any types of damages whatsoever

            '(including without limitation, damages from the loss of use, data, profits, or business)

            'arising out of the uses of this information, applications, or services.

             

             

            'BACK UP YOUR DATA BEFORE USE & USE AT YOUR OWN RISK!!!

            '--------------------------------------------------------------------------------------------------------------------------

             

             

            Option Explicit

             

             

                Dim swApp               As SldWorks.SldWorks

                Dim swModel             As ModelDoc2

                Dim swViewModel         As ModelDoc2

                Dim swCustPropMgr       As CustomPropertyManager

                Dim swDraw              As DrawingDoc

                Dim swView              As View

                Dim swExpPDFData        As ExportPdfData

                Dim vSheetNames         As Variant

                Dim sDrawName           As String

                Dim sFilePath           As String

                Dim sFileName           As String

                Dim filename            As String

                Dim sValOutDrawRev      As String

                Dim sResValOutDrawRev   As String

                Dim sValOutDrawNo       As String

                Dim sResValOutDrawNo    As String

                Dim lErrors             As Long

                Dim lWarnings           As Long

                Dim bRatval             As Boolean

                Dim bWasRes             As Boolean

            Sub main()

               

                Set swApp = Application.SldWorks

                Set swModel = swApp.ActiveDoc

                Set swExpPDFData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)

               

                'Warning message if no document is open.

                If swModel Is Nothing Then

                    swApp.SendMsgToUser2 "No document open. Open drawing document.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOkCancel

                    Exit Sub

                   

                'Warning message if open document is not an assembl document.

                ElseIf swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then

                    swApp.SendMsgToUser2 "Macro must be run in drawing document.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOkCancel

                    Exit Sub

                End If

               

                'Gets the drawing name even if the drawing document is not saved.

                sDrawName = Left(swModel.GetTitle, InStr(swModel.GetTitle, "-") - 2)

                'Debug.Print sDrawName

               

                'Checks whether the drawing document is saved or not.

                'swModel.GetPathName will return empty string if the drawing document is not saved.

                If swModel.GetPathName = Empty Then

                    swApp.SendMsgToUser2 "Drawing document '" & sDrawName & "' must be saved before running the macro.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOkCancel

                    Exit Sub

                End If

               

                Set swDraw = swModel

                Set swView = swDraw.GetFirstView            'First view will always be 'Sheet Format' view.

                Set swView = swView.GetNextView             'Gets the first view on the active drawing sheet.

               

                'Waring message if active sheet doesn't contain any views.

                If swView Is Nothing Then

                    swApp.SendMsgToUser2 "Active drawing sheet '" & swDraw.GetCurrentSheet.GetName & "' does not contain any drawing view.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

               

                'Loop through views to find out the referenced model document.

                'Once the first referenced model is found, the loop will be terminated.

                'The drawing name is determind by the name of the referenced model in the first drawing view.

                Do While Not swView Is Nothing

                    'Debug.Print swView.Name

                   

                    'Gets the referenced model document.

                    Set swViewModel = swView.ReferencedDocument

                   

                    'Exit the loop once the first model is found.

                    If Not swViewModel Is Nothing Then Exit Do

                         

                    Set swView = swView.GetNextView

                Loop

               

                'Warning message if failed to obtain swViewModel object.

                'This will happen if non of the views contain a referenced model.

                If swViewModel Is Nothing Then

                    swApp.SendMsgToUser2 "Active drawing sheet '" & swDraw.GetCurrentSheet.GetName & "' does not contain a drawing view of a referenced model.", swMessageBoxIcon_e.swMbStop,

             

             

            swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

               

                'Gets the custom property manager of the view model.

                Set swCustPropMgr = swViewModel.Extension.CustomPropertyManager(Empty)

               

                'Gets the resolved value of the specified custom property.

                'Warning message if failed to get the resolved valued of the custom property.

                bRatval = swCustPropMgr.Get5("Revision", False, sValOutDrawRev, sResValOutDrawRev, bWasRes)

                   

                If sResValOutDrawRev = "" Then

                    swApp.SendMsgToUser2 "Error: Failed to get resolved value of the custom property 'Revision' from the view model '" & swViewModel.GetTitle & "'.", swMessageBoxIcon_e.swMbStop,

             

             

            swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

                   

                'Gets the resolved value of the specified custom property.

                'Warning message if failed to get the resolved valued of the custom property.

                'bRatval = swCustPropMgr.Get5("DWG No.", False, sValOutDrawNo, sResValOutDrawNo, bWasRes)

                'If sResValOutDrawNo = "" Then

                    'swApp.SendMsgToUser2 "Error: Failed to get resolved value of the custom property 'DWG No.' from the view model '" & swViewModel.GetTitle & "'.", swMessageBoxIcon_e.swMbStop,

             

             

            swMessageBoxBtn_e.swMbOk

                    'Exit Sub

                'End If

               

                'Get the sheet names.

                vSheetNames = swDraw.GetSheetNames

               

                'Sets export data for PDF. Warning message if failed to set export data.

                '1. Saves all sheets as PDF (one file).

                '2. Does not show the PDF after saving.

                bRatval = swExpPDFData.SetSheets(swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, vSheetNames)

                If bRatval = False Then

                    swApp.SendMsgToUser2 "Error: Failed to sets sheets to export as PDF.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

                swExpPDFData.ViewPdfAfterSaving = False

               

                'Sets the file name of the PDF.

                'sFileName = sResValOutDrawNo & "-" & sResValOutDrawRev & ".PDF"

               

                'Set the file path including PDF file name and extension.

                sFilePath = swModel.GetPathName

                'sFilePath = Left(sFilePath, InStrRev(sFilePath, "\") - 1)

                'sFilePath = Left(sFilePath, InStrRev(sFilePath, "\") - 1) & "\History\" & sFileName

               

                'Get the filename

                filename = swModel.GetPathName

                If filename = "" Then

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

                    End

                End If

                filename = Strings.Left(filename, Len(filename) - 7) & " REV " & sResValOutDrawRev & ".PDF"

               

                'Saved the active drawing as PDF. Warning message if failed to save PDF.

                bRatval = swModel.Extension.SaveAs(filename, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPDFData, lErrors, lWarnings)

                If bRatval = False Then

                    swApp.SendMsgToUser2 "Error: Failed to save PDF :" & sFilePath, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

               

                'Creates the DWG name

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

               

                'Saved the active drawing as DWG. Warning message if failed to save DWG.

                bRatval = swModel.Extension.SaveAs(filename, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPDFData, lErrors, lWarnings)

                If bRatval = False Then

                    swApp.SendMsgToUser2 "Error: Failed to save DWG :" & sFilePath, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk

                    Exit Sub

                End If

               

                'Rebuilds the active drawing.

                'swModel.EditRebuild3

               

                'Saves the active drawing. Warning message if failed.

                'If swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, lErrors, lWarnings) = False Then

                    'swApp.SendMsgToUser2 "Error: Failed to save drawing document'" & sDrawName & "'.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOkCancel

                    'Exit Sub

                'End If

            End Sub

              • Re: Macro for Save As with custom file name and location.
                Danniel Sims

                Tamas,

                 

                You could try using filescriptingobject, chr() and a loop to check for existing revisions.

                This would basically check for each revision until it found one that does not exist.  Then output the REV letter for the next drawing.

                You will have to add a reference to Microsoft Scripting Runtime for it to work in your project.

                You would have to add something for an error catch if you already had a "Z" revision.

                 

                sFilePath = swModel.GetPathName

                Set obj_fso = CreateObject("Scripting.FileSystemObject")

                 

                i = 65 ' A

                 

                Do until i=91   ' 90 = "Z"

                    If obj_fso.fileExists(sFilePath & "\" & sResValOutDrawNo & "-" & Chr(i) & ".PDF")= true then

                          i=i+1

                     Else

                          sResValOutDrawRev = Chr(i)

                          exit do

                     End If

                Loop

                 

                'Sets the file name of the PDF.

                    'sFileName = sResValOutDrawNo & "-" & sResValOutDrawRev & ".PDF"