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

157787698 · 发表于 2011-12-7 14:54:44

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

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

x

RT

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

其中一行为中文，另一行为英文，内容固定

比如中国杭州和Hangzhou China

现在要统一改为杭州和Hangzhou

但块的名字不知道

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

157787698 · 发表于 2011-12-14 14:23:58

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

woaishuijia · 发表于 2011-12-14 19:27:23

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

157787698 · 发表于 2011-12-15 13:10:33

3# woaishuijia

最近实在是太忙了，不好意思

中国杭州改为杭州.dwg (79.74 KB, 下载次数: 8)

woaishuijia · 发表于 2011-12-15 20:05:46

本帖最后由 woaishuijia 于 2011-12-15 20:07 编辑

下面的代码只针对上传的文档,仅供参考

Sub A()7 {2 e, [' a2 d2 u
Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock9 V" M/ {5 v2 u, @0 A
On Error GoTo 104 A/ J9 R! L- P& X( V
'由用户在CAD当前文档的命令行输入需要修改的文件所在目录+ W$ D* D7 V2 U% r" V
Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )
0 J! q, U. r9 C b, U% ~3 |; j" E/ m
'如用户输入的目录字符串最后一个字符为""则去掉
$ H0 G3 t) t$ ?0 z1 L
If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1). ?6 v. e! b. w! m8 l
'逐个打开该目录下的所有"*.DWG"文档 E2 y4 y9 o3 B+ W8 Q2 V. N
FileName = Dir(Path & "\*.dwg" )
7 ~1 v, Q& J2 n L5 [3 v5 t
Do Until FileName = ""* O1 V. G" X8 j' y* b) w
Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
& U! [& ?+ w% Y3 O8 G0 P) _
'遍历该文档中所有块定义! |! Q8 l4 `% W& y
For Each B In D.Blocks: g+ t8 @5 U4 o8 l# c: \4 n
'如果该块定义中只有两个元素则进一步检查其中内容
' u, T/ S& i% [6 q# H" I' j8 a7 }
'否则跳过1 M; z- J [& w( |- |. `
If B.Count = 2 Then
) i' d q3 v$ p, X4 Y f- i6 o
'检查块元素是否为单行文字对象6 ^* L2 {9 D5 e: H
If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then, I, x+ u) Q1 z5 u- w6 F
'检查单行文字的内容,如符合要求即修改之,然后保存5 R. ^3 Q0 y) H
If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then
3 H) _0 `- i0 e* J. Y3 P# t/ b! X
B.Item(0).TextString = "杭州", ^ ]) Q( T) E H2 M# `7 Z9 y
B.Item(1).TextString = "Hangzhou"$ H8 j4 Z! L2 p) C! N7 a
D.Save
/ `9 Y) V7 D M6 {; E+ O
ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
, \; T6 _: |- J
B.Item(0).TextString = "Hangzhou"
, ` g6 v/ Z% W, F1 A9 N$ p
B.Item(1).TextString = "杭州"# J4 E6 h) c" _8 w$ g* ^3 O, n
D.Save* c7 w) r# P& g" _: B% z2 \
End If( C0 J0 }4 z8 y0 @/ a" _
End If
1 [! @8 o( I: Y0 |
End If
2 j% S5 C- q& ?$ L6 @
Next" [8 T0 _" v+ j; X. |, d
'关闭打开的文档: T; F5 |. u7 ?
D.Close8 T) g9 o& o0 @1 m) ?
'获取下一个文件名
# n9 ^5 k: Y/ [4 ]
FileName = Dir()
: E, ]: s h6 h1 A+ G
Loop
! [( q* s% ]. _$ I( k' `
10: End Sub

复制代码

157787698 · 发表于 2011-12-16 08:49:38

非常感谢版主，问题解决了

再次感谢

		自动登录	找回密码
密码			注册

通知

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

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

浏览过的版块