宏：焊件切割清单中自动增加『单重』和『总重』的属性+3！（限額5位）

学习了

跟焊件死磕到底了。。

如何在焊接件切割清单属性中添加一条名称
名称  钢板 "SW-3D-边界框长度@@@"X"SW-3D-边界框宽度@@@"X"SW-3D-边界框厚度@@@"
如此这样一条，以达到自动出钢板的规格

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 propNames As Variant
Dim vName As Variant
Dim propName As String
Dim Value As String
Dim resolvedValue As String
Dim TotalW As Double
Dim Parts As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
Set swApp = Application.SldWorks
Set Parts = swApp.ActiveDoc
Set thisFeat = Parts.FirstFeature
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Parts.ClearSelection2 True
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Parts.Extension.Create3DBoundingBox

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 "Total Weight"
                    custPrOPMgr.Delete "总重"
                    custPrOPMgr.Delete "Weight"
                    custPrOPMgr.Delete "材料"
                    fn = thisSubFeat.Name
                    pn = Parts.GetTitle
                    custPrOPMgr.Add "单重", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
                    custPrOPMgr.Add "重量", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
                    custPrOPMgr.Add "材料", "文字", Chr(34) & "SW-Material@@@" & 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")
                End If
            End If
        End If
        Set thisSubFeat = thisSubFeat.GetNextSubFeature
    Loop
    Set thisFeat = thisFeat.GetNextFeature
Loop
End Sub


我想在这段代码中能让切割清单中增加一条属性
名称  钢板 "SW-3D-边界框长度@@@"X"SW-3D-边界框宽度@@@"X"SW-3D-边界框厚度@@@"
不明白如何加入进去，请知道可以告知，谢谢

zyf0732 发表于 2014-11-22 11:35
响应鹿大号召，我就是在闷大基础上增加了几个适合我的属性
Option Explicit
Dim swApp As SldWorks.Sld ...

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 propNames As Variant
Dim vName As Variant
Dim propName As String
Dim Value As String
Dim resolvedValue As String
Dim TotalW As Double
Dim Parts As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
Set swApp = Application.SldWorks
Set Parts = swApp.ActiveDoc
Set thisFeat = Parts.FirstFeature
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Parts.ClearSelection2 True
boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Parts.Extension.Create3DBoundingBox

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 "Total Weight"
                    custPrOPMgr.Delete "总重"
                    custPrOPMgr.Delete "Weight"
                    custPrOPMgr.Delete "材料"
                    fn = thisSubFeat.Name
                    pn = Parts.GetTitle
                    custPrOPMgr.Add "单重", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
                    custPrOPMgr.Add "重量", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
                    custPrOPMgr.Add "材料", "文字", Chr(34) & "SW-Material@@@" & 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")
                End If
            End If
        End If
        Set thisSubFeat = thisSubFeat.GetNextSubFeature
    Loop
    Set thisFeat = thisFeat.GetNextFeature
Loop
End Sub


我想在这段代码中能让切割清单中增加一条属性
名称  钢板 "SW-3D-边界框长度@@@"X"SW-3D-边界框宽度@@@"X"SW-3D-边界框厚度@@@"
不明白如何加入进去，是否可以告知，谢谢

1. Sub main()
   
2. Set swApp = Application.SldWorks
   
3. Set Parts = swApp.ActiveDoc
   
4. Set thisFeat = Parts.FirstFeature
   
5. boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
   
6. boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
   
7. Parts.ClearSelection2 True
   
8. boolstatus = Parts.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
   
9. Parts.Extension.Create3DBoundingBox
   
10. 
    
11. Do While Not thisFeat Is Nothing
    
12.     If thisFeat.GetTypeName = "SolidBodyFolder" Then
    
13.         thisFeat.GetSpecificFeature2.UpdateCutList
    
14.     End If
    
15.     Set thisSubFeat = thisFeat.GetFirstSubFeature
    
16.     Do While Not thisSubFeat Is Nothing
    
17.         If thisSubFeat.GetTypeName = "CutListFolder" Then
    
18.             Set cutFolder = thisSubFeat.GetSpecificFeature2
    
19.         End If
    
20.         If Not cutFolder Is Nothing Then
    
21.             BodyCount = cutFolder.GetBodyCount
    
22.             If BodyCount > 0 Then
    
23.                 Set custPrOPMgr = thisSubFeat.CustomPropertyManager
    
24.                 If Not custPrOPMgr Is Nothing Then
    
25.                     custPrOPMgr.Delete "Total Weight"
    
26.                     custPrOPMgr.Delete "总重"
    
27.                     custPrOPMgr.Delete "Weight"
    
28.                     custPrOPMgr.Delete "材料"
    
29.                     fn = thisSubFeat.Name
    
30.                     pn = Parts.GetTitle
    
31.                     custPrOPMgr.Add "单重", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
    
32.                     custPrOPMgr.Add "重量", "文字", Chr(34) & "SW-Mass@@@" & fn & "@" & pn & Chr(34)
    
33.                     custPrOPMgr.Add "材料", "文字", Chr(34) & "SW-Material@@@" & fn & "@" & pn & Chr(34)
    
34.                     propNames = custPrOPMgr.GetNames
    
35.                     If Not IsEmpty(propNames) Then
    
36.                         For Each vName In propNames
    
37.                             propName = vName
    
38.                             custPrOPMgr.Get2 propName, Value, resolvedValue
    
39.                             If propName = "重量" Then TotalW = resolvedValue
    
40.                         Next vName
    
41.                     End If
    
42.                     custPrOPMgr.Add "总重", "文字", Format(BodyCount * TotalW, "0.00")
    
43.                     custPrOPMgr.Add "名称", "文字", "钢板 ""SW-3D-边界框长度@@@""X""SW-3D-边界框宽度@@@""X""SW-3D-边界框厚度@@@"""
    
44.                 End If
    
45.             End If
    
46.         End If
    
47.         Set thisSubFeat = thisSubFeat.GetNextSubFeature
    
48.     Loop
    
49.     Set thisFeat = thisFeat.GetNextFeature
    
50. Loop
    
51. End Sub
    

复制代码

可自动创建焊件的单重总重重量以及3D边界框和焊件中的钢板的名称尺寸长宽厚的链接
但是如果焊件中只有一个实体出错，总重If propName = "重量" Then TotalW = resolvedValue这句执行不下去

厉害了啊

看看，什么情况

看东西幺回复啊

谢谢分享！