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

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

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

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

Sub A()+ M1 K: m: L5 Z0 D0 T7 M+ }
Dim Path As String, FileName As String, D As AcadDocument, B As AcadBlock
8 k2 U" r7 \; J ~8 A! F0 r
On Error GoTo 10- L0 r9 N" x4 U& c9 @
'由用户在CAD当前文档的命令行输入需要修改的文件所在目录
- z- T1 w( p. c
Path = ThisDrawing.Utility.GetString(True, vbCrLf & "指定文件所在目录:" )0 s1 `6 f( a7 a V! S
'如用户输入的目录字符串最后一个字符为""则去掉
' O! t0 Y3 g! G4 A" i, }
If Left(Path, 1) = "" Then Path = Right(Path, Len(Path) - 1)
+ G! e, ?1 ?' P3 s# }, X; n2 j
'逐个打开该目录下的所有"*.DWG"文档2 d: B8 S% M' M% Q+ Q* \3 Z
FileName = Dir(Path & "\*.dwg" )2 ^* k/ N+ D, Y% T+ [+ p( D! d. x
Do Until FileName = ""
2 t' u! ]8 j$ |6 w
Set D = ThisDrawing.Application.Documents.Open(Path & "" & FileName)
' w/ e# \% u( S. G% s1 J# Q
'遍历该文档中所有块定义
0 k6 r. [# o) C# x x
For Each B In D.Blocks
" y( f* d8 X* y) u4 z) L
'如果该块定义中只有两个元素则进一步检查其中内容
8 X# W$ u& ^ e6 R0 ] O Z% ?
'否则跳过
, u6 I2 ]* V) ?' x; g% J0 T0 P& x
If B.Count = 2 Then
. ^, L& F0 h/ {; Y- u
'检查块元素是否为单行文字对象
* Y4 J2 U q7 o+ ?7 T, q8 J4 n+ r) k
If B.Item(0).ObjectName = "AcDbText" And B.Item(1).ObjectName = "AcDbText" Then- w; h4 e8 E3 j( d5 |/ Y
'检查单行文字的内容,如符合要求即修改之,然后保存
) [8 i7 c2 G2 F+ t u9 ~
If B.Item(0).TextString = "中国杭州" And B.Item(1).TextString = "Hangzhou China" Then# c+ F# i7 \7 Y- m* j
B.Item(0).TextString = "杭州"1 P+ x E$ d0 F# {1 Y! J* Q
B.Item(1).TextString = "Hangzhou"
* g) x, |4 q0 ]1 K
D.Save
: o. K; s$ d' G2 q" u. K
ElseIf B.Item(0).TextString = "Hangzhou China" And B.Item(1).TextString = "中国杭州" Then/ }7 c% }7 u5 I$ G
B.Item(0).TextString = "Hangzhou"7 F) y& [0 H6 m* u) e
B.Item(1).TextString = "杭州"* Q4 L, x6 A% b/ E# c& U
D.Save
6 i& f# f8 g; }
End If* `7 K) v6 e' X9 B7 w
End If" _8 A: R. x9 p* q: d
End If
* [" h6 o8 K; {8 N8 X. z3 R
Next
* r8 D2 L) u& z* a% F: m
'关闭打开的文档7 G) c* ^: e$ V
D.Close8 V2 W: k1 E" H: z; \% Z4 z
'获取下一个文件名
8 i1 U: z( l) d s4 L" L& @
FileName = Dir()
u% g5 C: ~' x: L7 \0 \! b
Loop! }! y& o/ m, x0 v9 a8 v
10: End Sub

复制代码

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

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

再次感谢

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

通知

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

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

浏览过的版块