9 Replies Latest reply on Feb 11, 2019 4:07 AM by Franz Dahinden

    Export PDF DXF and name Macro

    Oli Sparrow

      Hi all,

       

      I've been using the below macro from Deepak for a little while and have tried to add extra functionality that would make this an indispensable tool for our workflow. 

      I would like to:

      Export .DXF of current active sheet only

      Export .PDF of current active sheet only (currently exports all sheets)

      Allow input of file name to be identical for both (ie. myexport. pdf and myexport.dxf) and for them to be exported to the same directory that the open drawing is saved in.

       

      As a bonus I'd love it to be able to string together 2x custom properties with a dash in between as the export filename ("POC" - "PARTNUMBER".pdf/dxf) so we didn't need to enter it all manually

       

      I've seen all the various components in different macros but have failed to bring them together in one package. Can anyone help? Thanks in advance, and please bear in mind I have very little knowledge of VB.

       

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

      ' Written by: Deepak Gupta (http://gupta9665.com/)

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

      Option Explicit

      Sub main()

      Dim swApp           As SldWorks.SldWorks

      Dim swModel         As SldWorks.ModelDoc2

      Dim swDrawModel     As SldWorks.ModelDoc2

      Dim swDraw          As SldWorks.DrawingDoc

      Dim swView          As SldWorks.View

      Dim nErrors         As Long

      Dim nWarnings       As Long

      Set swApp = Application.SldWorks

      Set swDrawModel = swApp.ActiveDoc

      ' Check to see if a drawing is loaded.

      If swDrawModel Is Nothing Then

              MsgBox "There is no active drawing document"

              Exit Sub

      End If

      If swDrawModel.GetType <> swDocDRAWING Then

              MsgBox "Open a drawing first and then TRY again!"

              Exit Sub

      End If

      Set swDraw = swDrawModel

      Set swView = swDraw.GetFirstView

      Set swView = swView.GetNextView

      Set swModel = swView.ReferencedDocument

      ' Determine if there is any view

      If swModel.GetPathName = "" Then

              MsgBox "Insert a View first and then TRY again!"

              Exit Sub

      End If

      'Save as DXF

      swDraw.SaveAs3 Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1) & ".DXF", 0, 0

      'Save as PDF

      swDraw.SaveAs3 Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1) & ".PDF", 0, 0

      End Sub

        • Re: Export PDF DXF and name Macro
          Deepak Gupta

          Oli Sparrow wrote:

           

          As a bonus I'd love it to be able to string together 2x custom properties with a dash in between as the export filename ("POC" - "PARTNUMBER".pdf/dxf) so we didn't need to enter it all manually

          From where you're pulling the values for these two properties; model (configuration or custom) or drawing?

            • Re: Export PDF DXF and name Macro
              Oli Sparrow

              Hi,

              Sorry allow me to correct myself: the actual custom properties are "PROFILE ORDER CODE" and "PART NUMBER" as spec'd in the property tab builder.

               

              These are both custom properties entered in the .PRT

               

              Thanks

                • Re: Export PDF DXF and name Macro
                  Deepak Gupta

                  Try these codes

                   

                  Option Explicit
                  Dim swApp               As SldWorks.SldWorks
                  Dim swModel             As SldWorks.ModelDoc2
                  Dim swDrawModel         As SldWorks.ModelDoc2
                  Dim swDraw              As SldWorks.DrawingDoc
                  Dim swCustPropMgr       As CustomPropertyManager
                  Dim swView              As SldWorks.View
                  Dim sFileName           As String
                  Dim ValOut              As String
                  Dim ResolvedValOut(1)   As String
                  Dim wasResolved         As Boolean
                  
                  Sub main()
                  
                  Set swApp = Application.SldWorks
                  Set swDrawModel = swApp.ActiveDoc
                  
                  ' Check to see if a drawing is loaded.
                  If swDrawModel Is Nothing Then
                          MsgBox "There is no active drawing document"
                          Exit Sub
                  End If
                  
                  If swDrawModel.GetType <> swDocDRAWING Then
                          MsgBox "Open a drawing first and then TRY again!"
                          Exit Sub
                  End If
                  
                  If swDrawModel.GetPathName = "" Then
                          MsgBox "Save the drawing first and then TRY again!"
                          Exit Sub
                  End If
                  
                  Set swDraw = swDrawModel
                  Set swView = swDraw.GetFirstView
                  Set swView = swView.GetNextView
                  
                  ' Determine if there is any view
                  If swView Is Nothing Then
                          MsgBox "Insert a View first and then TRY again!"
                          Exit Sub
                  End If
                  
                  Set swModel = swView.ReferencedDocument
                  If swModel.GetPathName = ""  Then
                          MsgBox "Insert a View first and then TRY again!"
                          Exit Sub
                  End If
                  
                  Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
                  swCustPropMgr.Get5 "PROFILE ORDER CODE", False, ValOut, ResolvedValOut(0), wasResolved
                  swCustPropMgr.Get5 "PART NUMBER", False, ValOut, ResolvedValOut(1), wasResolved
                  
                  'Set File name
                  sFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, ".") - 1) & "-" & ResolvedValOut(0) & "-" & ResolvedValOut(1)
                  
                  'Save as DXF
                  swDraw.SaveAs3 sFileName & ".DXF", 0, 0
                  
                  'Save as PDF
                  swDraw.SaveAs3 sFileName & ".PDF", 0, 0
                  
                  End Sub
                  
                    • Re: Export PDF DXF and name Macro
                      Oli Sparrow

                      Thanks Deepak, I really appreciate your time.

                      Remaining issues:

                      • The macro still exports all PDF sheets rather than just the active sheet. Is it possible to stop this?
                      • The PART NUMBER and PROFILE ORDER CODE properties are configuration specific. They were not showing up in the export filename to begin with so I created new top level properties of the same name and this worked.  Is it possible for the macro to call on the configuration specific properties?
                        • eg Config1 - Profile Order Code = sw01  Config2 - Profile Order Code = sw02
                      • Current exports are being named the same as the drawing followed by the two custom properties: Is it possible to remove the filename from the start of the string?
                        • eg it is currently exporting as ".slddrw filename"-"PROFILE ORDER CODE"-"PART NUMBER".  Ideally I would just want "PROFILE ORDER CODE"-"PART NUMBER".

                       

                      Cheers

                        • Re: Export PDF DXF and name Macro
                          Deepak Gupta

                          Here are updated codes:

                           

                          Option Explicit
                          Sub main()
                          Dim swApp               As SldWorks.SldWorks
                          Dim swModel             As SldWorks.ModelDoc2
                          Dim swDrawModel         As SldWorks.ModelDoc2
                          Dim swDraw              As SldWorks.DrawingDoc
                          Dim swCustPropMgr       As CustomPropertyManager
                          Dim swView              As SldWorks.View
                          Dim swExportPDFData     As SldWorks.ExportPdfData
                          Dim sFileName           As String
                          Dim ValOut              As String
                          Dim ResolvedValOut(1)   As String
                          Dim wasResolved         As Boolean
                          Dim nErrors             As Long
                          Dim nWarnings           As Long
                          
                          Set swApp = Application.SldWorks
                          Set swDrawModel = swApp.ActiveDoc
                          
                          ' Check to see if a drawing is loaded.
                          If swDrawModel Is Nothing Then
                                  MsgBox "There is no active drawing document"
                                  Exit Sub
                          End If
                          
                          If swDrawModel.GetType <> swDocDRAWING Then
                                  MsgBox "Open a drawing first and then TRY again!"
                                  Exit Sub
                          End If
                          
                          If swDrawModel.GetPathName = "" Then
                                  MsgBox "Save the drawing first and then TRY again!"
                                  Exit Sub
                          End If
                          
                          Set swDraw = swDrawModel
                          Set swView = swDraw.GetFirstView
                          Set swView     = swView.GetNextView
                          
                          ' Determine if there is any view
                          If swView Is Nothing Then
                                  MsgBox "Insert a View first and then TRY again!"
                                  Exit Sub
                          End If
                          
                          Set swModel = swView.ReferencedDocument
                          Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
                          swCustPropMgr.Get5 "PROFILE ORDER CODE", False, ValOut, ResolvedValOut(0), wasResolved
                          swCustPropMgr.Get5 "PART NUMBER", False, ValOut, ResolvedValOut(1), wasResolved
                          
                          'Get and set file name
                          sFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & ResolvedValOut(0) & "-" & ResolvedValOut(1)
                          Set swExportPDFData = swApp.GetExportFileData(1)
                          swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
                          swExportPDFData.ViewPdfAfterSaving = False
                          
                          swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly
                          
                          'Save as DXF
                          swDraw.Extension.SaveAs sFileName & ".DXF", 0, 0, Nothing, nErrors, nWarnings
                          
                          'Save as PDF
                          swDraw.Extension.SaveAs sFileName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings
                          
                          End Sub