|
|
发表于 2011-12-15 20:05:46
|
显示全部楼层
来自： 中国辽宁
本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑 + d- `( P2 e% T, S* [
A7 r& ~$ O, s3 e下面的代码只针对上传的文档,仅供参考# w, Y$ N. y8 Q* V$ f$ _* S
- Sub A()
6 p' \7 y; X! { K9 T* R+ ` - Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock) T$ w- ^+ ^6 H* g8 q8 Z$ A: j0 ~
- On Error GoTo 10* h' J3 I C" O
- '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
9 V7 i) K" g" l - Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" ) b$ ]( z( F; T1 ]9 O, O: U# V8 c
- '如用户输入的目录字符串最后一个字符为""则去掉9 O0 }, x+ I9 a. ^0 A
- If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)5 V1 M' i' ^; \3 _& J: T
- '逐个打开该目录下的所有"*.DWG"文档
1 B! t# D( k" R - FileName = Dir(Path & "\*.dwg" )9 O& P- u: {" C! U% s! E
- Do Until FileName = "") j& i5 [4 A/ }5 I8 t0 v# J4 I
- Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)) i, t( v/ V2 u) \
- '遍历该文档中所有块定义& W, @9 s, N1 G& N( ?9 A
- For Each B In D.Blocks q4 I+ o: g9 S# D
- '如果该块定义中只有两个元素则进一步检查其中内容
& K& t8 t8 I6 Q! S S - '否则跳过/ \4 X! B$ w/ H( R" R9 L- M
- If B.Count = 2 Then% j' Q7 l, J* B/ y0 F
- '检查块元素是否为单行文字对象" v3 ?0 ?" X0 k$ S+ m) ~! @/ {5 @2 Z
- If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
3 f! n: @8 Q/ C% y - '检查单行文字的内容,如符合要求即修改之,然后保存+ Z* y$ }) |* B
- If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
8 F' C z; G% C6 Q7 B! Z - B.Item(0).TextString = "杭州"
( N) k" ~ M" Z$ G9 w - B.Item(1).TextString = "Hangzhou"% k$ C+ Z8 x2 X
- D.Save7 W. L' }! a* I- A
- ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then9 ~' w" \! |- g, i+ \
- B.Item(0).TextString = "Hangzhou"% s" X V% w7 h: j/ H1 Y: j' b
- B.Item(1).TextString = "杭州"
+ \8 {* _( S4 V2 e - D.Save6 @* F% s! Y" S
- End If2 b/ U2 S4 S7 v; I" l
- End If
5 y/ i4 o3 M0 u$ E- K" V - End If
/ {' f0 k& a, B - Next% N5 X, H8 q- t
- '关闭打开的文档1 @3 J) H- u t6 u q9 h
- D.Close
3 t+ k# c w+ W& V - '获取下一个文件名
, [: `4 g% ^& ?6 @" f' }" n - FileName = Dir()7 U6 h- `8 L2 r( s7 O; |2 M& M
- Loop
3 ~7 b# ]0 P7 ?* a. X# d& f - 10: End Sub
|
|
发表于 2011-12-7 14:54:44
楼主