9 Replies Latest reply on May 28, 2016 5:35 AM by Deepak Gupta

    Save as PDF with Revision macro

    Joe Tharion

      Hi,

       

      I'm trying to modify an existing Macro (by Matt Lorono) that was posted in Eng-Tips, but I am have trouble getting it to work.

      If I run the macro it stops at the line:

      MBpdf = Model.SaveAs4(MyPathPDF & "\" & NewNamePDF, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

       

      But in VBA editor program, if I stop (press Reset) the macro and click on the line:

      MyPathPDF = "C:\Export" and then click "Continue" the macro works as intended.

      I cant figure out why it wont work unless I run it from within the VBA editor

       

      Below is the code that I am using,

       

      Any help would be appreciated,

       

      cheers,

       

      Joe

       

      --

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

      ' Save Drawing as PDF and DXF

      ' SaveDwgAsPDF.swp - Original functional code by Lee Bell on 02/10/02.

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

      ' Description:

      ' Saves the active drawing or current view of a model or assembly as a PDF and DXF to a specified directory.

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

      ' Version - By Matthew Lorono, Copyright 2006

      '           1.00         * Created Macro from various sources at the above

      '                          website.

      '                        * Added error handling for no docs loaded.

      '                        * Modified error handling for failed save.

      '                        * Added/modified comments.

      '                        * Cleaned up user interface.

      '           1.10         * Add nondrawing support

      '                        * Add error handling for missing directory

      '           1.20         * Add error handling for missing document path

      '                        * Add user input/confirmation of save folder

      '           1.21         * Expand header to prohibit money based distribution

      '                          (such as for-profit or fee based) of this macro.

      '           1.22         * Add save status to lower left status bar pane; some

      '                          clean up; add detail to description.

      '           1.23         * Added DXF functionality.

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

      Option Explicit

       

       

      Dim SwApp As SldWorks.SldWorks

      Dim Model As SldWorks.ModelDoc2

      Dim swModelDocExt       As SldWorks.ModelDocExtension

      Dim swExportPDFData As SldWorks.ExportPdfData

      Dim MyPathPDF, MyPathDWG, ModName, NewNamePDF, NewNameDWG As String

      Dim Rev As String

      Dim dPathName As String

      Dim fso As Object

      Dim MBpdf, MBdwg As Boolean

      Dim Errs As Long

      Dim Warnings As Long

      Dim swFrame As SldWorks.Frame

      Dim Sheet1, FlatPatternSheet As String

      Dim strSheetName(4)     As String

      Dim varSheetName        As Variant

      Dim i                   As Long

       

       

      Sub main()

       

        Set SwApp = Application.SldWorks

        'SwApp.Visible = True

        Set Model = SwApp.ActiveDoc

        Set swFrame = SwApp.Frame

        Set swModelDocExt = Model.Extension

        Set swExportPDFData = SwApp.GetExportFileData(1)

       

       

      ' Error handler for no document loaded

        If Model Is Nothing Then MsgBox "No document loaded!", vbCritical: End

       

      ' Use one of the three following options for PDF save location

      ' Comment out the options with are not used.

       

       

      ' Option 1: Use the current directory

      '  MyPath = CurDir

       

       

      ' Option 2: Specify the directory you want to use

      MyPathPDF = "C:\Export"

      MyPathDWG = "C:\Export"

       

       

      ' Option 3: Use the drawing folder

        'MyPathPDF = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)

        'MyPathDWG = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)

       

      ' Call correct sub

      ' If Model.GetType <> 3 Then Call notdrawing

        If Model.GetType <> 3 Then MsgBox ("This only works for drawings"), vbCritical: End

        Call ifdrawing

       

       

      End Sub

       

       

      Sub notdrawing()

       

       

      MsgBox ("This only works for drawings"), vbCritical: End

       

       

      End Sub

       

       

      Sub ifdrawing()

       

       

      ' Set PDF file name

        Rev = Model.CustomInfo("Revision")

        Sheet1 = Model.ActivateSheet("Sheet1")

        ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3) + "Rev" + Rev

       

        Call alldoc

       

      End Sub

       

       

      Sub alldoc()

       

       

      ' See PDF and DXF file name with extention .pdf or .dwg

        NewNamePDF = ModName & ".pdf"

       

      ' PDF Creation

      ' MBpdf = swExportPDFData.SetSheets(swExportData_ExportAllSheets, varSheetName)

      ' MBpdf = swModelDocExt.SaveAs(MyPathPDF & "\" & NewNamePDF, 0, 0, swExportPDFData, Errs, Warnings)

       

      MBpdf = Model.SaveAs4(MyPathPDF & "\" & NewNamePDF, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

       

      ' DWG Creation

      'varSheetName = Model.GetSheetNames

       

       

          'For i = 0 To UBound(varSheetName)

       

       

              'MBdwg = Model.ActivateSheet(varSheetName(i))

              'NewNameDWG = ModName & "_" & varSheetName(i) & ".dwg"

              'MBdwg = Model.SaveAs4(MyPathDWG & "\" & NewNameDWG, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)

       

       

              'Debug.Assert MBdwg

       

       

          'Next i

       

       

          ' Switch back to first sheet

       

       

          'MBdwg = Model.ActivateSheet(varSheetName(0))

      Call last

      End Sub

      Sub last()

       

       

        swFrame.SetStatusBarText "Done"

       

      ' Clear immediate values

        Set Model = Nothing

        Set MyPathPDF = Nothing

        'Set MyPathDWG = Nothing

        Set swFrame = Nothing

        Set fso = Nothing

       

       

       

      End Sub