钣金切割清单属性导入到自定义属性

拉丝毛刺

    最近在做钣金成本核算，想把切割参数导入到BOM,无奈参数都在切割清单里面，自定义的BOM里面虽也可链接到切割参数，只是不在同一行里面，强迫症然觉累，所以在本站搜了一下，并没有相关宏贴。无奈下血本发布高额悬赏，原贴
https://www.swbbsc.com/threadcon-307442.html
希望引起大侠注意并指导一二，然时间已过数周，并没有能人异士出手相助。直到昨日，回顾本站，只见消息栏，灯泡异常闪亮，激动无比，心中窃喜，相必定有蹊跷，遂点开查阅，果不出所料，大侠tg000057 道出一二，奈何于VBA一窍不通，犹如天书也。
   于是回帖请教，还不得解，如此反复二三虚心请教，加上自己胡乱琢磨，终于运行成功，并在自定义BOM里面成功添加切割参数。VS，在此谢谢大侠tg000057不厌其烦！
     附上码图及宏程序，供大家学习交流，模型更改后，需再次运行宏，参数才能更新。不知为何，不能自动更新，小弟抛砖引玉，等待大神补充。谢谢！


宏码
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 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 bjkcd As Double
Dim bjkkd As Double
Dim zw As Double
Dim qgcdwb As Double
Dim qgcdnb As Double
Dim qg As Double




Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
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
propNames = custPropMgr.GetNames '获取切割清单属性的数据全部名称并放入数组
If Not IsEmpty(propNames) Then
For Each vName In propNames
propName = vName
custPropMgr.Get2 propName, Value, resolvedValue '获取全部属性名称 ，数值和评估的值
If propName = "边界框长度" Then bjkcd = resolvedValue '判断是否是自己所需要的数据，如果是就获取
If propName = "边界框宽度" Then bjkkd = resolvedValue
If propName = "切割长度-外部" Then qgcdwb = resolvedValue
If propName = "切割长度-内部" Then qgcdnb = resolvedValue
If propName = "切除" Then qg = resolvedValue
If propName = "折弯" Then zw = resolvedValue
If propName = "钣金厚度" Then bjhd = resolvedValue
Next vName
End If
End If
End If
End If
Set thisSubFeat = thisSubFeat.GetNextSubFeature
Loop
Set thisFeat = thisFeat.GetNextFeature
Loop
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)
End Sub

wmx0910

出一个 多实体  钣金折弯   切割  穿刺   面积 合并到自定义属性

tssunyong

很不错，顶一下！

拉丝毛刺

附上成功案例

yni621

   经典案例图书

楼主很专业，写得很好！对于报价来说很全面，大神。

yaoshuai58

请问切割长度内  和外 是表示什么呢

yaoshuai58

   经典案例图书

yaoshuai58 发表于 2021-1-27 16:16
请问切割长度内  和外 是表示什么呢

应该是了解了，主要是用于激光割的。激光割就是周长来计算费用的是吧

xiaofang820606

好东西，学习一下

storyli

楼主很专业，写得很好！

gzsod

楼主太有才了，膜拜中……

鸣沙山

楼主的宏程序非常实用，谢谢提供宏码。

gzsod

楼主的宏不可用  原贴作者的修改版才能用

ZJGERS

能不能增加展开后的面积？

xuaxiang

拉丝毛刺 发表于 2021-1-19 14:46
附上成功案例

这种表格模板怎么制作保存

1215956038

加入QQ群
参与讨论和学习

或扫描二维码加入

楼主太有才了，膜拜中……

dfdongfang

   经典案例图书

能把切割外部长度和切割内部长度相加吗

qq2941115105

加入QQ群
参与讨论和学习

或扫描二维码加入

楼主很专业，写得很好！

初学爱好者

   经典案例图书

感谢楼主分享，很不错

fanyanhong88

很不错，顶一下！

qqfly332211

楼主太有才了，膜拜中……

小豆芽疯回路转

感谢楼主分享，很不错！