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

157787698

RT
9 |! W$ P  X# S* N% G) a0 ?
有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字

其中一行为中文，另一行为英文，内容固定

" V! r) v: H$ e0 k% N比如中国杭州和Hangzhou China

现在要统一改为杭州和Hangzhou
# r7 U' ]1 j0 K8 V  k7 y3 `7 Q/ y
" t4 _+ m, A! K, ~; f但块的名字不知道

9 l- y0 g+ s, @- @7 F  a3 m# d' l
5 w0 q! q$ L. h' m# c% t3 W请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia

% z: N  t! }2 t: m9 K9 X) B最近实在是太忙了，不好意思
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件
* b* \/ n1 o' z! o: t
! H3 i* Z! I) y( Y图纸只是示例，由于保密原因不能将原图给出，还请见谅。

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

! T! D) m. b4 H1 O请提供帮助，，非常感谢。

woaishuijia

3 b( b$ }3 C8 r$ t) Q3 N
下面的代码只针对上传的文档,仅供参考

1. Sub A()
   / u/ s9 a$ Z3 P# L
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   
3. On Error GoTo 10
   
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   
6. '如用户输入的目录字符串最后一个字符为""则去掉
   
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   " s# d, [/ x0 ^2 x- h6 o
8. '逐个打开该目录下的所有"*.DWG"文档
     |8 z  l& Q+ ?  s
9. FileName = Dir(Path & "\*.dwg" )
   : h; F8 H  z9 g) X
10. Do Until FileName = ""
    ( P/ N. `+ E) f8 Z3 g: d
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    3 Z! n9 h' W6 v' V* J
12.     '遍历该文档中所有块定义
    % p! t. I/ L" s9 |5 R# m; }
13.     For Each B In D.Blocks
    2 r$ N: ~: m# A* J, ?( N
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    ( P( j  D% x9 r
16.         If B.Count = 2 Then
    7 s8 a, K- q' E' x/ L/ l/ M# G, @
17.             '检查块元素是否为单行文字对象
    * n+ Q' D3 w* o5 w  z& a& t  F
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    . p8 b8 m. G( x& s
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
    - F' O/ u# k# b* n! ^% Z& F
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    " Y  A4 @9 j5 d$ l/ O1 [
25.                     B.Item(0).TextString = "Hangzhou"
    $ Y3 o' i$ a4 q. ]0 X+ z$ H
26.                     B.Item(1).TextString = "杭州"
    $ m4 {1 _$ D9 Q; D1 O2 p
27.                     D.Save
    7 l, s/ v/ X4 `+ O/ P; S
28.                 End If
    
29.             End If
    ( {5 b$ g) N4 H4 [5 ]
30.         End If
    - C1 [; \- m4 Y6 E& R1 d
31.     Next
    
32.     '关闭打开的文档
    3 W: h9 W  E4 P" ?. Z) o" ^/ x' j
33.     D.Close
    
34.     '获取下一个文件名
    : Q" ~8 j, V/ Y0 J' W3 C
35.     FileName = Dir()
    
36. Loop
    & D4 ]* X$ D9 }  q. r. J% `
37. 10: End Sub

复制代码

157787698

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

. ^6 E* }. x1 g5 S* g: D6 n2 k再次感谢