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

157787698

RT
! B3 j6 y- p: b. \3 _
) h+ C6 X  [! \2 ?0 m有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字
# m2 Y* v! [9 I# q* Q8 F4 W! t
其中一行为中文，另一行为英文，内容固定
& I, y9 |# F+ K% c
2 B- v# v( x) L% g- B1 \3 ]比如中国杭州和Hangzhou China
" m: I$ ]1 Q' k2 U$ e
4 D1 o5 c+ h! ?' |. l现在要统一改为杭州和Hangzhou
5 d9 w- ?7 U1 P$ a" w
4 n) o% q* a( \, e' l但块的名字不知道


) C6 t' w7 K$ b请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia

+ ~. y/ Y+ _& i. I, b# R- ?+ \最近实在是太忙了，不好意思
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 7)

2011-12-15 13:10 上传

点击文件名下载附件

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

" @9 e. l5 f% u8 Y' c' T% L& b# ?就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开
/ x3 o4 Q! ~* x5 _8 \7 p
请提供帮助，，非常感谢。

woaishuijia

) f( @% L3 m9 O% U
下面的代码只针对上传的文档,仅供参考
# t  t1 i7 `) }- S" n

1. Sub A()
   $ {& V* u' x4 p+ g" K% L
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   
3. On Error GoTo 10
   6 n! O. X- c4 M1 h9 S% A9 R
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   5 y& Q+ H7 g. j
6. '如用户输入的目录字符串最后一个字符为""则去掉
   & P5 Z5 Q0 n5 j6 ?. q
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   
8. '逐个打开该目录下的所有"*.DWG"文档
   
9. FileName = Dir(Path & "\*.dwg" )
   
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    , v. U0 Z- K- U7 M
12.     '遍历该文档中所有块定义
    
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    3 J$ P' a( B5 z9 c. J* c
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    
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 = "杭州"
    
22.                     B.Item(1).TextString = "Hangzhou"
    
23.                     D.Save
    
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    ) M' y  v' ?0 m% B
25.                     B.Item(0).TextString = "Hangzhou"
    " a, O' A8 B' n" i0 n# n
26.                     B.Item(1).TextString = "杭州"
    8 G2 y8 M& [, _2 H
27.                     D.Save
    ( {. C+ j. g; K* l1 b5 F
28.                 End If
    / t; `' {0 h% Q6 R2 J. P
29.             End If
    
30.         End If
    4 m% `- j- y7 C/ X* u5 p
31.     Next
    
32.     '关闭打开的文档
    : L. j; [' }- g, x- ?
33.     D.Close
    * i, O1 h: E1 w7 v8 N8 z; |* F' L4 W( s
34.     '获取下一个文件名
    % E  Q* T: f4 C9 |& J  [
35.     FileName = Dir()
    5 r2 J. W+ c0 j* V5 {) f
36. Loop
    
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了
: D: j2 X/ U6 H7 J% w; ]
0 Q; y1 L  P+ N& ~再次感谢