依據配置特定屬性之"件號"及"名稱"存檔

zhito · 发表于 2018-11-15 12:32:28

经典图书

分享在他網的回覆

' ************************************************************************************
' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
' ************************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim nNbrProps As Long
Dim Part As Object
Dim Code_Name(2) As String
Dim valOut As String
Dim resolvedValOut As String
Dim longstatus As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swCustPropMgr = swConfig.CustomPropertyManager
' Get the number of custom properties for this configuration
nNbrProps = swCustPropMgr.Count
vPropNames = swCustPropMgr.GetNames
For j = 0 To nNbrProps - 1
swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
If vPropNames(j) = "代號" Then Code_Name(0) = valOut
If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
Next j
'Debug.Print " Name, type, and resolved value of custom property: " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
Set Part = swApp.ActiveDoc
longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
End Sub