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
SolidworksApi macros