用於將 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