CAD_VBA怎样文字查找替换并排序？

taqqug · 发表于 2011-3-24 21:10:33

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

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

x

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
功能：
1.查找-替换
2.加编号排序
2我不知道咋怎？

         文字       文字                                           文字02          文字03

文字                            文字 ----------------  文字01                               文字04
         文字                                                             文字06
                        文字                                                                文字05

taqqug · 发表于 2011-3-24 21:15:04

最好给出代码，谢谢了!

woaishuijia · 发表于 2011-3-25 00:23:55

是否可以这样:
遍历所有文字对象并分别对其X和Y坐标加总平均,找出所有文字对象的几何中心点,再计算出所有文字对象相对于此点的角度,排序,按排序结果替换.
下面的代码仅供参考

Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, V As Variant, P(2) As Double, A() As Double, I As Integer, J As Integer, D As Double& t% F b% a+ U8 w
With ThisDrawing) U+ G( O9 [" j: [
'创建选择集,用于选择所有文字对象
t7 v2 _/ v1 \* p' O0 u
Set SS = .SelectionSets.Add("SS")
& M# N4 ^/ Y$ w+ ^5 `, w
'定义过滤器为选择单行文字对象
i A. e6 R" h% Q: @' _. G L
Ft(0) = 0. g( U7 [1 s- A0 \
Fd(0) = "TEXT"8 C, l5 y% w0 R& { _( K: R3 J
'选择所有单行文字对象: |- y) E$ x! q# w. s1 ?, m
SS.Select acSelectionSetAll, , , Ft, Fd
" V, g3 {7 ?' F0 ]: }, H
'当存在单行文字对象时排序和替换
4 L- V* M+ i; s- h
If SS.Count > 0 Then0 H8 F0 U3 } e
'计算所有单行文字的几何中心- l% ]' ?! t# C2 v5 D' K
For I = 0 To SS.Count - 1$ ], H( t. V7 h: v1 X+ Y; ]
V = SS(I).InsertionPoint
# u* U% r, \; o* Y
P(0) = P(0) + V(0) / SS.Count
P(1) = P(1) + V(1) / SS.Count& J3 Y( m4 P: _: T4 `" r, n
Next4 F; B9 i2 v. }- ^+ k3 U* u8 [0 e5 T
'重定义动态数组下标
/ {6 o2 _6 G9 y+ ?4 x
ReDim A(SS.Count - 1, 1)! [# N1 T% i& h1 s8 K; c2 {
For I = 0 To SS.Count - 10 o( G& ]1 ^! t3 w6 z: k
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号 }7 X3 C* A' v0 z
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)8 f1 j0 D3 N2 K* R) m5 A F+ M
A(I, 1) = I
8 o' K4 a- _4 C( ~% u* ~* o0 W% J' N
Next
. Z3 a( O2 v0 C: c; U/ u7 ?: j
'按角度从大到小的顺序排序
6 J; ^9 e' }& @/ w7 M
For I = 0 To SS.Count - 2/ n. j8 q) a- Y8 d, r
For J = I + 1 To SS.Count - 1
6 `+ t: ]2 g1 P
If A(J, 0) > A(I, 0) Then
" x! j/ N* {- ]8 ?2 u9 g
D = A(J, 0)" G1 F; R9 E, b3 ]% }% l! P0 ]6 Q
A(J, 0) = A(I, 0), F3 z6 g W3 I- s. z: S9 s# j
A(I, 0) = D$ e9 q K$ L1 ]5 H* j/ O }+ q! I, G
D = A(J, 1)) L2 P+ p2 P/ q6 x+ S
A(J, 1) = A(I, 1)+ I* u+ n ~) U b5 x
A(I, 1) = D; d) u$ ]9 `; Q* ?
End If
: @: y4 B6 b1 o. b. `& Q2 z$ ]
Next7 q' X6 b$ a, O d+ Q V, ^
Next% z: a' F% m: }
'替换
/ {% i0 ~# n5 C" _
For I = 0 To SS.Count - 1, e' x q2 p5 t& d: W
SS(A(I, 1)).TextString = I + 1
) k1 R2 N; t/ O
Next
; [1 Z7 z/ B9 P. S* F& F
End If
, `5 r" W5 D/ d/ s, G. J1 Y% Q
'删除用过的选择集6 i; M, a% @ U! e% m
SS.Delete% A5 c0 o& r8 k$ ~* [
End With

复制代码

taqqug · 发表于 2011-3-25 10:25:55

woaishuijia 你这个思路太好了，我用坐标比较，整了半天没整好，非常感谢！

woaishuijia · 发表于 2011-3-25 12:23:08

我又想了一下,只用加总平均的办法计算中心点未免有点太单一了.如果增加一个选项,由用户在屏幕上指定中心点会更好些

Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, V As Variant, P(2) As Double, A() As Double, I As Integer, J As Integer, D As Double
3 ?% _5 G; I) x4 c# l& t9 d
On Error Resume Next
& G8 I+ I* Y3 b, a, T5 p+ q
With ThisDrawing3 }- \3 E* m- }& }' h% l
'创建选择集,用于选择所有文字对象; T( j7 R1 E- y
Set SS = .SelectionSets.Add("SS")
7 T+ M1 P* [+ o! ~
'定义过滤器为选择单行文字对象1 `) }- |0 N% I7 y. b4 b6 [- e
Ft(0) = 0
- m6 q9 X$ |6 B* u1 c9 d
Fd(0) = "TEXT"6 ` }8 u! n q! r5 Y# ?9 Q7 v
'选择所有单行文字对象
8 z( r2 T& E. x$ c! i8 r
SS.Select acSelectionSetAll, , , Ft, Fd% u: j+ C* U* b6 A+ s% i# o1 X
'当存在单行文字对象时排序和替换: r; J/ p$ W0 \$ ` K" _5 g9 C1 q4 J
If SS.Count > 0 Then
% j0 Y6 j1 r& M
'由用户在屏幕上指定中心点) s* }7 Y* b( n/ h# b% z; K
V = .Utility.GetPoint(, "指定中心点<默认>:"): ~9 [6 I5 g. U3 i- B* V
'如果用户没有取消则排序和替换
8 w2 j p: A: a. B' z$ s
If Err <> -2147352567 Then% O+ h% \+ ^- Q& V
'用户指定了点
2 z! R) }3 b& Z% n7 E
If Err = 0 Then. o# J. w4 u" l: C4 B1 `
P(0) = V(0)
6 j3 q \4 N: n1 L+ N# ~
P(1) = V(1)4 c5 n; v, D% Y
'用户选择了默认
# O6 b5 E5 R) C# Z# K5 E3 w- @
Else
- ]4 o6 N: F# t& q
'计算所有单行文字的几何中心% q$ ?# e, \8 R7 X% Y& R
For I = 0 To SS.Count - 1
: x4 E! H& y! f0 d1 k& F' o4 ?
V = SS(I).InsertionPoint
# O5 S2 p# H4 `5 _% S7 o
P(0) = P(0) + V(0) / SS.Count
8 W8 Y- v$ a0 ~ |# `" z5 x1 A
P(1) = P(1) + V(1) / SS.Count0 N0 _# t7 h/ k( U" L) _! g
Next4 x' C1 x5 a# S4 Y8 e0 A9 k
End If8 q! r5 v6 c, Z
'重定义动态数组下标
, u, I+ C+ o$ `/ P7 B
ReDim A(SS.Count - 1, 1)/ n+ N% j; \: K+ ^% ^8 I
For I = 0 To SS.Count - 1
, `! \! \& f4 S0 j5 U, n3 v, s" ~
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号$ Y1 v5 U: H4 q( s
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)" m) c7 u( A- ], b6 ]' y: N
A(I, 1) = I* L0 J S \. Y0 T: N' ~
Next& U; l; m% @% L1 w: s
'按角度从大到小的顺序排序7 w, h* i+ ]$ d' c/ S2 e7 w2 h/ F F
For I = 0 To SS.Count - 2
5 n" @ {, _) t1 Y" l
For J = I + 1 To SS.Count - 1
" H- M+ h" X! L* }/ Q* d- p
If A(J, 0) > A(I, 0) Then6 o' O4 I; R$ {' j
D = A(J, 0)0 P( Q! b" l* x/ J
A(J, 0) = A(I, 0)$ Y$ p ?, a5 i' C; z
A(I, 0) = D
3 b+ W% q2 [. \8 [% I
D = A(J, 1)
# Z( g" M+ d3 r4 p; V/ [
A(J, 1) = A(I, 1)7 q2 v( \5 H3 h1 ~4 Y: E( N
A(I, 1) = D# G" e1 X/ x$ u
End If, k" f$ ^% U# l# X k
Next
3 J7 R/ f: W5 N2 f
Next' k' W9 a8 `* Y5 S- \8 x( l. t
'替换) v" ~9 w- m9 ]# w- t$ y% [
For I = 0 To SS.Count - 1
6 q# }& k/ {) f
SS(A(I, 1)).TextString = I + 1
! {" u: Z4 j6 E3 ~& D
Next
End If
6 n8 K- Y$ Z' f/ S
End If
; T5 p. P5 ]% a! Y
'删除用过的选择集
i. C; P9 L2 q" A# t* S- M1 \# {
SS.Delete% ^% P: |2 J9 a) o# u- z
End With

复制代码

wangdy111 · 发表于 2011-3-26 11:15:07

版主真是高手，羡慕，我就会点autolisp基础，能编一点简单程序，请问，需要学vb编程吗，是不是够用就行，vb编程有什么好处

taqqug · 发表于 2011-4-14 11:00:27

5# woaishuijia

能不能做成这样，我们随意指定一点，然后从相对此点的90度方向开始顺时针编号，如图所示：
我考虑到用极坐标，但达不到效果，还想请教一下大家，谢谢了

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

通知

[已答复] CAD_VBA怎样文字查找替换并排序？

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

浏览过的版块