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 Double1 |" `* m- }% x3 M, \" w
With ThisDrawing
' G1 [3 V. |4 N
'创建选择集,用于选择所有文字对象9 Q0 @9 m. r" N" U' ^9 } u S
Set SS = .SelectionSets.Add("SS")
0 t" V5 |7 r% _: V& q. H
'定义过滤器为选择单行文字对象# ~* Z/ F; u1 d/ E. \
Ft(0) = 0' t, G: ]* [2 ?5 a2 z
Fd(0) = "TEXT"% P' |% I& r+ {$ V: ^
'选择所有单行文字对象$ n9 h& N% G1 _) N7 s; u4 k" `
SS.Select acSelectionSetAll, , , Ft, Fd' ]; O5 `6 l: |' W/ Q$ t1 T! F
'当存在单行文字对象时排序和替换 i" D1 Y" C$ O' ?7 r% i& u2 V" J
If SS.Count > 0 Then
5 R, h2 e, B. ~+ E
'计算所有单行文字的几何中心9 r6 m. s2 D9 r7 r/ J
For I = 0 To SS.Count - 1# t" x0 s+ U6 W6 q$ P+ A
V = SS(I).InsertionPoint
+ T3 J# ], _, M* ]9 a4 V5 J, {
P(0) = P(0) + V(0) / SS.Count
3 o+ m }- o4 F# w0 r) Z4 u
P(1) = P(1) + V(1) / SS.Count _* f9 t/ L( b
Next% \# t" X6 l& ?' F" H
'重定义动态数组下标1 D! \$ v4 R* S
ReDim A(SS.Count - 1, 1)8 [) T0 o: |! \4 w( I0 j6 V
For I = 0 To SS.Count - 1# ]2 x' C2 G+ K5 }2 D
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号9 X, l- H: \# R4 R c- s5 s
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)
% A' Z$ n( ^5 k$ ]0 P) ^) { E
A(I, 1) = I; g. L9 U# }0 s/ B2 D) ^
Next
' j/ {( h7 V+ ?
'按角度从大到小的顺序排序
' q) ^3 r/ T: Z) p: G
For I = 0 To SS.Count - 2
' {4 k5 t1 q8 L9 j! v) h6 K/ R
For J = I + 1 To SS.Count - 1
( y) K8 o; |' k
If A(J, 0) > A(I, 0) Then
% ?8 a9 r: k/ W8 ] G
D = A(J, 0)
' S7 k; I, A! w; [
A(J, 0) = A(I, 0)
7 c3 p. K- K2 v% C! a
A(I, 0) = D
0 ?8 [! E1 a) W" J4 S6 s
D = A(J, 1)
! G. u7 Y8 B8 D
A(J, 1) = A(I, 1)
6 L& C# h3 |. {; f' c z' y% l
A(I, 1) = D
2 Z# v; {; d8 Q6 z% E$ h
End If
# c `# k( A2 E) }4 g: ^
Next
" B i* d, \( ?, |: b6 a0 ^
Next
8 U( t" k5 R4 t, T* U. r3 q! p
'替换
) _+ L+ @$ {% O
For I = 0 To SS.Count - 1. Y3 I: r' V3 Y8 d
SS(A(I, 1)).TextString = I + 1
$ h- Z& E2 ?9 e( I1 V1 ?$ z
Next
; a/ @: Z5 {6 @
End If, m8 F3 @6 R2 o' y
'删除用过的选择集4 o! K" h2 F9 N& d3 V- C: O. _
SS.Delete2 e& @5 b2 z0 Z4 [5 _+ }4 g; u9 c
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
- n: B1 \: g2 m; U' z3 l
On Error Resume Next/ b5 S. F- k( X9 Z0 \( Y3 l
With ThisDrawing' v/ Q4 _( S. Q& S: G! z$ B
'创建选择集,用于选择所有文字对象- r4 Z) [, Z( h* n0 x
Set SS = .SelectionSets.Add("SS")
4 Y* v6 W+ z- a
'定义过滤器为选择单行文字对象
( ~7 H9 N: z7 I$ y9 v. P$ g
Ft(0) = 0
) H# J' u$ n- x
Fd(0) = "TEXT"
# S3 y2 X. m% o9 j/ H
'选择所有单行文字对象
X$ O' E# o0 a: m* k$ w5 \$ L
SS.Select acSelectionSetAll, , , Ft, Fd
7 w1 g7 n' u* w6 N
'当存在单行文字对象时排序和替换6 J! K2 J; z) H* r
If SS.Count > 0 Then. s' ?+ \8 U4 j! @1 u
'由用户在屏幕上指定中心点
& P9 k1 @7 N4 _% R0 s7 ? k, Q
V = .Utility.GetPoint(, "指定中心点<默认>:")9 P3 \+ h, h# c9 n1 l% z# L$ B. B
'如果用户没有取消则排序和替换
! [( D+ Z$ _) D9 z3 {4 P: a6 M/ b
If Err <> -2147352567 Then
) y. B0 R# d+ w( l
'用户指定了点
8 H' k& ?, X6 n+ B$ n
If Err = 0 Then3 H; x3 x- R, C0 V
P(0) = V(0)1 M; Q/ L' I! {: l" r& V
P(1) = V(1)$ N; p, a3 K! N: M$ l! _, \
'用户选择了默认8 R. i" S5 v1 Y2 r' J
Else
# h! a! |% M$ q
'计算所有单行文字的几何中心% }: r; `& F% x5 z" J. D8 l n
For I = 0 To SS.Count - 1
B, g5 v2 S3 P1 D
V = SS(I).InsertionPoint! ^* A! H T: b) }, o/ W
P(0) = P(0) + V(0) / SS.Count
/ E5 x) ~3 x/ f# l
P(1) = P(1) + V(1) / SS.Count" ^4 e& t5 B8 u) K, @; ^8 G/ S
Next m# e6 U0 [4 D# W( l! k F
End If8 o6 {( y1 X/ C: [# _
'重定义动态数组下标
" s' p' p* @; q/ P" ^; ]6 X6 m
ReDim A(SS.Count - 1, 1)
' p/ @5 f. s2 Z- c
For I = 0 To SS.Count - 10 ]8 m8 Z E- y
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号
% h @+ U8 o1 a( G) v/ o2 D- @
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)8 F/ N" O* I& S0 Q7 D w/ k. W4 ?
A(I, 1) = I
Next& F/ p% G4 i8 N& w. \
'按角度从大到小的顺序排序
9 H+ w( v7 F' a. _/ v" A6 o
For I = 0 To SS.Count - 2
9 M; ?8 X! a1 C+ J1 o
For J = I + 1 To SS.Count - 12 r0 D" M( d3 B: a$ W
If A(J, 0) > A(I, 0) Then0 V! }/ d+ P/ e
D = A(J, 0)0 g5 W5 ` n7 W) a+ g
A(J, 0) = A(I, 0)6 }9 I/ b4 L$ z, q, c m
A(I, 0) = D3 |% `% B; }: l8 c0 I
D = A(J, 1)7 y/ L: C0 ~3 H5 `% M+ Z; P$ \- e
A(J, 1) = A(I, 1)
# r6 ~) S9 S6 O* z# p* s- R# O
A(I, 1) = D
0 V$ ^7 E7 U1 V0 G. @5 ~, S; I
End If
5 q1 Z; O. A0 f; k" H4 Q
Next( G& j' K$ K2 H$ H' Q# f
Next
# M5 m$ H5 c- r* F
'替换- X1 Z( u- t# U$ [$ P0 t# p
For I = 0 To SS.Count - 1
) a, F3 b% G9 \6 S, R
SS(A(I, 1)).TextString = I + 1
; i) a3 w7 k% a* A- b! C. h* V* r
Next' Y1 ? r' b& ]1 b4 o# U2 I1 N
End If3 D; V Z. z$ p. G1 H
End If9 F/ Y+ h% W" o; I4 I1 u1 x
'删除用过的选择集: R. O, y) A1 c4 h" W1 D
SS.Delete- R; y* I& S4 {8 O3 Q; _
End With

复制代码

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

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

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

5# woaishuijia

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

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

通知

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

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

浏览过的版块