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

157787698

RT

有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字

其中一行为中文，另一行为英文，内容固定
- b, R- ~  v' D5 `
比如中国杭州和Hangzhou China
, L$ c( `$ r, D# B8 R
% A% s+ i* O: |9 B+ X现在要统一改为杭州和Hangzhou
# |; A. o2 X% _0 \. D$ B' @
7 `/ v; o7 u0 e- c8 h但块的名字不知道
: G6 z2 i3 H: {
1 c% l- f* Q- p1 i$ [4 ?+ F
6 w6 e. x$ c, h# V: {请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia

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

2011-12-15 13:10 上传

点击文件名下载附件

& c2 F3 |# ]9 a& M/ s6 `2 r图纸只是示例，由于保密原因不能将原图给出，还请见谅。

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

' M$ s" X- J6 l, B, h" q请提供帮助，，非常感谢。

woaishuijia

7 f# M7 V8 B9 O+ B# |6 I1 b8 V! I下面的代码只针对上传的文档,仅供参考
3 {: L2 v$ A& O4 H+ ~6 w

1. Sub A()
   - ?: w. q/ d: V$ y- @) }
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   
3. On Error GoTo 10
   ! R# R" O; n& K; A+ `
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   ( E6 a) U, s9 N* m; ~
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   
6. '如用户输入的目录字符串最后一个字符为""则去掉
   . \- O. i# Q! i/ L& J
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   ( E; E. ~8 n9 C0 o6 r
8. '逐个打开该目录下的所有"*.DWG"文档
   9 F! D7 z% V" B$ }
9. FileName = Dir(Path & "\*.dwg" )
   
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    % f/ I4 \# y, K/ b6 _
12.     '遍历该文档中所有块定义
    
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    & l0 h2 n$ Q4 {& J6 P$ x" a
16.         If B.Count = 2 Then
      o7 Z; `! I  j/ E4 g0 v
17.             '检查块元素是否为单行文字对象
    " ?2 R. S6 ~: t5 p7 }2 v5 y
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    5 K$ I6 G: ?4 c+ B6 r0 p
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    0 g% I* x5 v+ A. O2 Y: F, L+ f
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    
21.                     B.Item(0).TextString = "杭州"
    5 `! v. P6 m, }# z
22.                     B.Item(1).TextString = "Hangzhou"
    ) s2 e; _) Z3 r- g' g) [8 `$ ^8 ^) Q
23.                     D.Save
    
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    8 K' `0 Q/ O$ g
25.                     B.Item(0).TextString = "Hangzhou"
    
26.                     B.Item(1).TextString = "杭州"
    
27.                     D.Save
    $ k# M' o& x* }' ^- Z9 o
28.                 End If
    
29.             End If
    $ P; d. F; N5 Q; Y0 C; Z8 q
30.         End If
    7 Z/ p! P, @8 I! m) ?$ ~) }5 N
31.     Next
    7 S5 ~1 C# r( `+ v
32.     '关闭打开的文档
    
33.     D.Close
    
34.     '获取下一个文件名
    
35.     FileName = Dir()
    * y. K6 h9 Y. q" |1 C7 D8 B
36. Loop
    
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了
2 x4 \( E0 w3 }# t/ @! i
再次感谢