用于将 Solidworks 零件配置保存为 dxf 文件的宏

Question

我必须从 Solidworks 中保存大量 dxf 文件以用于 CNC 机器。

我正在寻求帮助来创建一个宏，以将零件的每个配置保存为零件的顶视图，作为 a.dxf 保存在与保存 Solidworks 文件相同的位置。

我发现了两个我需要组合在一起的宏。 第一个将所有配置单独保存为零件文件第二个将零件保存为顶视图的 dxf。

如果有人能帮助我，我将不胜感激

第一个宏：

' Macro created by Jeff Parker CSWP/MCP             12/30/02
'
'  Rev.1 = Added completion message box.  Also verified SolidWorks 2005 compatabliity.
'
'  Rev.2 = Fixed macro for x64 bits machines (changed folder browse codes).  Also verified SolidWorks 2014 compatabliity.
'           (BY: Deepak Gupta www.gupta9665.com      07/26/14)
'          Folder Browse Codes: http://www.cpearson.com/excel/browsefolder.aspx
'
'  Rev.3 = Fixed macro for Weldment part configuration names having <As Machined> and <As Welded>. Also verified SolidWorks 2016 compatabliity.
'           (BY: Deepak Gupta www.gupta9665.com      01/14/16)
'
'  DISCLAIMER:
'  * These macros are provided free of charge for personal use and/or reference.
'  * These macros may be freely distributed, provided the original copyright
'    notices remain unchanged and intact.
'  * All macros were written to work with SolidWorks 2005.
'  * These macros, and corresponding files, are provided as is.
'  * There are no warranties, expressed or implied, that these macros will perform
'    as indicated, perform to users expectations, or complete a specific task.
'  * These macros will change the current SolidWorks document. Use these macros at
'    your own risk. Back up your data before using this macro on any SolidWorks
'    document.
'
' ******************************************************************************

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim ConfigNamesArray As Variant
Dim ConfigNameMain As Variant
Dim ConfigName As Variant
Dim NewName As String
Dim PartName As String
Dim OpenName As String
Dim CurrentConfigName As Variant
Dim fileerror As Long
Dim filewarning As Long
Dim OrigConfigName As Variant
Dim Location As Variant
Dim ModLoc As String
Dim MassProps As Variant
Dim Mass As Variant
Dim MassError As Long
Dim ConfigCount As Long
Dim MassPropArrayTest As Long
Dim CustomPropNamesArray As Variant
Dim CustomPropName As Variant
Dim PartSourceName As String
Dim PartSourcePath As String
Dim status As Boolean

Sub main()

Set swApp = Application.SldWorks                    'Connect to SolidWorks session
Set Part = swApp.ActiveDoc                          'Set Part variable to active doc

If Part Is Nothing Then Exit Sub

ConfigCount = Part.GetConfigurationCount            'Get number of configurations
PartSourceName = Part.GetTitle                      'Get name of original part file that contains configurations

If Part.GetType <> swDocPART Then 'Check to see if current document is a part
    MsgBox "Only Allowed on Parts, Please open a part and try again.", vbOKOnly, "Error" ' Display error message"
    Exit Sub ' Exit this program
ElseIf ConfigCount = 1 Then
    MsgBox "Must have at least two configurations before starting macro.", vbOKOnly, "Error" ' Display error message"
    Exit Sub ' Exit this program
Else
    GoTo Rip
End If
 
Rip:                                                'RIP sub section

frmLocation.Show                                    'Show form

Location = frmLocation.txtPath.Text                 'Get user selected location

'---Check to see if location has last backslash---
ModLoc = Right(Location, 1)

If ModLoc <> "\" Then
    Location = Location & "\"
End If

ConfigNamesArray = Part.GetConfigurationNames   'Populate the array with all config names

OrigConfigName = ConfigNamesArray(0)            'Get current configuration

For i = 0 To UBound(ConfigNamesArray)
    ConfigName = ConfigNamesArray(i)            'Assign next config name to ConfigName variable
    Part.ShowConfiguration2 (ConfigName)        'Set next config as current
    
    ConfigName = Replace((Replace(ConfigName, "<As Machined>", "")), "<As Welded>", "")
     
    NewName = Location & ConfigName & ".sldprt" 'Create path
       
    
    Part.SaveAsSilent NewName, True             'Save as current config name
Next i

PartSourcePath = Part.GetPathName

swApp.CloseDoc PartSourceName                   'Close the source file to conserve memory for program

Set Part = Nothing                              'Clear part variable

