We want to create a new Save as DWG macro so that anyone who uses it, gets the exact same results. It needs to:
1) save to specified folder ("
2) use a predefined mapping file ("C:\EPDM_Vault\Templates\DWG Mapping Files\101517-mapping")
3) Along with the following settings established.
Below is a sample of an attempt. I'm able to get the file to save to the right location, but I'm baffled on how to specify the mapping file and other specific settings. Can anyone shed some light on this for me?
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
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"
' 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 ""
' Turn off showing of map
bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
Debug.Print "bShowMap = " & bShowMap
bRet = swModel.SaveAs4(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)
Beep
If bRet = False Then
swApp.SendMsgToUser2 "Problems saving file.", swMbWarning, swMbOk
End If
' Restore old setting
swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap
End Sub