|
|
发表于 2011-12-15 20:05:46
|
显示全部楼层
来自： 中国辽宁
本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑
, y" S3 g# k) e% i1 a! r9 Q" c8 v: g: ?0 a q! }$ o
下面的代码只针对上传的文档,仅供参考2 j+ p2 I) ]% q) s. Z3 }" x
- Sub A()
6 G) @8 D+ Z) j) t1 T - Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
5 P2 J* `5 n" F( H* ?, Q - On Error GoTo 10- J9 s: d) [$ r q& Y1 j# N% [. f
- '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
% | ~# _7 m5 O/ j' H - Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" ), v# S/ U* \2 k" L8 ]4 {' H
- '如用户输入的目录字符串最后一个字符为""则去掉
4 t. N9 h6 C* g0 @9 Y5 m) E: f J5 Q - If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)9 t ~- C- K8 o% i) ]/ p( V
- '逐个打开该目录下的所有"*.DWG"文档2 d& P7 U% B" q0 b8 S* c
- FileName = Dir(Path & "\*.dwg" )- J; ], x* H8 D5 e
- Do Until FileName = ""- V" b; f) [1 G/ G$ K+ d
- Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)8 v* \8 a( }7 r- m: ]; _, s) g% _
- '遍历该文档中所有块定义0 f; V( X/ u5 X; m
- For Each B In D.Blocks
( m* e8 z2 X$ f3 T& y - '如果该块定义中只有两个元素则进一步检查其中内容
* ?; s0 C3 Q3 r: D# \ h2 e - '否则跳过
" o3 ?& j0 b4 y9 X' g - If B.Count = 2 Then/ w. B( K- k: }. |! M9 c
- '检查块元素是否为单行文字对象! P$ _3 B1 \4 k2 _6 @
- If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
) y& l6 ^( |; P. w6 W - '检查单行文字的内容,如符合要求即修改之,然后保存
( X( s5 H. y9 L ? - If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then4 t, {0 t# H0 ?4 ^+ |3 I
- B.Item(0).TextString = "杭州"6 W1 E7 V" b! \! I3 ?
- B.Item(1).TextString = "Hangzhou"
4 ^ E5 R5 F5 i; [) Q - D.Save
9 A3 n6 _$ D, F$ p, M - ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then& |' l! l$ r+ z
- B.Item(0).TextString = "Hangzhou"- Y: [/ V$ w& b; m1 e
- B.Item(1).TextString = "杭州"3 b' E5 K4 }, o6 W
- D.Save- l. e8 z% d* U/ J2 N/ }. Q7 M1 o/ j& b- @
- End If+ H6 S' c3 P: x; J+ t9 U
- End If5 v/ n8 a" ]4 r# [
- End If) A' L9 z; B4 g, b3 Q3 Q ?* C E# o
- Next
* }, R1 z% P1 y& k6 n" h) y - '关闭打开的文档
0 f. N: d2 ?4 \! a" @6 I- R - D.Close
' A6 l R, e) d7 ^- K9 s' l - '获取下一个文件名
+ H$ W; t( [" H6 w C8 G" I - FileName = Dir() n0 E c5 L9 M% ]4 q
- Loop
+ |0 X9 e2 G1 ] - 10: End Sub
|
|
发表于 2011-12-7 14:54:44
楼主