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

157787698

RT

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

( e5 x: \0 c1 S3 \, g# ~$ i其中一行为中文，另一行为英文，内容固定

比如中国杭州和Hangzhou China

, R0 r% y& ^" d+ N现在要统一改为杭州和Hangzhou

但块的名字不知道


请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia
7 J2 C1 F+ t* @* n) f2 t0 N8 e
最近实在是太忙了，不好意思
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件
" k! O) p! p7 {$ x
图纸只是示例，由于保密原因不能将原图给出，还请见谅。

! c5 ]) G+ t0 v就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开
1 \& s2 ~$ y4 d' U' S! `
请提供帮助，，非常感谢。

woaishuijia

1 P: p4 G, H( r6 G) H下面的代码只针对上传的文档,仅供参考

1. Sub A()
   
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)
   $ T9 H; x) ?7 O  p9 b
8. '逐个打开该目录下的所有"*.DWG"文档
   7 t- E; S  {8 _3 v2 x, A) k: F
9. FileName = Dir(Path & "\*.dwg" )
   ! l6 m5 U  O3 r
10. Do Until FileName = ""
    
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    ) X0 h6 {6 D( K' Q0 v3 p6 z
12.     '遍历该文档中所有块定义
    ' b/ l. ?6 b+ n1 f) i6 O
13.     For Each B In D.Blocks
    # i$ A  }$ x% c9 O& o. I
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    2 P3 [6 _2 ^. w/ _' w' u4 p# [! U
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    ) l+ c1 v% `! ]5 w
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 = "杭州"
    2 U, _/ |& ^, E0 U$ n/ a
22.                     B.Item(1).TextString = "Hangzhou"
    % Q4 m% ^( Q; L0 A" q3 R
23.                     D.Save
    2 |2 Y- w# c% F" m
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    3 p7 o. E, o4 {3 e- X
25.                     B.Item(0).TextString = "Hangzhou"
    3 f% P7 B) h: c" s  r# U. z7 ^' w
26.                     B.Item(1).TextString = "杭州"
    
27.                     D.Save
    
28.                 End If
    
29.             End If
    9 f$ T  P& y) `4 ?2 ]7 h/ V' M
30.         End If
    
31.     Next
    # R& ]5 _5 L! M2 y5 a! `0 C) j3 G
32.     '关闭打开的文档
    ; T. Q; Y5 i) C
33.     D.Close
    0 z- K( w. N4 E0 _0 ]
34.     '获取下一个文件名
    1 S8 W' E: G. F
35.     FileName = Dir()
    % _+ O, A& `5 l
36. Loop
    + a! {  l# A0 H/ |. K  _0 `. k
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了
! M" q: c5 m; K1 L  x+ O
再次感谢