pirateincognito
Automotive
- Mar 4, 2015
- 20
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
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