|
代码如下:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim thisFeat As SldWorks.Feature
Dim thisSubFeat As SldWorks.Feature
Dim cutFolder As Object
Dim BodyCount As Integer
Dim fn As String
Dim pn As String
Dim custPropMgr As SldWorks.CustomPropertyManager
Dim custPropMgr1 As SldWorks.CustomPropertyManager
Dim propNames As Variant
Dim vName As Variant
Dim propName As String
Dim Value As String
Dim TValue As String
Dim tTotalw As Double
Dim resolvedValue As String
Dim tresolvedValue As String
Dim TotalW As Double
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set custPropMgr1 = Part.Extension.CustomPropertyManager("")
custPropMgr1.Get2 "数量", TValue, tresolvedValue
Set thisFeat = Part.FirstFeature
Do While Not thisFeat Is Nothing
If thisFeat.GetTypeName = "SolidBodyFolder" Then
thisFeat.GetSpecificFeature2.UpdateCutList
End If
Set thisSubFeat = thisFeat.GetFirstSubFeature
Do While Not thisSubFeat Is Nothing
If thisSubFeat.GetTypeName = "CutListFolder" Then
Set cutFolder = thisSubFeat.GetSpecificFeature2
End If
If Not cutFolder Is Nothing Then
BodyCount = cutFolder.GetBodyCount
If BodyCount > 0 Then
Set custPropMgr = thisSubFeat.CustomPropertyManager
If Not custPropMgr Is Nothing Then
custPropMgr.Delete "总重"
custPropMgr.Delete "单重"
custPropMgr.Delete "数量"
custPropMgr.Delete "总量"
fn = thisSubFeat.Name
pn = Part.GetTitle
custPropMgr.Add "单重", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
propNames = custPropMgr.GetNames
If Not IsEmpty(propNames) Then
For Each vName In propNames
propName = vName
custPropMgr.Get2 propName, Value, resolvedValue
If propName = "单重" Then TotalW = resolvedValue
Next vName
End If
custPropMgr.Add "总重", "文字", Format(BodyCount * TotalW, "0.00")
custPropMgr.Add "数量", "文字", Format(BodyCount, "0")
custPropMgr.Add "总量", "文字", Format(BodyCount * TValue, "0")
End If
End If
End If
Set thisSubFeat = thisSubFeat.GetNextSubFeature
Loop
Set thisFeat = thisFeat.GetNextFeature
Loop
End Sub
复制代码
敬请版大先生 斧正 |
|