AnsweredAssumed Answered

Merging Two Macros?

Question asked by Matt Jones on Jul 21, 2015
Latest reply on Jul 21, 2015 by Deepak Gupta

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

Outcomes