QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
RT
& X3 s9 A, V8 U9 q% o3 D  g  j) Q+ E4 `5 B
有一批图纸需要更改文字,但文字时以块的形式出现的,包括两行单行文字
) {0 Q# n$ [# A' ^2 z2 `
- ~. Y. t' H& o% A其中一行为中文,另一行为英文,内容固定5 c  }$ \8 S5 ?
8 K9 Y" h, ~' I7 u7 Y
比如中国杭州和Hangzhou China; ^3 }) U: s* ]8 f% Q! Y% L) T1 q
; M1 A$ J8 G- o
现在要统一改为杭州和Hangzhou
( x' l( C6 Y$ [/ R) S' l* x4 m
7 U& ?, B. l1 q, t% ~  E9 }但块的名字不知道
2 N( r9 \! d) ]. P: n. @' Y+ z% N" F& s* g* f" M- g# K

2 b( F0 F8 Y& p; p* W请问如何用程序实现?请大虾帮忙,谢谢
 楼主| 发表于 2011-12-14 14:23:58 | 显示全部楼层 来自: 中国浙江杭州
自己顶下,还没解决问题,不能沉了
发表于 2011-12-14 19:27:23 | 显示全部楼层 来自: 中国辽宁
你若是真心求助,就应该提供尽可能详细的信息,比如一份DWG文件.
 楼主| 发表于 2011-12-15 13:10:33 | 显示全部楼层 来自: 中国浙江杭州
3# woaishuijia - F7 U( U3 Z4 j% P9 L% T
+ S! d. G! \# C6 J& }9 l: P
最近实在是太忙了,不好意思
' k" ]7 X; b7 e5 w! y 中国杭州改为杭州.dwg (79.74 KB, 下载次数: 6)
发表于 2011-12-15 20:05:46 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑
7 Z2 w8 t; k8 h  e
7 I& y: Y; L* i9 `( y下面的代码只针对上传的文档,仅供参考' y, Q1 L/ P: e$ f% \
  1. Sub A()1 K# ]0 X2 \. u- f; ?
  2. Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
    9 d+ ]( `& F' L
  3. On Error GoTo 10  `6 C3 [) ~; w9 X4 a# v( b
  4. '由用户在CAD当前文档的命令行输入需要修改的文件所在目录( m& Q4 K, u5 }4 O0 o6 f1 x
  5. Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )) J8 }: w& q7 D$ r# b% k/ ]
  6. '如用户输入的目录字符串最后一个字符为""则去掉
    + M" p7 \( @4 O+ x
  7. If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
    , U# C; l$ v; j' ?
  8. '逐个打开该目录下的所有"*.DWG"文档
    1 Y& F( ?1 [* M, t' X" |
  9. FileName = Dir(Path & "\*.dwg" )
    0 ~) o6 ~5 O3 h  T
  10. Do Until FileName = ""
    % j0 E& a- n& g- E2 p
  11.     Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)4 k- x9 M5 w! \5 a7 t7 J
  12.     '遍历该文档中所有块定义
    ' \( K5 g8 F4 y
  13.     For Each B In D.Blocks; A4 ?' A( W5 N7 P: T
  14.         '如果该块定义中只有两个元素则进一步检查其中内容; \2 j, k, `8 q9 J
  15.         '否则跳过8 I3 `6 [8 l& k2 r- U$ p
  16.         If B.Count = 2 Then
    , S4 J" ^+ o( F# J' Z
  17.             '检查块元素是否为单行文字对象
    : ~2 d5 \' H# J0 W
  18.             If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then
    + j7 U8 K: m0 V9 n8 G; R
  19.                 '检查单行文字的内容,如符合要求即修改之,然后保存1 h8 ]- ~2 ^; R# X! ~
  20.                 If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then  d8 Y! V9 u% o7 j- Z% T: i" c- t
  21.                     B.Item(0).TextString = "杭州"2 i5 H! b/ R6 `: {
  22.                     B.Item(1).TextString = "Hangzhou"
    % i- t1 I; W( X% ]% j
  23.                     D.Save  a- F  V' N. w2 ?7 _8 ]6 P: o
  24.                 ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then- W/ x# T5 p! c+ c9 ]
  25.                     B.Item(0).TextString = "Hangzhou"$ ~4 C7 V5 l. d! M4 G2 \
  26.                     B.Item(1).TextString = "杭州"9 b6 S: o! h6 R  t& I) l
  27.                     D.Save
    7 x4 ~: Q- H4 q  g. x9 n0 e- o
  28.                 End If& i( J9 F1 w0 M' T: ?9 S: a9 @1 H
  29.             End If7 i. m3 f% C  L  e& }6 A
  30.         End If
    + _  O4 P' \3 Q$ S9 o- y
  31.     Next
    8 c* a% N/ _0 g% k
  32.     '关闭打开的文档
    6 c9 P! O0 y- k. q( r0 P
  33.     D.Close
    6 o( P7 m( @9 h: O# Q0 [
  34.     '获取下一个文件名: C/ e% t, }( O" n, o! W
  35.     FileName = Dir()
    9 r- W& ~) L& I7 [
  36. Loop
    ; R% d. s. D' y' E1 I+ w+ |
  37. 10: End Sub
复制代码
 楼主| 发表于 2011-12-16 08:49:38 | 显示全部楼层 来自: 中国浙江杭州
非常感谢版主,问题解决了
* K  \+ o  _& K
8 y9 g7 o. S; d$ v再次感谢
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

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

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