12 Replies Latest reply on Jan 16, 2018 9:58 AM by Shaun Jalbert

    Save as DWG with Defined Settings

    Shaun Jalbert

      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 ("<user>\Desktop\Export\")

      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?

       

      Dim 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
      
      
          • Re: Save as DWG with Defined Settings
            Shaun Jalbert

            Hmm... Looked at this. Looks like this would solve item 2) in my list. I tried it, but it didn't work.

            Also, this doesn't address item 3) at all either.

             

            Anyway, this was my latest attempt.

             

            'Save DWG in Specified Folder.swp
            'Description: Macro to export Drawing File as DWG in specified location.
            'Pre-Condition: An active drawing file.
            'Post-Condition: Macro will export the active Drawing File as DWG in specified location
            ' ------------------------------------------------------------------------------
            
            Dim 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
            
            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\101517-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 ""
                
                ' 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
            
            • Re: Save as DWG with Defined Settings
              Shaun Jalbert

              Looks like these are what I want to set for task item #3) in my list.

              How do I call these out?

               

              2016 api - File > Save As > Save as type > Dxf or Dwg > Options

                • Re: Save as DWG with Defined Settings
                  Deepak Gupta

                  You can call those options using SetUserPreferenceIntegerValue and SetUserPreferenceToggle

                    • Re: Save as DWG with Defined Settings
                      Shaun Jalbert

                      Deepak:

                       

                      I'm not a programmer, so please bare with me. I'm having trouble calling out those options.

                       

                      I've declared the following:

                           Dim instance As ISldWorks

                           Dim UserPreferenceValue As System.Integer

                           Dim OnFlag As System.Boolean

                       

                      Then Called out the setting as:

                           ' Set Client specific settings

                           ISldWorks::SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersOn, OnFlag)

                       

                      but I get the following error.

                      Not sure what I'm doing wrong?

                        • Re: Save as DWG with Defined Settings
                          Alex Burnett

                          According to your full code above, you're pretty much there. Just call out the commands as follows. It will fail if you put parenthesis unless you set it to a return value. The syntax you need is here:

                           

                          swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfMapping, false
                          

                           

                          The list of settings in my c# program are below. These can be translated easily into VBA and get you pointed in the right direction.

                           

                          ///  .dxf
                          ///  .dwg
                          ///  flat.dxf
                          // DXF Version
                          swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, (int)swDxfFormat_e.swDxfFormat_R2000);
                          
                          // Fonts (0 use AUTOCAD FONTS, 1 use TRUE TYPE)
                          swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputFonts, 0);
                          
                          // Line Styles (0 use AUTOCAD STANDARD, 1 use CUSTOM)
                          swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, 0);
                          
                          // Custom Map Solidworks to DXF/DWG
                          swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping, false);
                          
                          // Scale output
                          swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 0);
                          
                          // Endpoint Merging
                          swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfEndPointMerge, false);
                          
                          // Spline Export Options
                          swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, true);
                          
                          // Multisheet Options
                          swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, (int)swDxfMultisheet_e.swDxfMultiSheet);
                          
                        • Re: Save as DWG with Defined Settings
                          Shaun Jalbert

                          Ok, I think I figured out the callouts - as follows:

                           

                          ' Set specific Version
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat.e.Value) = 6
                          ' Set specific Fonts
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputFonts, swDxfFormat.e.Value) = 1
                          ' Set specific Fonts
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, swDxfFormat.e.Value) = 1
                          ' Enable specific Custom Map SOLIDWORKS to DXF/DWG
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping, OnFlag) = True
                          ' Custom Map SOLIDWORKS to DXF/DWG - Don't show mapping on each save
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFDontShowMap, OnFlag) = True
                          ' Custom Map SOLIDWORKS to DXF/DWG - Map file
                          ISldWorks:: SetUserPreferenceStringListValue(swUserPreferenceStringListValue_e.swDxfMappingFiles, Value) = CustomMap
                          ' Enable Scale output 1:1
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale, Value) = 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
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfEndPointMerge, OnFlag) = True
                          ' End Point Merging Tolerance
                          ISldWorks:: SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swDxfMergingDistance, Value) = 0
                          ' End Point Merging - High quality DWG export
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFHighQualityExport, OnFlag) = False
                          ' Spline export options - Export all splines as splines
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = True
                          ' Spline export options - Export all splines as polylines
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = False
                          ' Multiple sheet drawing - Export active sheet only
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly) = True
                          ' Multiple sheet drawing - Export all sheets to separate files
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets) = False
                          ' Multiple sheet drawing - Export all sheets to one file
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfMultiSheet) = False
                          ' Multiple sheet drawing - Export all drawing sheets to paper space
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportAllSheetsToPaperSpace, OnFlag) = False
                          
                          'Do you want to export entities on all layers? <Yes/No>
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersOn, OnFlag) = True
                          'Do not ask again
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersWarnIsOn, OnFlag) = True
                          
                          ' Use Solidworks Layers
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfUseSolidworksLayers, OnFlag) = True
                          

                           

                          However, I can't seem to run the script - keep getting an error:

                           

                          What's wrong here?

                           

                          Full script below

                          'Save DWG in Specified Folder.swp
                          
                          'Description: Macro to export Drawing File as DWG in specified location.
                          
                          'Pre-Condition: An active drawing file.
                          
                          'Post-Condition: Macro will export the active Drawing File as DWG in specified location
                          
                          ' ------------------------------------------------------------------------------
                           
                           
                          
                          Dim 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 System.Integer
                          
                          Dim OnFlag As System.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\101517-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
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat.e.Value) = 6
                          ' Set specific Fonts
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputFonts, swDxfFormat.e.Value) = 1
                          ' Set specific Fonts
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, swDxfFormat.e.Value) = 1
                          ' Enable specific Custom Map SOLIDWORKS to DXF/DWG
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping, OnFlag) = True
                          ' Custom Map SOLIDWORKS to DXF/DWG - Don't show mapping on each save
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFDontShowMap, OnFlag) = True
                          ' Custom Map SOLIDWORKS to DXF/DWG - Map file
                          ISldWorks:: SetUserPreferenceStringListValue(swUserPreferenceStringListValue_e.swDxfMappingFiles, Value) = CustomMap
                          ' Enable Scale output 1:1
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale, Value) = 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
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfEndPointMerge, OnFlag) = True
                          ' End Point Merging Tolerance
                          ISldWorks:: SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swDxfMergingDistance, Value) = 0
                          ' End Point Merging - High quality DWG export
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFHighQualityExport, OnFlag) = False
                          ' Spline export options - Export all splines as splines
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = True
                          ' Spline export options - Export all splines as polylines
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = False
                          ' Multiple sheet drawing - Export active sheet only
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly) = True
                          ' Multiple sheet drawing - Export all sheets to separate files
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets) = False
                          ' Multiple sheet drawing - Export all sheets to one file
                          ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfMultiSheet) = False
                          ' Multiple sheet drawing - Export all drawing sheets to paper space
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportAllSheetsToPaperSpace, OnFlag) = False
                          
                          'Do you want to export entities on all layers? <Yes/No>
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersOn, OnFlag) = True
                          'Do not ask again
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersWarnIsOn, OnFlag) = True
                          
                          ' Use Solidworks Layers
                          ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfUseSolidworksLayers, OnFlag) = 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
                          
                          
                          
                          
                            • Re: Save as DWG with Defined Settings
                              Shaun Jalbert

                              Please see my full code below.

                              I keep getting a compile error at:

                              Dim UserPreferenceValue As System.Integer
                              
                              

                               

                              Can anyone point out what's wrong?

                               

                               

                              'Save DWG in Specified Folder.swp
                              
                              'Description: Macro to export Drawing File as DWG in specified location.
                              
                              'Pre-Condition: An active drawing file.
                              
                              'Post-Condition: Macro will export the active Drawing File as DWG in specified location
                              
                              ' ------------------------------------------------------------------------------
                               
                               
                              
                              Dim 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 System.Integer
                              
                              Dim OnFlag As System.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\101517-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
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat.e.Value) = 6
                              ' Set specific Fonts
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputFonts, swDxfFormat.e.Value) = 1
                              ' Set specific Fonts
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputLineStyles, swDxfFormat.e.Value) = 1
                              ' Enable specific Custom Map SOLIDWORKS to DXF/DWG
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping, OnFlag) = True
                              ' Custom Map SOLIDWORKS to DXF/DWG - Don't show mapping on each save
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFDontShowMap, OnFlag) = True
                              ' Custom Map SOLIDWORKS to DXF/DWG - Map file
                              ISldWorks:: SetUserPreferenceStringListValue(swUserPreferenceStringListValue_e.swDxfMappingFiles, Value) = CustomMap
                              ' Enable Scale output 1:1
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale, Value) = 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
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfEndPointMerge, OnFlag) = True
                              ' End Point Merging Tolerance
                              ISldWorks:: SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swDxfMergingDistance, Value) = 0
                              ' End Point Merging - High quality DWG export
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFHighQualityExport, OnFlag) = False
                              ' Spline export options - Export all splines as splines
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = True
                              ' Spline export options - Export all splines as polylines
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportSplinesAsSplines, OnFlag) = False
                              ' Multiple sheet drawing - Export active sheet only
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly) = True
                              ' Multiple sheet drawing - Export all sheets to separate files
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets) = False
                              ' Multiple sheet drawing - Export all sheets to one file
                              ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfMultiSheet) = False
                              ' Multiple sheet drawing - Export all drawing sheets to paper space
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfExportAllSheetsToPaperSpace, OnFlag) = False
                              
                              'Do you want to export entities on all layers? <Yes/No>
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersOn, OnFlag) = True
                              'Do not ask again
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDXFExportHiddenLayersWarnIsOn, OnFlag) = True
                              
                              ' Use Solidworks Layers
                              ISldWorks:: SetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfUseSolidworksLayers, OnFlag) = 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
                              
                              
                              
                              
                              • Re: Save as DWG with Defined Settings
                                Deepak Gupta

                                You need to format the lines correctly.

                                 

                                For e.g. this line 

                                ' Set specific Version 

                                ISldWorks:: SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat.e.Value) = 6 

                                 

                                should be

                                 

                                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfVersion, 6

                                 

                                Please update the other lines correctly and it should work fine.

                                  • Re: Save as DWG with Defined Settings
                                    Shaun Jalbert

                                    Thanks so much. Worked like a charm.

                                    Full corrected script in case anyone else ever needs it.

                                     

                                     

                                    'Save DWG in Specified Folder.swp
                                    
                                    'Description: Macro to export Drawing File as DWG in specified location.
                                    
                                    'Pre-Condition: An active drawing file.
                                    
                                    'Post-Condition: Macro will export the active Drawing File as DWG in specified location
                                    
                                    ' ------------------------------------------------------------------------------
                                     
                                     
                                    
                                    Dim 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\101517-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? <Yes/No>
                                    
                                    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