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

157787698

RT

) a" l9 E- z- S' D9 P# ^, B有一批图纸需要更改文字，但文字时以块的形式出现的，包括两行单行文字
! a# f9 Z* }, K, c# R+ T2 Z3 _- {8 @
其中一行为中文，另一行为英文，内容固定

比如中国杭州和Hangzhou China
" c8 o# i) A: @
  Y0 P/ X: z" G* ^( r% a# ^$ q现在要统一改为杭州和Hangzhou

5 y, @- [1 U  w" |) d8 j: N* C但块的名字不知道


, [  ^5 u! ^& Z1 k7 E# _8 \7 X请问如何用程序实现？请大虾帮忙，谢谢

157787698

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

woaishuijia

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

157787698

3# woaishuijia

( `: h% _* j: i& G$ S最近实在是太忙了，不好意思
: {/ y! f( U$ `, h; A& m7 h 中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)

2011-12-15 13:10 上传

点击文件名下载附件

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

0 k! i0 _: }0 L/ {, z! [就是将左侧的块内的“中国杭州”和“Hangzhou China”改成右侧红色框内的样子（具体见图纸），含这两行文字的块可以炸开，其他的块不能炸开
* l7 s5 k- i# @3 M8 L0 {3 m$ k
请提供帮助，，非常感谢。

woaishuijia

" Q0 v$ U7 |+ H# r5 w
下面的代码只针对上传的文档,仅供参考
4 [# s( m4 F1 H4 N

1. Sub A()
   " Y1 H0 E- P4 N7 h" q
2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
   - d( G+ Q3 x# q
3. On Error GoTo 10
   
4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
   ! [! i5 \2 H0 c, C* P# u
5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
   + L4 {0 a/ n: z0 A; ^) x
6. '如用户输入的目录字符串最后一个字符为""则去掉
   
7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
   $ c. H8 E0 A5 a
8. '逐个打开该目录下的所有"*.DWG"文档
   
9. FileName = Dir(Path & "\*.dwg" )
   
10. Do Until FileName = ""
    : J; N/ u4 B: r% o) \) K+ d9 G* l
11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
    7 h4 F% n' B: M. Y' ]) Z: {
12.     '遍历该文档中所有块定义
    / M$ Q# o4 V8 V/ M9 N1 D
13.     For Each B In D.Blocks
    
14.         '如果该块定义中只有两个元素则进一步检查其中内容
    
15.         '否则跳过
    
16.         If B.Count = 2 Then
    
17.             '检查块元素是否为单行文字对象
    + V( G$ e" P+ F, U+ ?
18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    
19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    : i; m7 H- h" {
20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    ; B( D1 u, I1 F! E
21.                     B.Item(0).TextString = "杭州"
    
22.                     B.Item(1).TextString = "Hangzhou"
    , q/ w$ ]/ n* B& o9 s
23.                     D.Save
    
24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    ; r6 M( X3 ^2 y; X) Q
25.                     B.Item(0).TextString = "Hangzhou"
    , d! y- N+ O' t6 W6 o3 Y
26.                     B.Item(1).TextString = "杭州"
    / U* G8 l# b3 `
27.                     D.Save
    % l$ c, s# {3 p( X: g  e* W
28.                 End If
    ( s4 K8 Z; \' c2 `! _: }
29.             End If
    
30.         End If
    
31.     Next
    & I6 Q% a) W8 C! E- k; x6 C! c
32.     '关闭打开的文档
    4 F7 O' v5 _' X- }5 i# y! A' r
33.     D.Close
    ; G4 A& U. I# f$ U
34.     '获取下一个文件名
    * O$ v+ `1 U1 Z/ R& T2 `0 k1 |: ?; [
35.     FileName = Dir()
    
36. Loop
    
37. 10: End Sub

复制代码

157787698

非常感谢版主，问题解决了
" L) p) @! {' N$ ~% ?7 }' m
) j# x, C% h! j再次感谢