Option Explicit
1 L6 z5 i: k) r! q _Dim swApp As SldWorks.SldWorks* {' ~$ M* h! I( N! y
Dim swModel As ModelDoc2: c8 ]( D1 P `1 j
Dim cpm As CustomPropertyManager0 ~; M9 r; j, @* u5 A
Sub main()9 H4 N% ^7 K+ W8 e- y
Set swApp = Application.SldWorks
! u, {9 J" [8 m) u2 g# rSet swModel = swApp.ActiveDoc
" F# h& c. x. Q! VSet cpm = swModel.Extension.CustomPropertyManager("")
+ f/ B3 Y5 V' _8 |Dim path As String, filename As String, partno As String, partname As String, beizhu As String' F1 k+ ?% G4 D6 p; d
path = swModel.GetPathName '获得文件路径和文件名称8 d& P3 k+ ?0 C6 L
filename = Mid$(path, InStrRev(path, "\") + 1) ' 获得文件名称及扩展名$ E+ c$ X' v" Y
filename = Left$(filename, InStrRev(filename, ".") - 1) '移除扩展名
/ U0 P$ _/ d8 k' `partno = Left(filename, 10) ' 定义partno等于文件名的前9位
4 f! G' H3 d$ C" E o+ i, c% Xpartname = Right(filename, Len(filename) - 10) ' 定义partname等于文件名剩下若干位
, x5 o, D1 F/ m; N7 U' Zcpm.Delete "编码" ' 删除自定义属性“编码”
3 b5 a' K: B' t8 m. @1 w# scpm.Delete "名称" ' 删除自定义属性“名称”! i$ a! S9 p! D8 q" K5 J3 Q5 K/ B
cpm.Delete "路径" ' 删除自定义属性“路径”8 q* ~8 E6 J* u1 f
cpm.Add2 "编码", swCustomInfoText, partno ' 增加自定义属性“编码”$ Q+ N0 H m/ y
cpm.Add2 "名称", swCustomInfoText, partname ' 增加自定义属性“名称”
5 S2 Z* n, l; P3 T" M! }& m'cpm.Add2 "路径", swCustomInfoText, path '增加自定义属性“路径”
' X1 M8 s9 }, ~5 X8 C2 z" o8 b s; wswModel.Save ' 保存文件
0 l+ ?% k3 _2 i'swApp.CloseDoc (filename) ' 关闭当前激活文件
6 o6 u8 K9 x' R7 J& K+ u1 `End Sub* K' C7 z; L# m- f2 K# ?6 w) F
————————————————————————————————————————————————————
" x3 @' C- V. R0 h/ H以上是一种 SW工程图的编辑程序 添加在编辑宏内 ,在做工程图时 可以自动生成 零件名称 、图号、 材料类型、数量等。希望对大家有用!!
6 c9 R5 s+ ?/ N/ a( u |