求大佬修改宏，急用！！！！

iawifj

1. Dim swApp As SldWorks.SldWorks
   
2. Dim Part As SldWorks.ModelDoc2
   
3. Dim thisFeat As SldWorks.Feature
   
4. Dim thisSubFeat As SldWorks.Feature
   
5. Dim cutFolder As Object
   
6. Dim BodyCount As Integer
   
7. Dim custPropMgr As SldWorks.CustomPropertyManager
   
8. Dim propNames As Variant
   
9. Dim vName As Variant
   
10. Dim propName As String
    
11. Dim Value As String
    
12. Dim resolvedValue As String
    
13. Dim bjkcd As Double
    
14. Dim bjkkd As Double
    
15. Dim zw As Double
    
16. Dim qgcdwb As Double
    
17. Dim qgcdnb As Double
    
18. Dim qg As Double
    
19. 
    
20. 
    
21. 
    
22. 
    
23. Sub main()
    
24. Set swApp = Application.SldWorks
    
25. Set Part = swApp.ActiveDoc
    
26. Set thisFeat = Part.FirstFeature
    
27. Do While Not thisFeat Is Nothing '遍历设计树
    
28. If thisFeat.GetTypeName = "SolidBodyFolder" Then
    
29. thisFeat.GetSpecificFeature2.UpdateCutList
    
30. End If
    
31. Set thisSubFeat = thisFeat.GetFirstSubFeature
    
32. Do While Not thisSubFeat Is Nothing
    
33. If thisSubFeat.GetTypeName = "CutListFolder" Then '查找切割清单
    
34. Set cutFolder = thisSubFeat.GetSpecificFeature2
    
35. End If
    
36. If Not cutFolder Is Nothing Then
    
37. BodyCount = cutFolder.GetBodyCount
    
38. If BodyCount > 0 Then
    
39. Set custPropMgr = thisSubFeat.CustomPropertyManager
    
40. If Not custPropMgr Is Nothing Then
    
41. propNames = custPropMgr.GetNames '获取切割清单属性的数据全部名称并放入数组
    
42. If Not IsEmpty(propNames) Then
    
43. For Each vName In propNames
    
44. propName = vName
    
45. custPropMgr.Get2 propName, Value, resolvedValue '获取全部属性名称 ，数值和评估的值
    
46. If propName = "边界框长度" Then bjkcd = resolvedValue '判断是否是自己所需要的数据，如果是就获取
    
47. If propName = "边界框宽度" Then bjkkd = resolvedValue
    
48. If propName = "切割长度-外部" Then qgcdwb = resolvedValue
    
49. If propName = "切割长度-内部" Then qgcdnb = resolvedValue
    
50. If propName = "切除" Then qg = resolvedValue
    
51. If propName = "折弯" Then zw = resolvedValue
    
52. If propName = "钣金厚度" Then bjhd = resolvedValue
    
53. Next vName
    
54. End If
    
55. End If
    
56. End If
    
57. End If
    
58. Set thisSubFeat = thisSubFeat.GetNextSubFeature
    
59. Loop
    
60. Set thisFeat = thisFeat.GetNextFeature
    
61. Loop
    
62. blnretval = Part.DeleteCustomInfo2("", "展开长度") '删除属性栏上摘要信息的数据
    
63. blnretval = Part.DeleteCustomInfo2("", "展开宽度")
    
64. blnretval = Part.DeleteCustomInfo2("", "切割长度-外部")
    
65. blnretval = Part.DeleteCustomInfo2("", "切割长度-内部")
    
66. blnretval = Part.DeleteCustomInfo2("", "穿孔数")
    
67. blnretval = Part.DeleteCustomInfo2("", "折弯")
    
68. blnretval = Part.DeleteCustomInfo2("", "板厚")
    
69. blnretval = Part.AddCustomInfo3("", "展开长度", swCustomInfoText, bjkcd) '添加数据到摘要信息
    
