VBA:如何查找并替换块内文字？

157787698

RT
7 o+ |# N3 C9 [* M+ ~% I1 @
有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字

其中一行为中文，另一行为英文，内容固定
) u0 n& e# P& U' k' K" \/ b
6 ]# e7 D) l: U- I) M$ B" J1 C比如中国杭州和Hangzhou China
7 t" S* `- X6 g# \
; z4 r& G0 |# W( c2 P+ s' E: [1 J5 ]现在要统一改为杭州和Hangzhou

但块的名字不知道
6 f* L3 _7 e. g, F: w9 y2 P
1 i' s" B% V- M- X
) X- m: b5 g! Q- w$ Y( b请问如何用程序实现？请大虾帮忙，谢谢

157787698

自己顶下，还没解决问题，不能沉了

woaishuijia

你若是真心求助,就应该提供尽可能详细的信息,比如一份DWG文件.

157787698

3# woaishuijia

& k8 [0 A) G  b# W7 U5 o% d4 r最近实在是太忙了，不好意思
( M( N3 A( X" l9 k 中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件

+ `( V" X# e+ a. p/ I- ?9 A0 I图纸只是示例，由于保密原因不能将原图给出，还请见谅。
6 G3 ~! P* @6 B$ k6 `& Y
$ F3 M# y" M3 ]) [就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开
7 ~( c$ G' g0 G9 h* _9 p
请提供帮助，，非常感谢。

woaishuijia

. `% M" W( t" z, d0 Z( l2 ^# K1 o下面的代码只针对上传的文档,仅供参考
6 \, |$ u1 Y) B

1. Sub A()
     ]1 Q4 I$ E7 Q
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   5 _8 p" q" x4 o4 S0 ~
3. On Error GoTo 10
   . f! y, o! }% M) U
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   / W$ b+ n$ D" p
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   
6. '如用户输入的目录字符串最后一个字符为""则去掉
   ( A5 k+ p& G- \% ~: @. j
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   
8. '逐个打开该目录下的所有"*.DWG"文档
   
9. FileName = Dir(Path & "\*.dwg" )
   6 p! h$ |$ ^' o4 J' b) t4 e- z' Q
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    
12.     '遍历该文档中所有块定义
    
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    : j: D% M* m: f9 n: S
15.         '否则跳过
    + k) h) g. e' W: d
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    ; |' v5 J/ z" w$ ~; n4 ~
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    1 s# N* ^* O! z& }
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    5 d4 C4 D0 \+ ?; U
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    
21.                     B.Item(0).TextString = "杭州"
    
22.                     B.Item(1).TextString = "Hangzhou"
    0 N/ F. Z' i0 Y/ j, b
23.                     D.Save
    2 H  y, e' s, Q  k; J: a8 n
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    
25.                     B.Item(0).TextString = "Hangzhou"
    
26.                     B.Item(1).TextString = "杭州"
    
27.                     D.Save
    * S: K$ a, }6 ]  z
28.                 End If
    # ~+ {1 A& B4 ~3 @% \/ _2 e
29.             End If
    
30.         End If
    
31.     Next
      \% T- A, R7 E% v
32.     '关闭打开的文档
    
33.     D.Close
    
34.     '获取下一个文件名
    
35.     FileName = Dir()
    . r* G, l" Z* T, |2 f3 L! h* f
36. Loop
    + T- [5 J% z/ p/ z7 `
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了

再次感谢