5 Replies Latest reply on Jul 21, 2015 2:50 AM by Deepak Gupta

    Merging Two Macros?

    Matt Jones

      Hey Guys

       

      So I have written a macro (a combo of what I have learnt in the limited VBA/API time I have been learning this stuff and mixing it with the code you guys have in the forums) that saves a drawing document as a PDF and builds the name out of info from the model referenced in the drawing document.

       

      I also have a different macro that saves all open documents as a PDF just with the filename of the drawing then closes them.

       

      I am trying to merge these two macros together so basically save all open documents as a PDF with the first macro then closes the documents. But I cant get it to work, it either gets stuck in a loop on the one document or it saves all the open documents as the name from the first referenced model.

       

      Does anyone know how to easily do this? I am very keen on learning this stuff but need a push in the right direction due to not being very fluent in VBA!

       

      Here is my first Macro;

       

      ____________________________________________________________________________

       

       

      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

       

      Sub main()

      Set swApp = Application.SldWorks

      Set swDraw = swApp.ActiveDoc

       

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

       

      Exit Sub

      End If

      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\"

       

      If (swModel.GetType = swDocPART) Then

       

          Set swCustProp = swModel.Extension.CustomPropertyManager(ConfigName)

          swCustProp.Get2 "Description", valOut1, resolvedValOut1

          swCustProp.Get2 "Revision", valOut2, resolvedValOut2

       

          swDraw.SaveAs (Filepath + PartNo + "-" + ConfigName + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF")

          MsgBox Filepath + PartNo + "-" + ConfigName + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF" + " Saved as a PDF"

       

      ElseIf (swModel.GetType = swDocASSEMBLY) Then

       

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

          swCustProp.Get2 "Description", valOut1, resolvedValOut1

          swCustProp.Get2 "Revision", valOut2, resolvedValOut2

       

          swDraw.SaveAs (Filepath + PartNo + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF")

          MsgBox Filepath + PartNo + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF" + " Saved as a PDF"

      End If

       

       

      End Sub

       

       

      _______________________________________________________________________________

       

      Here is the second Macro

      _______________________________________________________________________________

       

      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: Merging Two Macros??
          Matt Jones

          This is my attempt at merging the two, where it just loops on the first part. What am I not understanding here?

           

           

           

          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

            

          Sub main()

          Set swApp = Application.SldWorks

          Set swDraw = swApp.ActiveDoc

           

           

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

           

           

          Exit Sub

          End If

          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\"

            

           

           

           

          swDocs = swApp.GetDocuments

           

           

               For i = 0 To UBound(swDocs)

                    Set Part = swDocs(i)

                    If Part.GetType = swDocDRAWING Then

                        

                         If (swModel.GetType = swDocPART) Then

           

           

              Set swCustProp = swModel.Extension.CustomPropertyManager(ConfigName)

              swCustProp.Get2 "Description", valOut1, resolvedValOut1

              swCustProp.Get2 "Revision", valOut2, resolvedValOut2

           

           

              swDraw.SaveAs (Filepath + PartNo + "-" + ConfigName + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF")

              MsgBox Filepath + PartNo + "-" + ConfigName + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF" + " Saved as a PDF"

              swApp.QuitDoc Part.GetTitle

            

          ElseIf (swModel.GetType = swDocASSEMBLY) Then

           

           

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

              swCustProp.Get2 "Description", valOut1, resolvedValOut1

              swCustProp.Get2 "Revision", valOut2, resolvedValOut2

             

              swDraw.SaveAs (Filepath + PartNo + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF")

              MsgBox Filepath + PartNo + "-" + resolvedValOut2 + " " + resolvedValOut1 + ".PDF" + " Saved as a PDF"

              swApp.QuitDoc Part.GetTitle

          End If

           

           

            

           

                    End If

                Next i

            

          End Sub