70. blnretval = Part.AddCustomInfo3("", "展开宽度", swCustomInfoText, bjkkd)
    
71. blnretval = Part.AddCustomInfo3("", "切割长度-外部", swCustomInfoText, qgcdwb)
    
72. blnretval = Part.AddCustomInfo3("", "切割长度-内部", swCustomInfoText, qgcdnb)
    
73. blnretval = Part.AddCustomInfo3("", "穿孔数", swCustomInfoText, qg)
    
74. blnretval = Part.AddCustomInfo3("", "折弯", swCustomInfoText, zw)
    
75. blnretval = Part.AddCustomInfo3("", "板厚", swCustomInfoText, bjhd)
    
76. End Sub
    

复制代码

把宏修成钣金下料尺寸数据放在一起显示，重谢！！！

刘茂机械

blnretval = Part.DeleteCustomInfo2("", "展开长度") '删除属性栏上摘要信息的数据
blnretval = Part.DeleteCustomInfo2("", "展开宽度")
blnretval = Part.DeleteCustomInfo2("", "切割长度-外部")
blnretval = Part.DeleteCustomInfo2("", "切割长度-内部")
blnretval = Part.DeleteCustomInfo2("", "穿孔数")
blnretval = Part.DeleteCustomInfo2("", "折弯")
blnretval = Part.DeleteCustomInfo2("", "板厚")
blnretval = Part.DeleteCustomInfo2("", "开料尺寸")
blnretval = Part.AddCustomInfo3("", "展开长度", swCustomInfoText, bjkcd) '添加数据到摘要信息
blnretval = Part.AddCustomInfo3("", "展开宽度", swCustomInfoText, bjkkd)
blnretval = Part.AddCustomInfo3("", "切割长度-外部", swCustomInfoText, qgcdwb)
blnretval = Part.AddCustomInfo3("", "切割长度-内部", swCustomInfoText, qgcdnb)
blnretval = Part.AddCustomInfo3("", "穿孔数", swCustomInfoText, qg)
blnretval = Part.AddCustomInfo3("", "折弯", swCustomInfoText, zw)
blnretval = Part.AddCustomInfo3("", "板厚", swCustomInfoText, bjhd)
blnretval = Part.AddCustomInfo3("", "开料尺寸", swCustomInfoText, bjkcd&”x“&bjkkd&”x“&bjhd)
End Sub

zhanganhua998

顶一下，坐等高手！

xinzq123

SolidWorks机械工程师网，顶一下。

chenzhg

   经典案例图书

顶一下，坐等高手！

jugege

在"end sub“前加上一句：”blnretval = Part.AddCustomInfo3("", "展开尺寸", swCustomInfoText, bjkcd & "x" & bjkkd & "x" & bjhd)

igxoqve

   经典案例图书

,这个宏呵呵

Alex_Wang

顶一下，坐等沙发

nbxhynbxhy

宏，有点啰嗦了，可以更简洁一点，支持5五楼的

MJATM01

感谢楼主分享，很不错！

iawifj

能不能做成在装配体一键批量所有钣金零部件写入到自定义属性里

iawifj

刘茂机械 发表于 2022-8-1 14:20
blnretval = Part.DeleteCustomInfo2("", "展开长度") '删除属性栏上摘要信息的数据
blnretval = Part.Del ...

按照修改内容更正之后，运行还是出错呢

刘茂机械

iawifj 发表于 2022-8-12 00:13
按照修改内容更正之后，运行还是出错呢

字符不对  直接复制不行吗

iawifj

刘茂机械 发表于 2022-8-12 20:54
字符不对  直接复制不行吗

其实我就是想在钣金切割清单生成多一项，（边界框长度×边界框宽度×钣金厚度）属性名称为“长度”！不用写入自定义属性里，能做到吗？？

470548400

加入QQ群
参与讨论和学习

或扫描二维码加入

牛牛牛牛牛牛牛牛牛

懒懒的高贵

   经典案例图书

很不错，顶一下！