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, 下载次数: 6)

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

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

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

Sub A()* }+ v* X/ i3 J( i
Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock$ }1 g0 O+ B: ]+ Z' f- e
On Error GoTo 10
( b4 t1 H' F2 i9 T% m8 [* Y
'由用户在CAD当前文档的命令行输入需要修改的文件所在目录
7 a) l- c- c! C5 n+ |; c0 v4 T
Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )3 Y' G3 w; x. y9 w) R% [
'如用户输入的目录字符串最后一个字符为""则去掉
2 q( i$ b$ k6 c. @/ x
If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)6 O3 y8 ?0 m. m7 H
'逐个打开该目录下的所有"*.DWG"文档( k. _$ C& J/ I. Y7 I+ l3 j
FileName = Dir(Path & "\*.dwg" ), ?& p, o' }! [* ^
Do Until FileName = ""9 j. N( | S7 j$ M
Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)- \/ a# X" |$ D3 S" }
'遍历该文档中所有块定义
$ S' b( H' ]. v7 G
For Each B In D.Blocks
6 h) z& \0 R8 B; {, {& B
'如果该块定义中只有两个元素则进一步检查其中内容; s8 S( }1 c& u0 ~/ u) |1 _. f
'否则跳过- e1 ^0 e2 i) v8 A# a
If B.Count = 2 Then
3 W; m3 v' L1 D' `7 C' q3 d- g- Q
'检查块元素是否为单行文字对象
/ S. T5 s) a8 {
If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then/ {1 Y. [5 f8 V o2 a4 g
'检查单行文字的内容,如符合要求即修改之,然后保存; q @- H+ n0 B& C+ R
If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then8 B% h9 {" `" W2 M9 b
B.Item(0).TextString = "杭州"$ S* _5 S0 S) J! F) e$ R
B.Item(1).TextString = "Hangzhou"0 S7 ~# a: Y: W
D.Save
" r4 `) m: e0 E
ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then
6 `* L; Z# A k% \! Q
B.Item(0).TextString = "Hangzhou"
& N9 n: J+ M- h$ r: K$ p$ f) H
B.Item(1).TextString = "杭州"
! a* r8 k+ a {
D.Save
4 q' P2 ^4 Z0 P! U3 v/ ^& P% Y
End If! D& r8 \6 l" y' J% [0 c" X
End If4 u/ |) t' w, j9 W ^6 m* u" l
End If
( I: p' i) a R! f5 d. \9 W0 g& M
Next
0 r1 F/ \) I2 r3 h) m" ^( h+ `5 X
'关闭打开的文档
, n4 e' g5 e5 Z
D.Close! p& i1 N$ }: X& u9 N5 b6 v
'获取下一个文件名, s& I, f! g5 ~! ^4 P
FileName = Dir()
5 e2 |7 v6 P' ^. I! v+ c
Loop: j) i- ]: r8 `6 {0 _) H
10: End Sub

复制代码

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

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

再次感谢

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

通知

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

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

浏览过的版块