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

157787698

RT
* h2 f5 l6 H) V5 k7 M' X
& l. E; o7 \+ x2 [( L: Y有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字
0 g& ~8 b9 c" l4 [; l
% q$ L7 |; ~* E# d* p& K) V  ?9 P其中一行为中文，另一行为英文，内容固定
" B( C2 G: b0 q3 n2 P6 w2 \* W
% m+ u. e! g* ~/ v# U- I# O) C比如中国杭州和Hangzhou China
# j, s4 Z7 p4 ^6 j& |7 n- l
3 Y3 e$ ?/ I. B" U5 p现在要统一改为杭州和Hangzhou
& U" k  o3 p8 ~9 ?; r
) I# @2 F# w; e* y但块的名字不知道
5 G" y$ u5 c/ J% s1 M

请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia

最近实在是太忙了，不好意思
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件

图纸只是示例，由于保密原因不能将原图给出，还请见谅。

就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开

请提供帮助，，非常感谢。

woaishuijia

% _3 `* W5 S$ u+ t2 U2 F下面的代码只针对上传的文档,仅供参考
0 T  B# h! V3 [" z3 a2 Q, z- p0 A/ W! ?

1. Sub A()
   
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   + L& K! ?  N) R& E
3. On Error GoTo 10
   
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   6 f' J2 k1 |3 k8 Q; |+ M% T
6. '如用户输入的目录字符串最后一个字符为""则去掉
     |% `; ^- I) w" g6 Z
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   ) R9 P1 t' c: G% e0 B+ ?
8. '逐个打开该目录下的所有"*.DWG"文档
   
9. FileName = Dir(Path & "\*.dwg" )
   ' |( J0 L$ r7 T2 ^- s% k
10. Do Until FileName = ""
    % y. |( r$ d7 @: |2 C! Y
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    
12.     '遍历该文档中所有块定义
    , A; A/ f% Z8 m9 y0 M" @1 w
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    $ r1 s: N; H8 a: C1 p/ l
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    
21.                     B.Item(0).TextString = "杭州"
    * \7 a+ B, [, Y% V. ]5 o9 u* F; i4 q5 Y
22.                     B.Item(1).TextString = "Hangzhou"
    
23.                     D.Save
    3 ]5 e; W/ ]- X& |
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    8 w/ |9 V( ?! m" }; k" a+ B
25.                     B.Item(0).TextString = "Hangzhou"
    
26.                     B.Item(1).TextString = "杭州"
    + L2 t0 q6 ?, k8 r) U  p' g
27.                     D.Save
    
28.                 End If
    - o' q5 ~; _% V0 p5 d# C
29.             End If
    
30.         End If
    $ `1 \9 m+ q2 @- B0 M# A. u* _
31.     Next
    
32.     '关闭打开的文档
    
33.     D.Close
    : z# Y! ]' f7 F1 g3 x8 F
34.     '获取下一个文件名
    1 g# e- w# x, y* j+ B
35.     FileName = Dir()
    # W+ T6 K* }( D* ~6 X5 Y! G
36. Loop
    $ i$ A0 j+ T5 I7 W4 L" {
37. 10: End Sub

复制代码

157787698

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

% X$ J, V" a7 I; o' H, t0 Y再次感谢