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

157787698

RT

8 U7 {0 T; H/ q: A有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字
* l" }0 X8 I. Q( s6 s) T) D3 x* n% g
" l# L2 A2 @# @! Y- F6 c( Z8 v其中一行为中文，另一行为英文，内容固定

比如中国杭州和Hangzhou China

现在要统一改为杭州和Hangzhou

& m& l4 }( t, _* N! ]9 \# w但块的名字不知道
7 i$ e8 l+ D3 X. _
* A8 x( r4 `% M# G9 k
, H! `# `: t; L/ r9 L8 m6 U( K请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia
0 h! o! C( V" J5 C2 U- ]1 T" `& @
最近实在是太忙了，不好意思
) w5 {& b5 b5 I6 [3 W; C  c 中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件

图纸只是示例，由于保密原因不能将原图给出，还请见谅。
  U8 i" x2 v! k& L1 J0 p. D
7 L. _/ u( P4 a4 j. J就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开

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

woaishuijia

下面的代码只针对上传的文档,仅供参考
) h6 [+ w6 o) }' l! E* r

1. Sub A()
   4 X. d$ o. t- E% e' r# E
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   
3. On Error GoTo 10
   ' I' s- ^* M! v0 }  L1 U
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   $ ]% J* j1 t* b5 E% B
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   
6. '如用户输入的目录字符串最后一个字符为""则去掉
   
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   $ F. B* X8 }/ A, ^
8. '逐个打开该目录下的所有"*.DWG"文档
   , j: E: O7 g. R
9. FileName = Dir(Path & "\*.dwg" )
   ( J5 C+ W1 [' _
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    ; U5 I6 n% s5 [
12.     '遍历该文档中所有块定义
    
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    6 i/ w4 h4 ?2 g9 R3 \: s
15.         '否则跳过
    " S. D9 A% q+ s. ?( \8 D, O4 D
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    7 g: R" U0 h( E/ o# g
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    
21.                     B.Item(0).TextString = "杭州"
    3 d) h2 h! I$ Y' ~
22.                     B.Item(1).TextString = "Hangzhou"
    4 F2 F; w4 h) }4 e0 t
23.                     D.Save
    $ W5 r$ g! [/ D; E& _
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    2 S, f, R! D' T* j; S
25.                     B.Item(0).TextString = "Hangzhou"
    5 U( z& j1 `6 D1 P
26.                     B.Item(1).TextString = "杭州"
    . X/ {. E3 C, D/ d7 u4 I
27.                     D.Save
    8 G  V9 D; j+ d) _: A( O8 s% U0 z3 f
28.                 End If
    
29.             End If
    
30.         End If
    
31.     Next
    3 e8 G7 x) r5 ^
32.     '关闭打开的文档
    % L% h) ?# R1 J5 Y
33.     D.Close
    
34.     '获取下一个文件名
    
35.     FileName = Dir()
    3 h; _& W; n) a( e" n  Q8 N
36. Loop
    . a/ ]1 L! @, a3 [1 ]
37. 10: End Sub

复制代码

157787698

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

再次感谢