9 Replies Latest reply on Jul 22, 2015 9:08 AM by Leon Wurr

    Macro Question : To all open documents.

    Matt Jones

      Hey Guys, new to the forum here but have been using solidworks for 7 or 8 years now!

       

      I have written a basic macro to Save As a PDF (into the folder the drawing is in) and then close the document without saving. I was wondering if I can get this macro to run on all open documents from within the macro, ie. I hit the button once and it runs through every open document saving as a pdf and then closing.

       

      Any help would be greatly appreciated! (See my macro details below)

       

       

      ______________________________________________________________________________________________________

       

      Dim swApp As SldWorks.SldWorks

      Dim Part As SldWorks.ModelDoc2

       

      Sub main()

       

      Set swApp = Application.SldWorks

      Set Part = swApp.ActiveDoc

       

      Dim FilePath As String

      Dim Pathsize As Long

      Dim PathNoExtension As String

      Dim NewFilePath As String

       

      FilePath = Part.GetPathName

      Pathsize = Strings.Len(FilePath)

      PathNoExtension = Strings.Left(FilePath, Pathsize - 6)

      NewFilePath = PathNoExtension & "pdf"

       

      Part.SaveAs2 NewFilePath, 0, True, False

       

      swApp.QuitDoc Part.GetTitle 'to disable auto close of doc add ' to start of this line

       

      MsgBox "Saved" & NewFilePath 'to get rid of message box add ' to start of this line

       

       

      End Sub

       

      ____________________________________________________________________________________

        • Re: Macro Question : To all open documents.
          Amirtharaj Vk

          Hi Matt:

           

          I have just modified your code. Try this.

           

          ------------------------------------------------

          Dim swApp As SldWorks.SldWorks
          Dim Part As SldWorks.ModelDoc2

          Sub main()

          Set swApp = Application.SldWorks
          Set Part = swApp.ActiveDoc

          Dim FilePath As String
          Dim Pathsize As Long
          Dim PathNoExtension As String
          Dim NewFilePath As String

          While Not Part Is Nothing
              FilePath = Part.GetPathName
              Pathsize = Strings.Len(FilePath)
              PathNoExtension = Strings.Left(FilePath, Pathsize - 6)
              NewFilePath = PathNoExtension & "pdf"
             
              Part.SaveAs2 NewFilePath, 0, True, False
              swApp.QuitDoc Part.GetTitle 'to disable auto close of doc add ' to start of this line
              Set Part = swApp.ActiveDoc
          Wend
          MsgBox "All documents are successfully saved as PDF!", vbInformation, "PDF Creation"
          'MsgBox "Saved " & NewFilePath 'to get rid of message box add ' to start of this line

          End Sub

           

          ------------------------------------------------

           

          Regards

          V K Amirtharaj

          EGS Computers India Pvt Ltd

          Dassault System SolidWorks Reseller

          Chennai | Tamilnadu | India

          http://www.egsindia.com/solidworks.html

          http://www.egs.co.in

          • Re: Macro Question : To all open documents.
            Leon Wurr

                 You should use something like this to cycle through all opened documents:

             

            swDocs = swApp.GetDocuments
                For i = 0 To UBound(swDocs)
                    Debug.Print swDocs(i).GetTitle
                Next i
            

             

                 And an If statement using ModelDoc2::GetType to check if the document is a drawing.

              • Re: Macro Question : To all open documents.
                Matt Jones

                If I got rid of the messagebox would i insert this in place of that?

                  • Re: Macro Question : To all open documents.
                    Leon Wurr

                    Try this out:

                     

                    Dim swApp As SldWorks.SldWorks
                    Dim Part As SldWorks.ModelDoc2
                     
                    Sub main()
                     
                    Set swApp = Application.SldWorks
                     
                    Dim FilePath As String
                    Dim Pathsize As Long
                    Dim PathNoExtension As String
                    Dim NewFilePath As String
                    
                    swDocs = swApp.GetDocuments  
                         For i = 0 To UBound(swDocs) 
                              Set Part = swDocs(i)
                              If  part.gettype = swDocDRAWING then
                                   FilePath = Part.GetPathName
                                   Pathsize = Strings.Len(FilePath)
                                   PathNoExtension = Strings.Left(FilePath, Pathsize - 6)
                                   NewFilePath = PathNoExtension & "pdf"
                    
                                   Part.SaveAs2 NewFilePath, 0, True, False
                     
                                   swApp.QuitDoc Part.GetTitle 'to disable auto close of doc add ' to start of this line
                     
                                   MsgBox "Saved" & NewFilePath 'to get rid of message box add ' to start of this line
                              End if
                          Next i
                     
                    End Sub
                    
                      • Re: Macro Question : To all open documents.
                        Matt Jones

                        Thanks heaps for that! Works a charm.. One more simple annoying mod is id like to specify a folder instead of sending it to the documents folder (for example id like to send it to  C:\Users\m.jones\Desktop\PDF ) but Id like to keep the option of sending it to the documents folder but have that marked out?? Is this easy to do

                          • Re: Macro Question : To all open documents.
                            Leon Wurr

                            I'm away from my working station so I'm not able to test it, but try the following.

                            Take a look at the line where the folder "C:\Users\m.jones\Desktop\PDF\" is set, you can change that text to set other folders.

                             

                             

                            Dim swApp As SldWorks.SldWorks  
                            Dim Part As SldWorks.ModelDoc2  
                               
                            Sub main()  
                               
                            Set swApp = Application.SldWorks  
                               
                            Dim FilePath As String  
                            Dim Pathsize As Long  
                            Dim PathNoExtension As String  
                            Dim NewFilePath As String
                              
                            swDocs = swApp.GetDocuments    
                                 For i = 0 To UBound(swDocs)   
                                      Set Part = swDocs(i)  
                                      If  part.gettype = swDocDRAWING then  
                            
                            
                                           FilePath = Part.GetPathName  
                                           Pathsize = Strings.Len(FilePath)  
                                           PathNoExtension = Strings.Left(FilePath, Pathsize - 6)  
                                           'NewFilePath = PathNoExtension & "pdf"  'REMOVE THE QUOTE FROM THE START OF THIS LINE IF YOU WANT THE STANDARD BEHAVIOR
                                           'PUT A QUOTE IN FRONT OF THE FOLLOWING LINE AS WELL  AS REMOVING THE QUOTE FROM THE PREVIOUS LINE IF YOU WANT THE STANDARD BEHAVIOR
                                           NewFilePath = "C:\Users\m.jones\Desktop\PDF\" & Strings.Left(Part.GetTitle, Strings.Len(Part.GetTitle) - 6)  &  "pdf"
                            
                                           Part.SaveAs2 NewFilePath, 0, True, False  
                               
                                           swApp.QuitDoc Part.GetTitle 'to disable auto close of doc add ' to start of this line  
                               
                                           MsgBox "Saved" & NewFilePath 'to get rid of message box add ' to start of this line  
                                      End if  
                                  Next i  
                               
                            End Sub
                            
                          • Re: Macro Question : To all open documents.
                            Matt Jones

                            Thanks Leon!!

                             

                            I have merged this macro in with another one of mine so it saves all open as a pdf building the file name from values of the referenced model in the drawing file then closes the document.

                             

                            I deleted a bit of your stuff because it kept hanging up on the           part.gettype = swDocDRAWING then

                             

                            Then giving me the following error.

                             

                            Capture.JPG

                             

                            Since deleting that stuff the macro does what its intended to do but it doesnt end it just crashes out once there are no open drawings anymore.

                             

                            Can you help me fix this so it ends properly?

                             

                            Your help would be greatly appreciated!!! (see macro below)

                             

                            _____________________________________________________________________

                             

                            Dim swApp As SldWorks.SldWorks

                            Dim swModel As SldWorks.ModelDoc2

                            Dim swDraw As SldWorks.DrawingDoc

                            Dim swCustProp As CustomPropertyManager

                            Dim valOut1 As String

                            Dim valOut2 As String

                            Dim resolvedValOut1 As String

                            Dim resolvedValOut2 As String

                            Dim Filepath As String

                            Dim ConfigName As String

                            Dim PartNo As String

                            Dim FullName As String

                            Dim nFileName As String

                             

                             

                            Sub main()

                            Set swApp = Application.SldWorks

                             

                             

                            swDocs = swApp.GetDocuments

                                 For i = 0 To UBound(swDocs)

                                      Set Part = swDocs(i)

                                     

                                        Set swDraw = swApp.ActiveDoc

                                        Set swView = swDraw.GetFirstView

                                        Set swView = swView.GetNextView

                                        Set swModel = swView.ReferencedDocument

                             

                             

                                        If (swModel.GetType = swDocPART) Then

                             

                             

                                            Set swModel = swView.ReferencedDocument

                                            Set swView = swDraw.GetFirstView

                                            Set swView = swView.GetNextView

                                            ConfigName = swView.ReferencedConfiguration

                                            FullName = swModel.GetTitle

                                            PartNo = Left(FullName, Len(FullName) - 7)

                                            'Filepath = "C:\Users\m.jones\Desktop\PDF\"

                             

                             

                                            Set swCustProp = swModel.Extension.CustomPropertyManager(ConfigName)

                                                swCustProp.Get2 "Description", valOut1, resolvedValOut1

                                                swCustProp.Get2 "Revision", valOut2, resolvedValOut2

                                    

                                            nFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & PartNo & "-" & ConfigName & "-" & resolvedValOut2 & " " & resolvedValOut1

                             

                             

                                            swDraw.SaveAs3 nFileName & ".PDF", 0, 0

                               

                                            'MsgBox nFileName & ".PDF" + " Saved as a PDF"

                               

                                            swApp.QuitDoc swDraw.GetPathName

                              

                                        ElseIf (swModel.GetType = swDocASSEMBLY) Then

                             

                             

                                            Set swView = swDraw.GetFirstView

                                            Set swView = swView.GetNextView

                                            Set swModel = swView.ReferencedDocument

                                            ConfigName = swView.ReferencedConfiguration

                                            FullName = swModel.GetTitle

                                            PartNo = Left(FullName, Len(FullName) - 7)

                                            'Filepath = "C:\Users\m.jones\Desktop\PDF\"

                             

                             

                                            Set swCustProp = swModel.Extension.CustomPropertyManager("")

                                                swCustProp.Get2 "Description", valOut1, resolvedValOut1

                                                swCustProp.Get2 "Revision", valOut2, resolvedValOut2

                                 

                                            nFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & PartNo & "-" & resolvedValOut2 & " " & resolvedValOut1

                             

                             

                                            swDraw.SaveAs3 nFileName & ".PDF", 0, 0

                               

                                            'MsgBox nFileName & ".PDF" + " Saved as a PDF"

                               

                               

                                            swApp.QuitDoc swDraw.GetPathName

                                        End If

                             

                             

                             

                             

                                Next i

                             

                             

                             

                             

                             

                             

                            End Sub

                              • Re: Macro Question : To all open documents.
                                Leon Wurr

                                Hello Sir,

                                 

                                     Try this, the lines in blue are already on your code, the one in red is the one that needs to be added.

                                 

                                     ...................

                                     Set Part = swDocs(i)

                                     Set swDraw = swApp.ActiveDoc

                                     If swDraw Is Nothing Then End

                                     Set swView = swDraw.GetFirstView

                                     Set swView = swView.GetNextView

                                     Set swModel = swView.ReferencedDocument

                                     ...................

                                 

                                     This will end the macro once there's no other drawings left to save as .PDF, thus avoiding the error.