10 Replies Latest reply on Feb 7, 2018 3:17 PM by Robert H.

    Marco to save pdf/dwg in specific directory

    Robert H.

      Hi all

       

      am looking to get write/modify a macro to save pdf and dwg to a specific directory , expect i can not get the marco to save them in the right folders, i can get them to be saved out on level up  but i can not seam to go down one again to save the PDF/DWG in there respective folders - did try  + "/PDF" + but it doesn't seam to be working

      instead it the macro just adds PDF to the file name , very frustrating, am sure it something simple am missing !!

       

      Thank you

       

      Robert

       

      eg

      Drawing directory

      \430_F12 GLASS SHELVING\CAD FILES\ ( soildworks drawing file)

       

      PDF / DWG directory

       

      430_F12 GLASS SHELVING\PDF

       

      430_F12 GLASS SHELVING\DWG

       

       

      Code:

       

      Dim swApp           As SldWorks.SldWorks

      Dim swModel         As SldWorks.ModelDoc2

      Dim swDraw          As SldWorks.DrawingDoc

      Dim Filepath        As String

      Dim FileName        As String

      Dim Drawingno       As String

      Dim Rev             As String

      Dim Title           As String

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Sub main()

       

       

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

       

       

      ' Check to see if a drawing is loaded.

       

       

      If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

       

       

      swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

       

       

      ' If no model currently loaded, then exit

       

       

       

       

      Exit Sub

       

       

      End If

       

      Set swDraw = swModel

      Set SWmoddoc = swApp.ActiveDoc

       

       

      Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") - 10)

      If Dir(Filepath & "PDF", vbDirectory) = "" Then ' Change Sub folder Name here

      MkDir Filepath + "PDF" ' Change Sub folder Name here

      End If

       

       

      If Dir(Filepath & "DWG", vbDirectory) = "" Then ' Change Sub folder Name here

      MkDir Filepath + "DWG" ' Change Sub folder Name here

      End If

       

       

       

       

       

       

      Drawingno = SWmoddoc.CustomInfo("Drawing No.")

       

       

      Rev = SWmoddoc.CustomInfo("version")

       

       

      Title = SWmoddoc.CustomInfo("Title")

       

       

       

       

       

       

      swDraw.SaveAs (Filepath + Drawingno + "_#" + Rev + "_" + Title + ".PDF")

      swDraw.SaveAs (Filepath + Drawingno + "_#" + Rev + "_" + Title + ".DWG")

       

       

      End Sub

        • Re: Marco to save pdf/dwg in specific directory
          Deepak Gupta

          Replace this line

          Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") - 10)

          with

          Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") )

          • Re: Marco to save pdf/dwg in specific directory
            Robert H.

            this there not some way to grab the parent folder of the drawing or  grab the path and delete every thing up to the last \

             

            \430_F12 GLASS SHELVING\CAD FILES

             

            to reach \430_F12 GLASS SHELVING\

             

             

                • Re: Marco to save pdf/dwg in specific directory
                  Robert H.

                  i could get that to work for me

                   

                  although i have managed to hack something together

                   

                   

                   

                   

                   

                   

                  Dim swApp           As SldWorks.SldWorks

                  Dim swModel         As SldWorks.ModelDoc2

                  Dim swDraw          As SldWorks.DrawingDoc

                  Dim Filepath        As String

                  Dim FileName        As String

                  Dim Drawingno       As String

                  Dim Rev             As String

                  Dim Compileddir     As String

                  Dim Compileddir2     As String

                  Dim Title           As String

                  Dim strFolder       As String

                   

                   

                  Dim boolstatus As Boolean

                  Dim longstatus As Long, longwarnings As Long

                  Sub main()

                   

                   

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                   

                   

                  ' Check to see if a drawing is loaded.

                   

                   

                  If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

                   

                   

                  swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

                   

                   

                  ' If no model currently loaded, then exit

                   

                   

                  Exit Sub

                   

                   

                  End If

                   

                  Set swDraw = swModel

                  Set SWmoddoc = swApp.ActiveDoc

                   

                   

                  Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "CAD FILES") - 1)

                   

                   

                  If Dir(Filepath & "PDF", vbDirectory) = "" Then ' Change Sub folder Name here

                  MkDir Filepath + "PDF" ' Change Sub folder Name here

                  End If

                   

                   

                  If Dir(Filepath & "DWG", vbDirectory) = "" Then ' Change Sub folder Name here

                  MkDir Filepath + "DWG" ' Change Sub folder Name here

                  End If

                   

                   

                  Drawingno = SWmoddoc.CustomInfo("Drawing No.")

                   

                   

                  Rev = SWmoddoc.CustomInfo("version")

                   

                   

                  Title = SWmoddoc.CustomInfo("Title")

                   

                   

                  Compileddir = (Filepath + "PDF\" + Drawingno + "_#" + Rev + "_" + Title)

                  Compileddir2 = (Filepath + "DWG\" + Drawingno + "_#" + Rev + "_" + Title)

                   

                   

                  Dim fso As New Scripting.FileSystemObject

                   

                  If fso.FileExists(Compileddir + ".PDF") Then

                  If fso.FileExists(Compileddir2 + ".DWG") Then

                      MsgBox ("File Already Exists.")

                  End If

                      End

                  End If

                   

                   

                  swDraw.SaveAs (Compileddir + ".PDF")

                  swDraw.SaveAs (Compileddir2 + ".DWG")

                   

                   

                   

                   

                  End Sub

                    • Re: Marco to save pdf/dwg in specific directory
                      Deepak Gupta

                      Glad you got it working.

                        • Re: Marco to save pdf/dwg in specific directory
                          Swapnil Masaye

                          I have the below code to save pdf but the pdf file is saved in same directory and i need a particular path to save the pdf and the pdf file name should be same as that of drawing file which is achieved by below code.But the only thing is bothering me to save in a particulat directory,,

                           

                          Need help

                           

                          Thanks

                           

                           

                           

                          Option Explicit

                            Dim swApp As SldWorks.SldWorks

                            Dim swModel As SldWorks.ModelDoc2

                            Dim swModelDocExt As SldWorks.ModelDocExtension

                            Dim swExportData As SldWorks.ExportPdfData

                            Dim boolstatus As Boolean

                            Dim filename 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 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

                            

                            'Save drawing

                            boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

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

                            If boolstatus Then

                            MsgBox "Save as Drawing successful" & vbNewLine & filename

                            Else

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

                            End If

                            

                            

                            'Save as PDF

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

                            boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

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

                            If boolstatus Then

                            MsgBox "Save as PDF successful" & vbNewLine & filename

                            Else

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

                            End If

                           

                            'Save as DXF

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

                            boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

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

                            If boolstatus Then

                            MsgBox "Save as DXF successful" & vbNewLine & filename

                            Else

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

                            End If

                            

                          End Sub

                        • Re: Marco to save pdf/dwg in specific directory
                          Josh Brady

                          Something else to consider:

                          Don't use "+" to combine (concatenate) two strings.  Use "&", which is the VBA concatenation operator.