Dim swApp As Object
Dim swModel As ModelDoc2
Dim vCustInfoNameArr2 As Variant
Dim cpm As CustomPropertyManager
Dim Value As String
Dim i As Integer
Dim massprops As Variant '定义一个数组
Dim status As Long
Sub main() '先删除自定义属性,再给自定义属性赋值
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set cpm = swModel.Extension.CustomPropertyManager("")
'Set msp = swModel.Extension.GetMassProperty2()
Dim path As String, filename As String, partno As String, desc As String, hhf As String, beizhu As String, chuli As String
'(以下为删除自定义属性里所有内容)
vCustInfoNameArr2 = swModel.GetCustomInfoNames
vCustInfoValue2 = swModel.GetCustomInfoValue("", "处理")
vCustInfoValue3 = swModel.GetCustomInfoValue("", "加工品材质")
vCustInfoValue4 = swModel.GetCustomInfoValue("", "热处理")
vCustInfoValue5 = swModel.GetCustomInfoValue("", "设计人")
处理 = vCustInfoValue2
加工品材质 = vCustInfoValue3
热处理 = vCustInfoValue4
设计人 = vCustInfoValue5
If Not IsEmpty(vCustInfoNameArr2) Then
For Each vCustInfoName2 In vCustInfoNameArr2
bRet = swModel.DeleteCustomInfo(vCustInfoName2)
Next
End If
'(以下为删除配置特定里的内容)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
CurCFGname = swModel.GetConfigurationNames
CurCFGnameCount = swModel.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = swModel.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
For Each Vnamearr2 In Vnamearr
bRet = swModel.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
Next
End If
Next
path = swModel.GetPathName '获取文件路径和文件名
filename = Mid$(path, InStrRev(path, "\") + 1) ' 带扩展名的文件名
filename = Left$(filename, InStrRev(filename, ".") - 1) ' 移除文件扩展名
partno = Left(filename, 17) '取零件名称的前17位
desc = Right(filename, Len(filename) - 18) ' 取零件名称18位以后的
massprops = swModel.Extension.GetMassProperties2(1, status, True)
加工品质量 = massprops(5)
加工品表面积 = massprops(4) * 1000000
加工品质量 = VBA.Format(加工品质量, "#0.00") '二位小数
加工品表面积 = VBA.Format(加工品表面积, "#0.00") '二位小数
Dim AddStatus As Long
AddStatus = cpm.Add3("图号", swCustomInfoText, partno, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("名称", swCustomInfoText, desc, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("处理", swCustomInfoText, 处理, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("加工品质量", swCustomInfoText, 加工品质量, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("加工品表面积", swCustomInfoText, 加工品表面积, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("加工品材质", swCustomInfoText, 加工品材质, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("热处理", swCustomInfoText, 热处理, swCustomPropertyReplaceValue)
AddStatus = cpm.Add3("设计人", swCustomInfoText, "某某", swCustomPropertyReplaceValue)
End Sub
solidworks宏添加自定义属性
于 2024-07-08 21:36:36 首次发布