×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

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

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

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

(OP)
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 
Replies continue below

Recommended for you

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login



News


Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close