So I have the following macro which automates the "save as DWG" operation by also configuring specific options and then creates a directory to store the DWG file in.
This macro works 100% of the time when the "Export" folder doesn't already exist. But when the "Export" folder already exists, the script may run successfully, but sometimes, it errors out at the following line...
I can't figure out why it randomly works/doesn't work if the directory already exists. Is there a way to rewrite this to check if the directory exists, and if it does exist, to not make the directory, but instead use the sPathName? I'm just not fluent enough to write that out myself.
SolidworksApi/macrosDim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim sFileName As String
Dim sPathName As String
Dim strFullPath As String
Dim bRet As Boolean
Dim nErrors As Long
Dim nWarnings As Long
Dim CustomMap As String
Dim instance As ISldWorks
Dim UserPreferenceValue As Integer
Dim OnFlag As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
sFileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
sFileName = Left(sFileName, InStrRev(sFileName, ".") - 1)
sPathName = Environ("USERPROFILE") & "\Desktop\Export\"
If Dir(sPathName) = "" Then
MkDir sPathName
End If
sPathName = sPathName & sFileName & ".DWG"
CustomMap = "C:\EPDM_Vault\Templates\DWG Mapping Files\cem-mapping"
' Show current settings
Debug.Print "DxfMapping = " & swApp.GetUserPreferenceToggle(swDxfMapping)
Debug.Print "DXFDontShowMap = " & swApp.GetUserPreferenceToggle(swDXFDontShowMap)
Debug.Print "DxfVersion = " & swApp.GetUserPreferenceIntegerValue(swDxfVersion)
Debug.Print "DxfOutputFonts = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
Debug.Print "DxfMappingFileIndex = " & swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
Debug.Print "DxfOutputLineStyles = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
Debug.Print "DxfOutputNoScale = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)
Debug.Print "DxfMappingFiles = " & swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)
Debug.Print "DxfOutputScaleFactor = " & swApp.GetUserPreferenceDoubleValue(swDxfOutputScaleFactor)
Debug.Print ""
' Set specific Version
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfVersion, 6
' Set specific Fonts
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputFonts, 1
' Set specific Fonts
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, 1
' Enable specific Custom Map SOLIDWORKS to DXF/DWG
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfMapping, True
' Custom Map SOLIDWORKS to DXF/DWG - Don't show mapping on each save
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFDontShowMap, True
' Custom Map SOLIDWORKS to DXF/DWG - Map file
swApp.SetUserPreferenceStringListValue swUserPreferenceStringListValue_e.swDxfMappingFiles, CustomMap
' Enable Scale output 1:1
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, True
' Scale output 1:1 - Base scale - NOT AVAILABLE IN SW2017 API
' Scale output 1:1 - Warn me if enabled - NOT AVAILABLE IN SW2017 API
' Enable End Point Merging
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfEndPointMerge, True
' End Point Merging Tolerance
swApp.SetUserPreferenceDoubleValue swUserPreferenceDoubleValue_e.swDxfMergingDistance, 0
' End Point Merging - High quality DWG export
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFHighQualityExport, False
' Spline export options - Export all splines as splines
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, True
' Spline export options - Export all splines as polylines
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, False
' Multiple sheet drawing - Export active sheet only
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, True
' Multiple sheet drawing - Export all sheets to separate files
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, False
' Multiple sheet drawing - Export all sheets to one file
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, False
' Multiple sheet drawing - Export all drawing sheets to paper space
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfExportAllSheetsToPaperSpace, False
'Do you want to export entities on all layers?
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFExportHiddenLayersOn, True
'Do not ask again
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFExportHiddenLayersWarnIsOn, True
' Use Solidworks Layers
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfUseSolidworksLayers, True
' Turn off showing of map
bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
swApp.SetUserPreferenceToggle swDXFDontShowMap, False
swApp.SetUserPreferenceStringListValue swDxfMappingFiles, CustomMap
Index = swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
If (Index = -1) Then
swApp.SetUserPreferenceIntegerValue swDxfMappingFileIndex, 0
End If
bRet = swModel.SaveAs4(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)
If bRet = False Then
nRetval = swApp.SendMsgToUser2("Problems saving file.", swMbWarning, swMbOk)
End If
' Restore old setting
swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap
End Sub