|
下面是一个VB代码函数,供诸君参考。
函数功能:添加焊件切割清单项目属性,并填写其默认值。调用该函数应使用当前零件为参数。
------------------------------------
Public Sub AddCutL(ByVal part As ModelDoc2) '添加焊件切割清单默认值
Dim s As String
Dim ffname As String
Dim i As Integer
Dim ii As Integer
Dim partName As String
Dim swModel As ModelDoc2
Dim swFeature As feature
Set swModel = part
If swModel Is Nothing Then Exit Sub '参数为空,退出
If swModel.GetType <> swDocPART Then Exit Sub '当前不是零件环境,退出
i = 0
ii = 0
s = ""
ffname = GetOnlyname(swModel.GetPathName)
Set swFeature = swModel.FirstFeature
Do While Not swFeature Is Nothing '遍历文档中的所有特征,查找切割清单项目
s = swFeature.name
If swFeature.GetTypeName = "CutListFolder" Then '如是切割清单则增加重量属性及材质名称
If swFeature.CustomPropertyManager.Add("weight", "文字", """SW-Mass@@@" & s & "@" & ffname & ".sldprt""") = 0 Then
swFeature.CustomPropertyManager.Set "weight", """SW-Mass@@@" & s & "@" & ffname & ".sldprt"""
End If
If swFeature.CustomPropertyManager.Add("Material", "文字", "Q235A") = 0 Then
swFeature.CustomPropertyManager.Set "Material", "Q235A"
End If
i = i + 1
End If
Set swFeature = swFeature.GetNextFeature
Loop
'查找完毕
If Len(s) > 0 Then MsgBox "更新了" + Str(i) + "个切割清单的材料Q235A及重量属性。" + banName, vbOKOnly, "提示"
Set swModel = Nothing
End Sub
Public Function GetOnlyname(ByVal s As String) As String '从全名中取出文件名简称,去除路径及扩展名
Dim i As Integer
Dim OnlyS As String
OnlyS = s
i = InStrRev(OnlyS, "")
OnlyS = Right(OnlyS, Len(OnlyS) - i)
i = InStrRev(OnlyS, ".")
OnlyS = Left(OnlyS, i - 1)
GetOnlyname = OnlyS
End Function |
|