板金展开尺寸写入自定义属性修改为配置属性

yh2008

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. Sub main()
    
16. Set swApp = Application.SldWorks
    
17. Set Part = swApp.ActiveDoc
    
18. Set thisFeat = Part.FirstFeature
    
19. Do While Not thisFeat Is Nothing '
    
20. If thisFeat.GetTypeName = "SolidBodyFolder" Then
    
21. thisFeat.GetSpecificFeature2.UpdateCutList
    
22. End If
    
23. Set thisSubFeat = thisFeat.GetFirstSubFeature
    
24. Do While Not thisSubFeat Is Nothing
    
25. If thisSubFeat.GetTypeName = "CutListFolder" Then '
    
26. Set cutFolder = thisSubFeat.GetSpecificFeature2
    
27. End If
    
28. If Not cutFolder Is Nothing Then
    
29. BodyCount = cutFolder.GetBodyCount
    
30. If BodyCount > 0 Then
    
31. Set custPropMgr = thisSubFeat.CustomPropertyManager
    
32. If Not custPropMgr Is Nothing Then
    
33. propNames = custPropMgr.GetNames '
    
34. If Not IsEmpty(propNames) Then
    
35. For Each vName In propNames
    
36. propName = vName
    
37. custPropMgr.Get2 propName, Value, resolvedValue '
    
38. If propName = "边界框长度" Then bjkcd = resolvedValue '
    
39. If propName = "边界框宽度" Then bjkkd = resolvedValue
    
40. If propName = "钣金厚度" Then bjhd = resolvedValue
    
41. Next vName
    
42. End If
    
43. End If
    
44. End If
    
45. End If
    
46. Set thisSubFeat = thisSubFeat.GetNextSubFeature
    
47. Loop
    
48. Set thisFeat = thisFeat.GetNextFeature
    
49. Loop
    
50. blnretval = Part.DeleteCustomInfo2("", "边界框长度") '
    
51. blnretval = Part.DeleteCustomInfo2("", "边界框宽度")
    
52. blnretval = Part.DeleteCustomInfo2("", "钣金厚度")
    
53. blnretval = Part.AddCustomInfo3("", "边界框长度", swCustomInfoText, bjkcd) '
    
54. blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
    
55. blnretval = Part.AddCustomInfo3("", "钣金厚度", swCustomInfoText, bjhd)
    
56. 
    
57. 
    
58. blnretval = Part.DeleteCustomInfo2("", "边界框长度") '
    
59. blnretval = Part.DeleteCustomInfo2("", "边界框宽度")
    
60. blnretval = Part.DeleteCustomInfo2("", "钣金厚度")
    
61. blnretval = Part.AddCustomInfo3("", "边界框长度", swCustomInfoText, bjkcd) '
    
62. blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
    
63. blnretval = Part.AddCustomInfo3("", "钣金厚度", swCustomInfoText, bjhd)
    
64. blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
    
65. blnretval = Part.AddCustomInfo3("", "规格", swCustomInfoText, Format(bjkcd, "0") & "*" & Format(bjkkd, "0") & "*" & Format(bjhd, "0"))
    
66. MsgBox "规格已完成!"
    
67. End Sub
    

复制代码

在网上找的板金展开尺寸写入自定义属性，现在想修改为配置属性不知如何修改，向大家请教

yh2008

目前可以将属性写入到自定义属性中，想修改如上图

lizhongfa

顶一下，坐等高手！

沉默的人

顶一下，坐等高手！

wjbg2019

   经典案例图书

原文件可以发出来

yh2008

wjbg2019 发表于 2022-12-1 09:19
原文件可以发出来

顶楼就是源代码

yh2008

   经典案例图书

高手在哪里

tg000057

• blnretval = Part.DeleteCustomInfo2("", "边界框长度") '
• blnretval = Part.DeleteCustomInfo2("", "边界框宽度")
• blnretval = Part.DeleteCustomInfo2("", "钣金厚度")
• blnretval = Part.AddCustomInfo3("", "边界框长度", swCustomInfoText, bjkcd) '
• blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
• blnretval = Part.AddCustomInfo3("", "钣金厚度", swCustomInfoText, bjhd)
• blnretval = Part.DeleteCustomInfo2("", "边界框长度") '
• blnretval = Part.DeleteCustomInfo2("", "边界框宽度")
• blnretval = Part.DeleteCustomInfo2("", "钣金厚度")
• blnretval = Part.AddCustomInfo3("", "边界框长度", swCustomInfoText, bjkcd) '
• blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
• blnretval = Part.AddCustomInfo3("", "钣金厚度", swCustomInfoText, bjhd)
• blnretval = Part.AddCustomInfo3("", "边界框宽度", swCustomInfoText, bjkkd)
• blnretval = Part.AddCustomInfo3("", "规格", swCustomInfoText, Format(bjkcd, "0") & "*" & Format(bjkkd, "0") & "*" & Format(bjhd, "0"))
  

，
改成：
，
blnretval = Part.DeleteCustomInfo2("默认", "规格")
blnretval = Part.AddCustomInfo3("默认", "规格", swCustomInfoText, Format(bjkcd, "0") & "*" & Format(bjkkd, "0") & "*" & Format(bjhd, "0"))

yh2008

tg000057 发表于 2022-12-6 17:17

blnretval = Part.DeleteCustomInfo2("", "边界框长度") '

blnretval = Part.DeleteCustomInfo2(" ...

感谢您的回复，这样属性是写入了自定义属性。
但此宏还是有一个问题，就是当板金修改后，其写入的属性无法自动更新尺寸。不知道是可以做到自动修改？

jy000167

很不错，找到组织了！

lianfugany

顶一下，坐等高手！

taolai89

SW机械工程师网，找到组织了！

zxt0824

感谢楼主分享，很不错！

taolai89

非常不错，求楼主分享！

sun5166

加入QQ群
参与讨论和学习

或扫描二维码加入

这个宏有个问题这个规格修改图后不会改么！！！