Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

SolidWorks Macro - Save Dwg as PDF, DWG and .Zip file

Status
Not open for further replies.

pirateincognito

Automotive
Mar 4, 2015
20
0
0
US
Hello,

I'm using the following code to export my dwgs (taken from various internet examples).

I'd like to release this macro to the engineering department, but it needs to be more robust (report if existing file is in-use and can't be overwritten) and ideally it would .Zip the files and remove the originals.

Can anyone suggest edits to my code to

Code:
Option Explicit

Sub main()

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDrawModel     As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim nErrors         As Long
Dim nWarnings       As Long
Dim Revision        As String
Dim dFileName       As String
Dim pFileName       As String
Dim Filepath        As String

Set swApp = Application.SldWorks
Set swDrawModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If swDrawModel Is Nothing Then
        MsgBox "There is no active drawing document"
        Exit Sub
End If
    
If swDrawModel.GetType <> swDocDRAWING Then
        MsgBox "Open a drawing first and then TRY again!"
        Exit Sub
End If

If swDrawModel.GetPathName = "" Then
        MsgBox "Plese Save the Drawing and then TRY again!"
        swDrawModel.Save
        Exit Sub
        
End If

Set swDraw = swDrawModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Set swModel = swView.ReferencedDocument

' Determine if there is any drawing view
If swView Is Nothing Then
        MsgBox "No View(s) found, Insert a View first and then TRY again!"
        Exit Sub
End If


' Determine if there is any drawing view
If swView.GetReferencedModelName = "" Then
        MsgBox "No Model View(s) found, Insert a View first and then TRY again!"
        Exit Sub
End If


'Drawing File Name Without Extension
Filepath = Left(swDrawModel.GetPathName, InStrRev(swDrawModel.GetPathName, "\")) ' Filepath to location
dFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1) ' Filename with Extension
dFileName = Left(dFileName, Len(dFileName) - 7) ' Filename without Extension



'Save as DXF
'swDraw.SaveAs3 Filepath & dFileName & "_" & Revision & ".DXF", 0, 0

'Save as DWG
'swDraw.SaveAs3 Filepath & dFileName & "_" & Revision & ".DWG", 0, 0
swDraw.SaveAs3 Filepath & dFileName & ".DWG", 0, 0

'Save as PDF
'swDraw.SaveAs3 Filepath & dFileName & "_" & Revision & ".PDF", 0, 0
swDraw.SaveAs3 Filepath & dFileName & ".PDF", 0, 0

'Save as STEP - Use Drawing filename (not Part)
swModel.Extension.SaveAs Filepath & dFileName & ".STEP", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings

End Sub
 
Status
Not open for further replies.
Back
Top