It's easier to display the code directly than to attach the macro:
Const INCLUDE_DRAWING_NAME As Boolean = True
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
try_:
On Error GoTo catch_
Dim swDraw As SldWorks.DrawingDoc
Set swDraw = swApp.ActiveDoc
Dim swModel As SldWorks.ModelDoc2
Set swModel = swDraw
If swModel.GetPathName() = "" Then
Err.Raise vbError, "", "Please save drawing"
End If
Dim vSheetNames As Variant
Dim i As Integer
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = swModel.SelectionManager
Dim selSheetNames() As String
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSHEETS Then
If (Not selSheetNames) = -1 Then
ReDim selSheetNames(0)
Else
ReDim Preserve selSheetNames(UBound(selSheetNames) + 1)
End If
Dim swSheet As SldWorks.Sheet
Set swSheet = swSelMgr.GetSelectedObject6(i, -1)
selSheetNames(UBound(selSheetNames)) = swSheet.GetName()
End If
Next
If (Not selSheetNames) = -1 Then
vSheetNames = swDraw.GetSheetNames
Else
vSheetNames = selSheetNames
End If
For i = 0 To UBound(vSheetNames)
Dim sheetName As String
sheetName = vSheetNames(i)
Dim swExpPdfData As SldWorks.ExportPdfData
Set swExpPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
Dim errs As Long
Dim warns As Long
Dim expSheets(0) As String
expSheets(0) = sheetName
swExpPdfData.ExportAs3D = False
swExpPdfData.ViewPdfAfterSaving = False
swExpPdfData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, expSheets
Dim drawName As String
drawName = swModel.GetPathName()
drawName = Mid(drawName, InStrRev(drawName, "\") + 1, Len(drawName) - InStrRev(drawName, "\") - Len(".slddrw"))
Dim outFile As String
outFile = swModel.GetPathName()
outFile = Left(outFile, InStrRev(outFile, "\"))
Debug.Print outFile
Debug.Print sheetName
outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"
If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
Err.Raise vbError, "", "Failed to export PDF to " & outFile
End If
Next
GoTo finally_
catch_:
swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
finally_:
End Sub
To understand the code you just have to add debug.files and look at the execution window
The part that concerns you:
outFile = Left(outFile, InStrRev(outFile, "\")) ' retrieves the path to the drawing
Visible with debug.file "outFile" & outFile' displays c:\temp\
Then:
outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"
This line defines the name of your pdf file drawName retrieves the name of your drawing file and sheetName the name of the sheet.
Ensuite If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
Err.Raise vbError, "", "Failed to export PDF to " & outFile
End If
Export your file as a pdf or display an error message.
Now you have to add a condition if your sheetName sheet starts with cutting you get what is left of the name of your sheet and you export in dwg instead of pdf.
Hint looks at the vba If function and also the Split function