|
100金币
在以下宏代码中分别加入全删自定义属性和配置特定属性,并这二段代码可以随意注释,根据需要保留自定义和配置特定属性
最好能有界面,无界面纯宏代码也可以
Sub main()
Set swApp = Application.SldWorks
PartPath = "C:\Users\Administrator\Desktop\QC\" '设定目录
PartFileName = Dir(PartPath & "*.sldprt") '搜寻首个零件档案名称
Do Until PartFileName = "" '直至搜寻到空值
Set Part = swApp.OpenDoc(PartPath & PartFileName, 1) '开启零件
'全删自定义属性标识代码,注释此行全删自定义属性代码无效
'全删自定义属性首
'全删自定义属性尾
'全删配置特定属性标识代码,注释此行全删配置特定属性代码无效
'全删配置特定属性首
'全删配置特定属性尾
'添加长宽高标识代码,注释此行添加长宽高代码无效
'添加长宽高首
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set SelMgr = swModel.SelectionManager
Corners = swModel.GetPartBox(True)
Y = Abs(Corners(4) - Corners(1)) * 1000
Y = Int(Y * 100) / 100 '精度0.01
Z = Abs(Corners(5) - Corners(2)) * 1000
Z = Int(Z * 100) / 100 '精度0.01
X = Abs(Corners(3) - Corners(0)) * 1000
X = Int(X * 100) / 100 '精度0.01
XYZ = Str(X) & "×" & Str(Y) & "×" & Str(Z)
PropValue = Replace(XYZ, " ", "")
'PropValue = InputBox("外形尺寸为:", "名字都被抢注了", PropValue)
swModel.DeleteCustomInfo2 "", "规格" '删除属性
swModel.DeleteCustomInfo2 "Default", "规格" '删除属性
'swModel.AddCustomInfo3 "默认", "规格", swCustomInfoText, PropValue '添加自定义属性
swModel.AddCustomInfo3 "Default", "规格", swCustomInfoText, PropValue '添加特定配置
'添加长宽高尾
'添加边界框标识代码,注释此行添加边界框代码无效
'添加边界框首
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim BoundingBox As Object
Set BoundingBox = Part.FeatureManager.InsertGlobalBoundingBox
(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Part.ClearSelection2 True
'添加边界框尾
Part.Save '保存
swApp.CloseDoc (PartFileName) '关闭零件
PartFileName = Dir '搜寻下一个零件档案名称
Loop '循环搜寻
End Sub
|
|