Option Explicit
4 W. G( c8 r9 a( E' I- [" A3 LDim swApp As SldWorks.SldWorks9 w" j) n6 E) U
Dim swModel As ModelDoc23 E5 [; l5 X) k' R5 H7 E( ~
Dim cpm As CustomPropertyManager. M ]1 g" [9 @, f0 J; ~+ ?, W" V
Sub main()! D& ?* }8 p' Q- e$ q/ u
Set swApp = Application.SldWorks
! H, Y' c: U$ x! P$ P6 h3 s) X- gSet swModel = swApp.ActiveDoc
% h# Z" b$ w0 \: Z+ @5 b- o7 ?Set cpm = swModel.Extension.CustomPropertyManager("")
7 K3 c8 t3 ^/ `$ lDim path As String, filename As String, partno As String, partname As String, beizhu As String- G8 ^7 o0 ?. a; l+ j% K
path = swModel.GetPathName '获得文件路径和文件名称
4 W9 H/ r' P3 J8 o' A: vfilename = Mid$(path, InStrRev(path, "\") + 1) ' 获得文件名称及扩展名
0 }# L7 O3 Q1 H# F$ I! Wfilename = Left$(filename, InStrRev(filename, ".") - 1) '移除扩展名
5 x* D# \, c4 O9 Bpartno = Left(filename, 10) ' 定义partno等于文件名的前9位& e+ ]5 T6 e+ v
partname = Right(filename, Len(filename) - 10) ' 定义partname等于文件名剩下若干位
" g% ?! v6 R) }( dcpm.Delete "编码" ' 删除自定义属性“编码”1 e+ a. Z/ U- N H* s }8 v% `6 C
cpm.Delete "名称" ' 删除自定义属性“名称”! x Z' I7 ^3 \& B
cpm.Delete "路径" ' 删除自定义属性“路径”
; u+ K) a$ v( [+ [8 x2 l- v& Tcpm.Add2 "编码", swCustomInfoText, partno ' 增加自定义属性“编码”
8 y% |% w' Z3 J4 P, g/ Q0 hcpm.Add2 "名称", swCustomInfoText, partname ' 增加自定义属性“名称”9 A/ i g0 z( R1 |8 K; g; T' _
'cpm.Add2 "路径", swCustomInfoText, path '增加自定义属性“路径”
* s" n" ?" a: Z& H4 D( {7 I4 JswModel.Save ' 保存文件
$ _+ @) l! v M% u'swApp.CloseDoc (filename) ' 关闭当前激活文件
6 {% ]! h& \8 W/ u6 B GEnd Sub
5 B& K% \6 u+ k4 C; j1 m# i4 W. p0 P' A以上 是一种宏的利用 你看看吧 |