请问切割清单参数怎么链接到自定义明细表里面

拉丝毛刺

请问切割清单参数怎么链接到自定义明细表里面，切割清单里的链接是什么原理？

轩辕龙

活到老学到老

嘟123456

   经典图书

很不错，找到组织了！

懒懒的高贵

很不错，顶一下！

z460515477

   经典案例图书

求教怎么写入配置清单中，十分感谢

442593696

很不错，顶一下！

小豆芽疯回路转

   经典案例图书

tg000057 发表于 2021-1-20 09:49
Sub main()
Dim thisFeat As SldWorks.Feature                                                       ...

可以在加上有多少个攻丝孔？多少个沉孔吗？

fanyanhong88

很不错，找到组织了！

qqfly332211

活到老学到老！

dfdongfang

   经典图书

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

1215956038

楼主很专业，写得很好！

yizhidalanzhu

谢谢各位大佬的分享    第一次接触到修改程序

tg000057

拉丝毛刺 发表于 2021-1-19 10:24
我刚才研究了一下，新建宏把里面的都删掉才可以运行，展开长度和宽度可以添加到自定义属性，现在我想添加 ...

Sub main()
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


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 qgcdnb = resolvedValue
If propName = "切割长度-外部" Then qgcdwb = resolvedValue
If propName = "切除" Then qc = 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, qgcdnb)
blnretval = Part.AddCustomInfo3("", "切割长度-外部", swCustomInfoText, qgcdwb)
blnretval = Part.AddCustomInfo3("", "穿孔数", swCustomInfoText, qc)
blnretval = Part.AddCustomInfo3("", "折弯刀数", swCustomInfoText, zw)
blnretval = Part.AddCustomInfo3("", "板厚", swCustomInfoText, bjhd)


End Sub

拉丝毛刺

tg000057 发表于 2021-1-19 10:14
昨天回复几个贴都没通过，不知道怎么回事，
你这个是开始和结束语注意一下，要把新建宏时原有的语句全部 ...

我刚才研究了一下，新建宏把里面的都删掉才可以运行，展开长度和宽度可以添加到自定义属性，现在我想添加切割长度、穿孔数、折弯数，添加进去后自定义属性里面没有变化，是不是和属性名称代码有关系，比如边界框长度是bjkcd，我试想切割长度-外部是不是qgcd-wb，然后添加进去并不是，请问怎么解决，谢谢

tg000057

加入QQ群
参与讨论和学习

或扫描二维码加入

拉丝毛刺 发表于 2021-1-18 16:29
是的，自定义属性里没有变化

昨天回复几个贴都没通过，不知道怎么回事，
你这个是开始和结束语注意一下，要把新建宏时原有的语句全部删除了，要复制代码进去，最后加一行结束语，这一行我复制漏了：end sub

tg000057

   经典案例图书

拉丝毛刺 发表于 2021-1-18 16:29
是的，自定义属性里没有变化

嗯，是我的问题，少了最后的结束语，新建宏原来就有几行的，都不要。因为Sub main()会重复。就执行不了了。最后一行加上 end sub
按这下面的也行


Sub main()
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
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
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.AddCustomInfo3("", "开料长度", swCustomInfoText, bjkcd) '添加数据到摘要信息
blnretval = Part.AddCustomInfo3("", "开料宽度", swCustomInfoText, bjkkd)
end sub

拉丝毛刺

加入QQ群
参与讨论和学习

或扫描二维码加入

tg000057 发表于 2021-1-18 16:17
没有反映，是什么情况，是切割清单的参数没到导到自定义属性里吗？

是的，自定义属性里没有变化

tg000057

   经典案例图书

拉丝毛刺 发表于 2021-1-18 15:26
这是修改后的，可是运行没有反应，请问是什么原因

没有反映，是什么情况，是切割清单的参数没到导到自定义属性里吗？

拉丝毛刺

tg000057 发表于 2020-11-6 10:30
把代码复制丟新宏文件里，然后按下图解释，增加修改自己需要的代码，刚刚看到，之前的代码，删除和写入属 ...

这是修改后的，可是运行没有反应，请问是什么原因

拉丝毛刺

tg000057 发表于 2021-1-18 14:21
做好一钣金零件，执行这一段宏，（要把宏修改成你需要的参数，比如展开长，宽，穿孔数，折弯等参数），然 ...

代码是直接复制进去吗，前后需要修改吗，粘贴后是在图片红色框那里改参数（展开长，宽）吗

谢谢

tg000057

拉丝毛刺 发表于 2021-1-18 13:25
请问这个怎么用呢

做好一钣金零件，执行这一段宏，（要把宏修改成你需要的参数，比如展开长，宽，穿孔数，折弯等参数），然后切割清单的参数就到了文件自定义属性里，(每一次执行都是删除旧的，重新获取新的，更新)。然后再插入材料明细表，定义每一列的属性，再另想另为明细表模板。