Option Explicit( V2 r+ _7 [# [6 f7 _9 T [; M Dim swApp As SldWorks.SldWorks# F' x) L6 U2 w) P4 O) ` Dim swModel As ModelDoc2; ^$ @1 G- {8 Q8 M/ u Dim cpm As CustomPropertyManager 0 |0 Y+ n" i/ h2 z* E' R' BSub main()5 ]$ G: b/ c. I0 m: I! z Set swApp = Application.SldWorks * O9 c' v$ ?2 m6 dSet swModel = swApp.ActiveDocM- z3 g) p& h# C, V2 b* f Set cpm = swModel.Extension.CustomPropertyManager("")$ |7 n2 K: d6 J3 ?- J7 M Dim path As String, filename As String, partno As String, partname As String, beizhu As String 3 l) ?" F5 a$ K, \ ]/ upath = swModel.GetPathName '获得文件路径和文件名称 4 K4 `0 Z6 i/ Z3 A. Cfilename = Mid$(path, InStrRev(path, "\") + 1) ' 获得文件名称及扩展名 9 j2 p( a, A) l, Qfilename = Left$(filename, InStrRev(filename, ".") - 1) '移除扩展名 / ?5 q0 b ? W/ ?1 N) H2 h3 Jpartno = Left(filename, 10) ' 定义partno等于文件名的前9位 ; Q6 @- e, y* t" ?! m! k2 q- opartname = Right(filename, Len(filename) - 10) ' 定义partname等于文件名剩下若干位 : H5 K0 G$ u+ ~: {8 ` J' o. @cpm.Delete "编码" ' 删除自定义属性“编码” 2 U( C3 n7 b; }' `cpm.Delete "名称" ' 删除自定义属性“名称” 4 X9 }3 _1 }/ p* k+ u+ Ocpm.Delete "路径" ' 删除自定义属性“路径”5 N; l. a0 Q; A: X: U+ [ cpm.Add2 "编码", swCustomInfoText, partno ' 增加自定义属性“编码” 0 Q( A! a' {+ L: `! o+ u) s. Ycpm.Add2 "名称", swCustomInfoText, partname ' 增加自定义属性“名称” 6 M2 s+ l# o$ N( l, M'cpm.Add2 "路径", swCustomInfoText, path '增加自定义属性“路径”/ i8 n; E8 M5 C& k* H A. x, `) p2 I swModel.Save ' 保存文件 / X: W9 P, k/ K% e) M) M'swApp.CloseDoc (filename) ' 关闭当前激活文件 3 P) Y' l1 v1 ~6 pEnd Sub 1 q4 Q/ }" F; V% y( ?& V. q———————————————————————————————————————————————————— # s' H9 J. R' _/ k- G3 a以上是一种 SW工程图的编辑程序 添加在编辑宏内 ,在做工程图时 可以自动生成 零件名称 、图号、 材料类型、数量等。希望对大家有用!! 3 J- H- r% }0 I0 [" j2 S0 G7 s |