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

157787698

RT
  K; ~6 }/ o- _5 {$ [- s
有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字
; i; W% A' w% Z! J$ K4 {
其中一行为中文，另一行为英文，内容固定
8 W3 V3 A6 i) r. s- a5 D
7 W2 I; {2 [) W$ V+ L3 s比如中国杭州和Hangzhou China

现在要统一改为杭州和Hangzhou
  V$ t  X6 @& a: Z3 @
" A. `) o# H0 ~& K但块的名字不知道
2 L2 E+ u7 a6 m% n
$ H/ w, `8 Z! C  u7 g/ F
请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia
& b0 A2 |% Q- V7 A. f; U- |6 N3 H$ J
" V% C% k! T& S8 A% C最近实在是太忙了，不好意思
) ]! j, y7 K$ k+ r# t: y- t 中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件
5 d& |+ c; T/ p% B1 W3 Y
+ T( r; i1 M8 x: F0 B7 ]图纸只是示例，由于保密原因不能将原图给出，还请见谅。
- u' U0 d" V1 u% d0 n8 H6 ]# p4 Z
3 m1 p! \5 L1 U: P& v就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开
# o( \2 b  e- ~7 @+ W6 B2 L
请提供帮助，，非常感谢。

woaishuijia

5 r$ a7 ^% J; v- A5 C# n3 |1 b: O" {下面的代码只针对上传的文档,仅供参考

1. Sub A()
   & N! f2 x- Y. c
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   3 Y9 h9 Q5 U( E! c0 k+ c
3. On Error GoTo 10
   . t+ I" `& U; m! D2 _4 C; `6 F! a
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   # a5 }2 n: o7 I8 j8 k) L- T
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   7 A# Q( E( X& `0 y* ^- m1 O
6. '如用户输入的目录字符串最后一个字符为""则去掉
   
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   
8. '逐个打开该目录下的所有"*.DWG"文档
   6 p5 p- A# u! H" l
9. FileName = Dir(Path & "\*.dwg" )
   
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    4 \- D& X2 H8 j1 o, \- V5 Y) l
12.     '遍历该文档中所有块定义
    * O: T: T9 p0 S" c+ i
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    , @3 p5 _# B8 c' z
15.         '否则跳过
    9 u. D9 n0 h9 z" K/ U0 t
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    % c' Y2 p9 X! s2 [* E& Z
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    $ Q! h( p$ [3 S- K# w0 D% k6 h
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    ; B3 P1 U; z5 H/ _% W
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    ! ]/ K& g% b1 ]0 R; i
21.                     B.Item(0).TextString = "杭州"
    6 Q6 K, I' }' g3 m& \9 ]9 _
22.                     B.Item(1).TextString = "Hangzhou"
    $ B& e6 S* x2 G- Z. S
23.                     D.Save
    9 B$ h1 {  r% V1 b$ \
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    / B* _$ c% I# s) v  ]0 {0 w
25.                     B.Item(0).TextString = "Hangzhou"
    2 n. c- A( I( L
26.                     B.Item(1).TextString = "杭州"
    $ b2 V$ }  u: g6 ]" X9 u, G5 r7 P( ]
27.                     D.Save
    
28.                 End If
    
29.             End If
    ! r9 C3 K* D' Y3 Z) W2 S* e! i
30.         End If
    
31.     Next
    6 r# t: n7 [- G
32.     '关闭打开的文档
    
33.     D.Close
    
34.     '获取下一个文件名
    / w# k3 s6 _) D/ i9 x! \
35.     FileName = Dir()
    
36. Loop
    8 r5 }8 M1 ^0 M+ Q  {* \$ s
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了
) X: _( @8 P$ j7 q1 U8 {
再次感谢