QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
9天前
查看: 6228|回复: 5
收起左侧

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

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

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

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

x
RT
" p6 d2 S4 T" @1 o( m, {- z2 x* {: u2 }
有一批图纸需要更改文字,但文字时以块的形式出现的,包括两行单行文字9 }4 P. ?: f$ o4 {5 o! j
2 J1 d1 \  j: x3 n" h; q
其中一行为中文,另一行为英文,内容固定
: g$ f, h3 }/ i: c+ [" l7 f3 l; V$ z1 v
比如中国杭州和Hangzhou China) o* F, I1 d  j5 t$ }- S

2 Q& q- @$ t+ A- g; ?% Q) H, a  M现在要统一改为杭州和Hangzhou* r4 I8 e( G  ~8 C

" {! \, y! z5 B4 x9 G* m: _) b6 H但块的名字不知道
8 @# b3 U2 q, p8 ?9 V+ h/ U
, d6 V4 p- q8 [# q& g" I
, n; ~+ f8 s" W2 r6 `: A; s请问如何用程序实现?请大虾帮忙,谢谢
 楼主| 发表于 2011-12-14 14:23:58 | 显示全部楼层 来自: 中国浙江杭州
自己顶下,还没解决问题,不能沉了
发表于 2011-12-14 19:27:23 | 显示全部楼层 来自: 中国辽宁
你若是真心求助,就应该提供尽可能详细的信息,比如一份DWG文件.
 楼主| 发表于 2011-12-15 13:10:33 | 显示全部楼层 来自: 中国浙江杭州
3# woaishuijia , C' |; a( O0 u+ @
, n" a+ R% d, K6 O% A5 m
最近实在是太忙了,不好意思4 \, r2 s6 T: W" u+ a0 l" l$ j1 S
中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)
发表于 2011-12-15 20:05:46 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑
9 m$ W/ _4 l1 \
% t6 e/ E, [/ S5 L  F下面的代码只针对上传的文档,仅供参考
( T6 B+ P, B% I3 U2 S& Q" Z# M
  1. Sub A()
    1 Q% H6 d) G8 M
  2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
      q  S( B( E, R) ~+ @$ T
  3. On Error GoTo 10
    6 w  S9 @  K! ^1 E
  4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录
    & p) c5 [+ ]3 K! \
  5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
    : U! Y$ T/ ?& l9 k
  6. '如用户输入的目录字符串最后一个字符为""则去掉
    3 ]! _6 d2 @6 M) G4 a2 h8 P) w0 O
  7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)+ Q, R; B8 b( q" g
  8. '逐个打开该目录下的所有"*.DWG"文档
    / ^5 J9 w4 s) i" z( B. E
  9. FileName = Dir(Path & "\*.dwg" )
    + p4 A$ O( W' t/ [5 M2 A& G" i
  10. Do Until FileName = ""8 E" e2 q! [6 @0 Z" }
  11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)9 ~7 R7 s: a, q
  12.     '遍历该文档中所有块定义& H# C) L1 y! [
  13.     For Each B In D.Blocks$ @* q3 b; O) k: g% J0 J2 W7 o3 ]
  14.         '如果该块定义中只有两个元素则进一步检查其中内容4 _! M' X; f8 K2 A& U4 I, u; V; S3 C
  15.         '否则跳过
    / @0 Q$ j- `" k( p& y) x% J
  16.         If B.Count = 2 Then2 Z' z; H# X' H1 T5 M
  17.             '检查块元素是否为单行文字对象% S: I& e8 Q7 E( A7 v1 M
  18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    / ~  \/ p% e0 y9 A& f
  19.                 '检查单行文字的内容,如符合要求即修改之,然后保存
    % ]* T0 |- H8 }, u( O+ N
  20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
    / g  ^' j  T5 f5 ?7 H0 u
  21.                     B.Item(0).TextString = "杭州"
    ' c4 F0 n: f# q( u
  22.                     B.Item(1).TextString = "Hangzhou"
    4 l6 V7 D$ ]7 x
  23.                     D.Save
    & M  \5 |, f+ q, l; Z  c1 \0 \
  24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
    $ S, ]0 r' u( u! _, }& }, _# V9 h
  25.                     B.Item(0).TextString = "Hangzhou"
    8 ]6 c; F2 s) o4 ]$ m7 j" y
  26.                     B.Item(1).TextString = "杭州"
    7 I' l8 J% x2 C1 b$ a9 \  e
  27.                     D.Save
    * r4 _4 ~! r2 ~5 s. w
  28.                 End If0 D% t! R" t" _7 x& z
  29.             End If! [- r8 \8 @$ O% Y/ v- x
  30.         End If' b' [# T. b% t5 d) r$ K
  31.     Next! B7 f' O. D8 Q+ ^! h$ T  ?
  32.     '关闭打开的文档
    ' ]% l/ O/ e4 p9 q  s/ h" A
  33.     D.Close3 O( h6 J3 t1 ]! H  y
  34.     '获取下一个文件名/ g1 d6 c: M; C  m. w% k5 h& j0 n! A- k
  35.     FileName = Dir()4 Y) M7 x. G# C6 E9 S
  36. Loop( e" n. R5 E* J3 R$ f9 V  Q3 m: g
  37. 10: End Sub
复制代码
 楼主| 发表于 2011-12-16 08:49:38 | 显示全部楼层 来自: 中国浙江杭州
非常感谢版主,问题解决了
' O8 F7 N# N: v4 N7 G) u7 J3 b% \% g( S2 `! w2 ]+ b
再次感谢
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

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

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