CAD Forum

Code: Select all

swModel.Extension.RunCommand swCommands_SaveAs, Empty

Code: Select all

'Export Open Drawings as PDF_DWG (SW2019).swp ------------- 01/30/19

'Description: Macro to export all open drawings as PDF and DWG.

'Pre-Condition: An open drawing which has been saved and has one model view. The model should have the
' PartNumber, Revision and Description custom properties with values added.

'Post-Condition: Macro save active drawing as PDF and DXF in same location as the drawing file with
' PartNumber, Revision and Description custom properties values from referenced model as the file name.

' The macro would process all open drawings and would export only those drawings which has been saved and contains minimum one model view.

' Please back up your data before use and USE AT OWN RISK
'
'------------------------------------------------------------------------------------
' Created by Deepak Gupta (Boxer's SOLIDWORKS Blog, India) http://gupta9665.com/
'------------------------------------------------------------------------------------
' Disclaimer:
' This macro is provided as is. No claims, support, refund, safety net, or
' warranties are expressed or implied. By using this macro and/or its code in
' any way whatsoever, the user and any entities which the user represents,
' agree to hold the authors free of any and all liability.
' Free distribution and use of this code in other free works is welcome.
' You may redistribute it and/or modify it on the condition that this header is retained.
' All other forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
' without the expressed written consent by the authors.
' Use at your own risk!
' ------------------------------------------------------------------------------

Option Explicit

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 Description As String
Dim PartNumber As String
Dim nFileName As String
Dim sFileName As String
Dim nResponse As Integer
Dim FileSave As Boolean
Dim sDrawingCol As New Collection

Sub Main()

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

swModel.Extension.RunCommand swCommands_SaveAs, Empty
 
' Check to see if a drawing is loaded.
If swDrawModel Is Nothing Then
MsgBox "There is no active drawing document"
Exit Sub
End If

Do While Not swDrawModel Is Nothing
If swDrawModel.GetType = swDocDRAWING Then
sDrawingCol.Add swDrawModel.GetPathName
Debug.Print swDrawModel.GetPathName
End If
Set swDrawModel = swDrawModel.GetNext
Loop

If sDrawingCol.Count > 0 Then

'Set file export type
nResponse = MsgBox("Select YES (PDF & DWG) OR NO (DXF) OR CANCEL (Exit/End)?", vbYesNoCancel)
If nResponse = vbYes Then
FileSave = True
ElseIf nResponse = vbNo Then
FileSave = False
ElseIf nResponse = vbCancel Then
Exit Sub
End If
Else

MsgBox "There is no active drawing document"
Exit Sub
 
End If

Set swDrawModel = swApp.GetFirstDocument
Do While Not swDrawModel Is Nothing
If swDrawModel.GetType = swDocDRAWING Then
Set swDraw = swDrawModel
 
If swDraw.GetPathName <> "" Then
sFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
swApp.ActivateDoc3 sFileName, False, swDontRebuildActiveDoc, nErrors
Else
 
MsgBox "This drawing: " & UCase(swDraw.GetTitle) & " has not been saved, " & vbCrLf & _
"jumping to next drawing (if available) else ending the macro"
GoTo Jump
End If
 
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView

If Not swView Is Nothing Then
Set swModel = swView.ReferencedDocument
Else
MsgBox "No model view found in this drawing: " & UCase(swDraw.GetTitle) & ", " & vbCrLf & _
"jumping to next drawing (if available) else ending the macro"
GoTo Jump
End If


'Get Model Properties
PartNumber = swModel.GetCustomInfoValue("", "Part Number")
Revision = swModel.GetCustomInfoValue("", "Revision")
Description = swModel.GetCustomInfoValue("", "Description")
 
If Revision = "" Then
Revision = ""
End If

'nFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & PartNumber & "-" & Revision & " " & Description
 
' Comment out above line and remove comment from following line in case you want to simply save the draing file with its own name.
nFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & sFileName
 
If FileSave = True Then
'Save as DWG (replace DWG with DXF in following line in case you want to save as DXF)
'Note that DWG will export to one or multiple sheets depending on your solidworks DWG export settings
swDraw.SaveAs3 nFileName & ".DWG", 0, 0
'Save as PDF`
swDraw.SaveAs3 nFileName & ".PDF", 0, 0
ElseIf FileSave = False Then
'Save as DWG (replace DWG with DXF in following line in case you want to save as DXF)
swDraw.SaveAs3 nFileName & ".DXF", 0, 0
End If
End If


Jump:
Set swDrawModel = swDrawModel.GetNext
Loop
 
Set sDrawingCol = Nothing

End Sub