Hello all,
I am getting an error in my code that I can't seem to figure why. I will run the macro successfully once or twice (sometimes 3 or 4 times) and then when I try and run it again, I get an error, usually on the same line, but sometimes on a different line (but usually the lines are performing similar tasks).
The error, when I debug the program, occurs on line 103 (sometimes different lines that contain similar code). I notice that when I run the program, the filename string is empty (looks as "" when I mouse over it). I can't see why it would be empty as the program doesn't even open up a folder browser dialogue.
Any help in figuring this out with me would be much appreciated!
SolidworksApi macrosOption Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim status As Boolean
Dim filename As String
Dim swDraw As SldWorks.ModelDoc2
Dim swCustProp As SldWorks.CustomPropertyManager
Dim swView As SldWorks.View
Dim ValOut As String
Dim Path As String
Dim PDFpath As String
Dim DXFpath As String
Dim IGSpath As String
Dim DWGpath As String
Dim Rev As String
Dim nErrors As Long
Dim nWarnings As Long
Dim swExportPDFData As SldWorks.ExportPdfData
Sub main()
On Error GoTo ErrCatcher
Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView 'this is the sheet view
Set swView = swView.GetNextView 'this is the next view (view 1 or not I am not sure need to test)
Set swModel = swView.ReferencedDocument
Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
'swExportPDFData.ViewPdfAfterSaving = False
If swModel Is Nothing Then
MsgBox "Open a file first"
Exit Sub
End If
Dim contFolder As String
contFolder = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\\") - 1)
'Opens folder browser dialogue and prompts user for PDF Folder
Path = SelectFolder("Select PDF Folder", contFolder)
If Len(Path) Then
Path = Path + "\\" 'if user clicks okay, continues the program
Else 'if user clicks cancel, exit the macro
Exit Sub
End If
'gets drawing number from model
Set swCustProp = swModel.Extension.CustomPropertyManager("")
swCustProp.Get5 "DrawingNo", True, ValOut, filename, False
'gets rev from drawing properties
Rev = swDraw.CustomInfo("Revision")
'sets the filename to format: M*123456_REV-**
filename = filename & "_REV-" & Rev
If InStr(filename, "PEF") > 0 Then
MsgBox "This is a PEF File " & InStr(filename, "PEF")
savePEF
Else
Select Case swModel.GetType
Case swDocPART
MsgBox "part file"
savePart
Case swDocDRAWING
'Do nothing
Case swDocASSEMBLY
MsgBox "assembly file"
saveAssy
End Select
End If
ErrCatcher:
If Err.Number > 0 Then
MsgBox ("The error was " & Err.Number)
Err.Clear
End If
On Error GoTo 0
End Sub
Public Sub savePEF()
'creates the PDF directory if it doesn't exist
PDFpath = Path & "PDFs\\"
If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
'creates the DXF directory if it doesn't exist
DXFpath = Path & "DXFs\\"
If Dir(DXFpath, vbDirectory) = "" Then MkDir DXFpath
'creates the DWG directory if it doesn't exist
DWGpath = Path & "DWGs\\"
If Dir(DWGpath, vbDirectory) = "" Then MkDir DWGpath
'saves as PDF
swDraw.SaveAs (PDFpath & filename & ".pdf")
'Saves as DXF
swDraw.SaveAs (DXFpath & filename & ".dxf")
'Saves as DWG
swDraw.SaveAs (DWGpath & filename & ".dwg")
End Sub
Public Sub saveAssy()
'creates the PDF directory if it doesn't exist
PDFpath = Path & "PDFs\\"
If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
'saves as PDF
swDraw.SaveAs (PDFpath & filename & ".pdf")
End Sub
Public Sub savePart()
'creates the PDF directory if it doesn't exist
PDFpath = Path & "PDFs\\"
If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
'creates the DXF directory if it doesn't exist
DXFpath = Path & "DXFs\\"
If Dir(DXFpath, vbDirectory) = "" Then MkDir DXFpath
'creates the IGS directory if it doesn't exist
IGSpath = Path & "IGSs\\"
If Dir(IGSpath, vbDirectory) = "" Then MkDir IGSpath
'saves as PDF
swDraw.SaveAs (PDFpath & filename & ".pdf")
'Saves as DXF
swDraw.SaveAs (DXFpath & filename & ".dxf")
'Saves as IGES
Set swModel = swApp.ActivateDoc3(swModel.GetPathName, False, swRebuildActiveDoc, nErrors)
swModel.Visible = 0
swModel.Extension.SaveAs IGSpath & filename & ".igs", 0, 0, Nothing, nErrors, nWarnings
'closes the recently opened part file
swApp.CloseDoc swModel.GetTitle
End Sub
'Both arguements are optional. The first is the dialog caption and the second is is to specify the top-most visible folder in the hierarchy. The default is "My Computer."
Function SelectFolder(Optional Title As String, Optional TopFolder As String) As String
Dim objShell As New Shell32.Shell
Dim objFolder As Shell32.Folder
'If you use 16384 instead of 1 on the next line, files are also displayed
Set objFolder = objShell.BrowseForFolder(0, Title, 1, TopFolder)
If Not objFolder Is Nothing Then
SelectFolder = objFolder.Items.Item.Path
End If
End Function
