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

tg000057

拉丝毛刺 发表于 2021-1-18 14:32
代码是直接复制进去吗，前后需要修改吗，粘贴后是在图片红色框那里改参数（展开长，宽）吗

谢谢

把代码复制丟新宏文件里，然后按下图解释，增加修改自己需要的代码，刚刚看到，之前的代码，删除和写入属性的名称没有对应，因为我之前用的是删除有所属性的，这个增加的时候复制错名了。

tg000057

用宏可以做到：

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
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
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)

tg000057

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

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

tg000057

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

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

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

tg000057

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

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

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