|
之前发贴求助过https://www.icax.org/forum.php?m ... ;extra=#pid11527543
现进行到了一个阶段,大家看一下
代码如下:
'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
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|