建立外形属性的宏

donglaifa · 发表于 2014-12-24 11:38:53

经典图书

之前发贴求助过solidworks机械工程师论坛
现进行到了一个阶段，大家看一下

代码如下:
'Outline外形属性设置
'2014.12.24于福州
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Dim A, B, C, T As Double
Dim DM As String
'取各属性值
A = swModel.GetCustomInfoValue("", "A")
B = swModel.GetCustomInfoValue("", "B")
C = swModel.GetCustomInfoValue("", "C")
DM = swModel.GetCustomInfoValue("", "DM") '圆柱或螺纹等的前缀
swModel.DeleteCustomInfo2 "", "Outline" '删除原Outline属性
If (A -1) Then '如果A尺寸不是-1，说明它是一个方形的零件
'对三个尺寸排序
T = IIf(A > B, A, B)
B = IIf(A > B, B, A)
A = T
T = IIf(A > C, A, C)
C = IIf(A > C, C, A)
A = T
T = IIf(B > C, B, C)
C = IIf(B > C, C, B)
B = T
swModel.AddCustomInfo3 "", "Outline", swCustomInfoText, Trim(Str(A)) & "X" & Trim(Str(B)) & "X" & Trim(Str(C)) '建立Outline属性
Else '如果A尺寸不是-1，说明它是一个圆柱形的或一个螺纹形的零件
swModel.AddCustomInfo3 "", "Outline", swCustomInfoText, DM & Trim(Str(B)) & "X" & Trim(Str(C)) 'Str()会去掉尾0
End If
End Sub