This macro creates a PDF of any sheets that don’t have “DXF” in the name. It then produces a DXF of a sheet with “DXF” in the name. (If you have multiple DXF sheets, it will overwrite all but the last. My drawings only have 1 DXF sheet.)
There is a bunch of file name manipulation that won’t make sense to anyone else, but I’ll leave that for you to sort out. There are likely some declared variables that are unused. This has evolved over a number of years.
As always, credit goes to a number of un-named internet sources and published macros that I borrowed from. I am an engineer who can bash his way through generating code that works, but only if I have good examples to start from.
The one known issue I haven’t dealt with is that the number of sheets in the title block count’s the DXF, even though it isn’t present in the pdf.
Option Explicit
Dim Part As Object
Dim longstatus As Long
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swCustPropMgr As CustomPropertyManager
Dim sModelName As String
Dim sModelPath As String
Dim sNewPath As String
Dim sNewName As String
Dim sModelFullName As String
Dim sDxfFullName As String
Dim CropPos As Integer
Dim sRev As String
Dim sDesc As String
Dim Bool As Boolean
Dim Junk As String
Dim ModelType As Object
Dim LocalPath As String
Dim strSheetName() As String
Dim swExportPDFData As SldWorks.ExportPdfData
Dim varSheetName As Variant
Dim lErrors As Long
Dim lWarnings As Long
Dim s As Variant
Private Declare PtrSafe Sub SHAddToRecentDocs Lib "shell32" _
(ByVal uFlags As Long, ByVal pv As Any)
Sub ProcessDwg()
Set swApp = Application.SldWorks
Set ModelType = swApp.ActiveDoc
If ModelType Is Nothing Then ' Check to see if a document is loaded
' If no model is currently loaded, then exit
Exit Sub
End If
If (ModelType.GetType <> 3) Then 'CHeck to see if document is a drawing. prt=1, asm=2, drw=3
MsgBox ("Not a Drawing File")
Exit Sub
End If
Set swDraw = swApp.ActiveDoc
longstatus = swDraw.Save3(1, lErrors, lWarnings)
Set swView = swDraw.GetFirstView 'this gets the sheet
Set swView = swView.GetNextView 'this gets the first view
Set swModel = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Bool = swCustPropMgr.Get4("Revision", False, sRev, Junk)
Bool = swCustPropMgr.Get4("Long Name", False, sDesc, Junk)
'this is the full name and path
sModelPath = swModel.GetPathName
'get filename from full path
CropPos = InStrRev(sModelPath, "\")
sNewName = Right(sModelPath, (Len(sModelPath) - CropPos))
'strip slddrw extension
sNewName = Left(sNewName, Len(sNewName) - 7)
'add revision and description
'Set swCustProp = swModelDocExt.CustomPropertyManager("")
sNewName = sNewName + "-" + sRev + "-" + sDesc
sNewName = Replace(sNewName, ",", "")
sNewName = Replace(sNewName, ".", "_")
sNewName = Replace(sNewName, "/", "_")
sNewName = Replace(sNewName, "\", "_")
sNewName = Replace(sNewName, """", "")
'add pdf extension
sNewName = sNewName + ".pdf"
'get path
sNewPath = Left(sModelPath, CropPos - 1)
'remove subdirectory from path
CropPos = InStrRev(sNewPath, "\")
sNewPath = Left(sNewPath, CropPos)
'add drawings folder
sNewPath = sNewPath + "drawings\"
sModelFullName = sNewPath + sNewName
' Save As
'save to Onedrive
LocalPath = Mid(sModelFullName, 21)
sModelFullName = "C:\Users\DSPerman\CTW Automation\CAD - General" + LocalPath
sDxfFullName = Left(sModelFullName, (Len(sModelFullName) - 3)) + "dxf"
'get list of sheets, excluding dxf
ReDim strSheetName(0)
For Each s In swDraw.GetSheetNames
longstatus = swDraw.ActivateSheet(s)
swApp.ActiveDoc.Extension.ViewZoomToSheet
If Not UCase(s) Like "*DXF*" Then
strSheetName(UBound(strSheetName)) = s
ReDim Preserve strSheetName(UBound(strSheetName) + 1)
End If
Next s
varSheetName = strSheetName
' Save As
If swExportPDFData Is Nothing Then MsgBox "Nothing"
longstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
longstatus = swModelDocExt.SaveAs(sModelFullName, 0, 0, swExportPDFData, lErrors, lWarnings)
SHAddToRecentDocs 2, sModelFullName
'process dxf
For Each s In swDraw.GetSheetNames
If UCase(s) Like "*DXF*" Then
longstatus = swDraw.ActivateSheet(s)
longstatus = swDraw.SaveAs3(sDxfFullName, 0, 2)
SHAddToRecentDocs 2, sModelFullName
End If
Next s
longstatus = swDraw.ActivateSheet(strSheetName(0))
longstatus = swDraw.Save3(1, lErrors, lWarnings)
End Sub