For j = 0 To UBound(ConfigNamesArray)
    ConfigNameMain = ConfigNamesArray(j)                        'Populate ConfigNameMain with current name
    ConfigNameMain = Replace((Replace(ConfigNameMain, "<As Machined>", "")), "<As Welded>", "")
    OpenName = Location & ConfigNameMain & ".sldprt"            'Set location of file to open
    fileerror = swFileNotFoundError                             'Default system error message
    filewarning = swFileSaveWarning_NeedsRebuild                'Default warning message
    swApp.OpenDoc6 OpenName, 1, 0, "", fileerror, filewarning   'Open saved configuration file
    Set Part = swApp.ActiveDoc                                  'Set newly opened file as current
    
    Part.DeleteDesignTable          'Delete design table if present


    For k = 0 To UBound(ConfigNamesArray)                       'Delete all configurations from new file
        ConfigName = ConfigNamesArray(k)
        Part.DeleteConfiguration2 (ConfigName)
    Next k
        
    Part.EditConfiguration3 ConfigNameMain, "Default", "", "", 0      'Rename leftover config to default
    
    Part.ViewZoomtofit2                                                 'Make part zoom to fit so icon looks good
    
    Part.Save2 (True)                                               'Save newly modified part
    Set Part = Nothing                                              'Clear Part variable
    swApp.CloseDoc ConfigNameMain & ".sldprt"                       'Close current part
Next j

swApp.OpenDoc6 PartSourcePath, 1, 0, "", fileerror, filewarning     'Open original source file

Set Part = swApp.ActiveDoc                                          'Set original part as current
Part.ShowConfiguration2 (OrigConfigName)                            'Set original part to original status

MsgBox "Here is where you can find your files: " & Chr(13) & Location, vbInformation, "Configuration Rip Success!"

Location = ""                                                       'Clear location variable

End Sub                                                             'Close program

第二个宏：

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim sModelName As String
Dim sPathName As String
Dim varAlignment As Variant
Dim dataAlignment(11) As Double
Dim varViews As Variant
Dim dataViews(0) As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
sModelName = swModel.GetPathName
sPathName = Left(sModelName, Len(sModelName) - 6) & "dxf"
dataAlignment(0) = 0#
dataAlignment(1) = 0#
dataAlignment(2) = 0#
dataAlignment(3) = 1#
dataAlignment(4) = 0#
dataAlignment(5) = 0#
dataAlignment(6) = 0#
dataAlignment(7) = 0#
dataAlignment(8) = -1#
dataAlignment(9) = 0#
dataAlignment(10) = 1#
dataAlignment(11) = 0#
varAlignment = dataAlignment
dataViews(0) = "*Top"
varViews = dataViews
swPart.ExportToDWG2 sPathName, sModelName, swExportToDWG_e.swExportToDWG_ExportAnnotationViews, True, varAlignment, False, False, 0, varViews
End Sub

Answer 1

试试这些代码

Option Explicit Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim sModelName As String Dim sPathName As String Dim vConfNameArr As Variant Dim i As Long Dim sConfigName As String Dim bRebuild As Boolean Dim swPart As SldWorks.PartDoc Dim nFileName As String Dim varAlignment As Variant Dim dataAlignment(11) As Double Dim varViews As Variant Dim dataViews(0) As String Sub Main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc ' Is document active? If swModel Is Nothing Then swApp.SendMsgToUser2 "A Sheet Metal Part must be open.", swMbWarning, swMbOk Exit Sub End If ' Is it a part document? If swModel.GetType <> SwConst.swDocPART Then swApp.SendMsgToUser2 "A Sheet Metal Part must be open.", swMbWarning, swMbOk Exit Sub End If sModelName = swModel.GetPathName sPathName = Left(sModelName, InStrRev(sModelName, "\")) vConfNameArr = swModel.GetConfigurationNames For i = 0 To UBound(vConfNameArr) sConfigName = vConfNameArr(i) If Not UCase(sConfigName) Like "*FLAT*" Then swModel.ShowConfiguration2 (sConfigName) bRebuild = swModel.ForceRebuild3(False) nFileName = sPathName & sConfigName & ".DXF" Set swPart = swModel dataAlignment(0) = 0# dataAlignment(1) = 0# dataAlignment(2) = 0# dataAlignment(3) = 0# dataAlignment(4) = 0# dataAlignment(5) = 0# dataAlignment(6) = 0# dataAlignment(7) = 0# dataAlignment(8) = 0# dataAlignment(9) = 0# dataAlignment(10) = 0# dataAlignment(11) = 0# varAlignment = dataAlignment dataViews(0) = "*Top" varViews = dataViews 'Export Top View swPart.ExportToDWG2 nFileName, sModelName, 3, True, varAlignment, False, False, 0, varViews End If Next i End Sub