QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 6295|回复: 5
收起左侧

[已答复] VBA:如何查找并替换块内文字?

[复制链接]
发表于 2011-12-7 14:54:44 | 显示全部楼层 |阅读模式 来自: 中国浙江杭州

马上注册,结识高手,享用更多资源,轻松玩转三维网社区。

您需要 登录 才可以下载或查看,没有帐号?注册

x
RT
- u+ R# L/ p- k5 \8 \$ ]; \3 d3 O4 d1 ^" [
有一批图纸需要更改文字,但文字时以块的形式出现的,包括两行单行文字
  I/ k/ j  U. g' t+ k; D8 [8 k2 f% {: J1 R6 \3 u
其中一行为中文,另一行为英文,内容固定+ A* z' c2 r$ @0 o  {  J$ Y' _

8 o2 `" D$ O+ i1 c4 n+ r" _比如中国杭州和Hangzhou China* A9 \* A* f- C! f) e0 N* l

& [* A" }1 ^" `现在要统一改为杭州和Hangzhou' J# V( ]  {$ d) m) O; m) P

+ `* Y/ ~! [" x- o& A但块的名字不知道
: C* |* [- z/ ?1 b9 B3 |* v# l& j2 N$ h8 M3 O/ R7 D' ?! E
( b/ K2 |; A3 N7 ~: z* x0 w
请问如何用程序实现?请大虾帮忙,谢谢
 楼主| 发表于 2011-12-14 14:23:58 | 显示全部楼层 来自: 中国浙江杭州
自己顶下,还没解决问题,不能沉了
发表于 2011-12-14 19:27:23 | 显示全部楼层 来自: 中国辽宁
你若是真心求助,就应该提供尽可能详细的信息,比如一份DWG文件.
 楼主| 发表于 2011-12-15 13:10:33 | 显示全部楼层 来自: 中国浙江杭州
3# woaishuijia
- I& R5 g) z2 @) J+ i! l
+ W+ D* x0 W: n7 m+ u最近实在是太忙了,不好意思) h0 {) Z1 W- {* X$ p6 L
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)
发表于 2011-12-15 20:05:46 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑
0 ]9 j  M: L5 k$ h/ L
4 [/ X5 K$ p! P, s2 m! g下面的代码只针对上传的文档,仅供参考2 @+ |$ m8 g8 c7 r+ o
  1. Sub A()! B. t, c' v% s1 ^5 n) L0 R
  2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock- Q. D( c0 B9 _7 M
  3. On Error GoTo 100 J) g/ J1 G" _( r& W
  4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
    2 N- ?9 H! {2 W1 p
  5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )) n! I/ a5 T: k: q+ F& |. i) M* c
  6. '如用户输入的目录字符串最后一个字符为""则去掉9 A  l- a7 G" n$ m& M9 H# [- A
  7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
    1 W. X7 T! g; H. ~
  8. '逐个打开该目录下的所有"*.DWG"文档
    + C4 ~( {+ ~/ J5 L$ I( Y7 P
  9. FileName = Dir(Path & "\*.dwg" ). {0 V3 L" C6 c& m$ H" ~3 J+ s
  10. Do Until FileName = ""
    1 L4 K6 m- n5 W& Y
  11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)' r$ U4 S  ?9 Q8 U0 b
  12.     '遍历该文档中所有块定义/ Z6 [7 [" N5 F$ B0 W3 y# g
  13.     For Each B In D.Blocks
    9 u) ^! U: k, A
  14.         '如果该块定义中只有两个元素则进一步检查其中内容
    ) P/ f. N/ s5 P$ f. L) q: G  w
  15.         '否则跳过  Y2 h! I1 s4 X7 @. }
  16.         If B.Count = 2 Then" N8 B" E7 W; r3 R
  17.             '检查块元素是否为单行文字对象
    2 b" j% W: ?7 U1 W( g, }
  18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    $ O  }$ F  T) _
  19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    , O; q7 m1 a/ ~8 z$ l' \8 X, T
  20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    ! F/ y$ }+ i& v# @' I/ @
  21.                     B.Item(0).TextString = "杭州"
    7 R3 V' }* `1 P2 z2 s8 a0 @( Q$ j
  22.                     B.Item(1).TextString = "Hangzhou"
    / o0 S! N& R5 x: N6 e
  23.                     D.Save# F+ U* o9 k: K# N- u7 |4 b6 q- \' n
  24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then8 \2 n3 F( \1 K" T, C
  25.                     B.Item(0).TextString = "Hangzhou"
    ; s, z$ X1 C- v4 H, H1 P8 y
  26.                     B.Item(1).TextString = "杭州"( E/ l" ]$ t: q( L& l
  27.                     D.Save9 [: X$ j- E5 B4 D5 H
  28.                 End If
    ; o& Y  G8 U8 z7 W8 D
  29.             End If
    ( L$ j, o8 k5 T% L4 _
  30.         End If
    & }( g7 j3 d9 |+ d! P9 a
  31.     Next# e( i  M. Z! a- d/ Y5 n2 [' O7 r' Q7 _
  32.     '关闭打开的文档
    ; l' ]. A4 N% a" g+ i; y% a' T
  33.     D.Close
    2 o  r. |! d. ^9 I+ Y$ {7 F- e; Q
  34.     '获取下一个文件名
    6 x7 ^# K9 l0 _2 E! u0 G; c" l
  35.     FileName = Dir()
    5 a" p9 _6 u4 q6 B' x6 v, ^
  36. Loop
      \6 Z. d8 I+ s+ I$ C; t9 V2 w
  37. 10: End Sub
复制代码
 楼主| 发表于 2011-12-16 08:49:38 | 显示全部楼层 来自: 中国浙江杭州
非常感谢版主,问题解决了
7 w' w! K. E! Z; e
2 T# q/ a' [/ B2 v5 H' Z再次感谢
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

快速回复 返回顶部 返回列表