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
0 F. K+ P2 X, c' S5 B, ^4 \$ f+ I
With ThisDrawing
: k( U5 r; C' O: U
'创建选择集,用于选择所有文字对象
) m8 ~# I0 J( ~% y/ r; I) X& l$ |
Set SS = .SelectionSets.Add("SS") R0 b7 C8 U, |- l
'定义过滤器为选择单行文字对象
3 B. e8 t; T! u' a+ Z7 g( h
Ft(0) = 0( B! n" ^6 g2 K: H- v
Fd(0) = "TEXT"
& T% C& x1 a# h# Y I
'选择所有单行文字对象
( E$ a9 Z( P1 W2 P9 s
SS.Select acSelectionSetAll, , , Ft, Fd
) O9 W8 q, h5 S: E1 D
'当存在单行文字对象时排序和替换
( U, T$ F: v# v x/ x4 u- e
If SS.Count > 0 Then0 d* r# ^ F; ]% f. `( p9 x z
'计算所有单行文字的几何中心, c2 ~6 w3 p$ I% l" \& p9 @
For I = 0 To SS.Count - 1
V = SS(I).InsertionPoint
7 ^. y- o+ _4 p& V# ^$ o+ o) e
P(0) = P(0) + V(0) / SS.Count* O; s" f- d7 k5 J) X) U
P(1) = P(1) + V(1) / SS.Count9 j' }1 [ n7 a* P( W3 F8 E
Next% e D( L6 g2 y: j; Y
'重定义动态数组下标
# d6 q# ?1 j0 _. Q( o8 u7 c4 w. ]) H
ReDim A(SS.Count - 1, 1)$ h8 M. \6 V( z `
For I = 0 To SS.Count - 1% B* l3 h, L @) h m
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号
( o9 \0 k' Q7 u2 G0 e
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)
& t) ] p* z3 e9 }- K
A(I, 1) = I0 M' Y( F% r& ^! B8 d
Next
* j2 C: s: T; p
'按角度从大到小的顺序排序
: |* J$ S N9 G/ \! ~
For I = 0 To SS.Count - 2
- T$ a% n9 e- ^$ f. p& U
For J = I + 1 To SS.Count - 16 A" g/ z" t) n$ F3 A5 J, I& F6 _
If A(J, 0) > A(I, 0) Then
e( D. e$ S- g3 r: G3 c
D = A(J, 0)5 m* L& n' L u2 ^9 v
A(J, 0) = A(I, 0)
6 Z- z7 Y: A0 ]* Q) Q, N: v
A(I, 0) = D% l+ D% l2 [7 d* S; d
D = A(J, 1)' p# n5 a/ R8 g
A(J, 1) = A(I, 1)
, }2 |. x# L: E
A(I, 1) = D# M; @5 ^# d8 Y0 ~
End If, K6 s; K; c/ x. h* f+ H
Next
( [# Q) l0 M/ B3 a4 r, r
Next$ b- {7 y7 n. Y$ k: d
'替换
* Q/ {7 ^, _, `* V- b
For I = 0 To SS.Count - 1
0 A9 Y- s- V0 T
SS(A(I, 1)).TextString = I + 1
3 X2 F7 w, E, m. }' p
Next
9 G$ M! b5 T, ~8 f) U
End If
- ]. x- d$ M$ {; V5 s* D
'删除用过的选择集" g \0 Z P* s; J
SS.Delete$ E5 ?3 a0 B) E) A. V2 v% M- p
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
) F& i3 ?/ Y& g! d3 Z
On Error Resume Next
z. @& F, x: j$ v/ D9 s
With ThisDrawing
2 _4 Y# q- x7 u
'创建选择集,用于选择所有文字对象% q# q# P( X- \& h
Set SS = .SelectionSets.Add("SS")
, f) Q; n, C' a+ Q5 b; b* b9 X* y6 a
'定义过滤器为选择单行文字对象
# q" Q- D8 O+ e I: r Y
Ft(0) = 0
* q9 u1 `% d8 u2 y2 M
Fd(0) = "TEXT"
9 V6 B' B$ Q; C0 u
'选择所有单行文字对象# u- U; s, E! v C9 O* ]
SS.Select acSelectionSetAll, , , Ft, Fd5 K+ {$ ^* M2 C# i
'当存在单行文字对象时排序和替换0 q* j; X8 p4 d ?
If SS.Count > 0 Then+ M2 z' j* j, k. k T5 D( t5 Z) g
'由用户在屏幕上指定中心点
) v' N6 p- C7 P3 n) c
V = .Utility.GetPoint(, "指定中心点<默认>:")/ _6 q( i; W- q$ N8 z3 H; J
'如果用户没有取消则排序和替换
. @- t7 _1 c- X& \, I
If Err <> -2147352567 Then ~. o1 i( @5 T/ w/ I* s0 V5 Z& p
'用户指定了点
3 h3 i/ P4 ^0 C: J0 \ D
If Err = 0 Then
p; Y$ ]( K0 n% f
P(0) = V(0)% G+ ^1 i. a5 a0 h4 G6 I; B T2 D' }
P(1) = V(1)
T. d/ _- f% a$ R7 D m
'用户选择了默认5 F3 b2 `$ f# W; [- K& T4 }
Else
, @2 ^- X0 J& y0 `( x5 `. k
'计算所有单行文字的几何中心1 q0 W1 ]! s4 H$ w" P) U8 x, p8 ]7 @
For I = 0 To SS.Count - 1# A1 I; H4 r, d% \
V = SS(I).InsertionPoint
( A0 G" A% Q/ G' Q1 q% P2 A0 K
P(0) = P(0) + V(0) / SS.Count
: `" h, F/ A0 @
P(1) = P(1) + V(1) / SS.Count9 V# \' x/ p' O" t# ]5 T
Next
4 V7 h& K) D4 D9 n0 g3 K9 b2 w, c2 {/ h
End If
) Y$ t1 y- y( y5 o; O8 z
'重定义动态数组下标6 y0 W/ o5 [/ P8 g+ C5 i3 M4 ^
ReDim A(SS.Count - 1, 1)! l+ f& t5 H. U/ }- N
For I = 0 To SS.Count - 1
- O% |, q0 R/ z7 }$ M. p0 X
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号' c3 G, G: ~/ m4 {) z
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)6 l8 E" F3 |- w
A(I, 1) = I/ c6 u# V9 M4 X1 w+ u2 T* f6 q
Next" M3 _9 J+ j$ t* A5 W9 M8 ~( ~
'按角度从大到小的顺序排序
& \ w, Y+ j' e4 T
For I = 0 To SS.Count - 2 |- z8 n. U( c/ P3 |' t+ Z5 `
For J = I + 1 To SS.Count - 1# L) \( \1 y5 A, Z4 K7 @% U
If A(J, 0) > A(I, 0) Then
6 N3 ~0 M, X, @3 j- z( A8 U: I' n
D = A(J, 0)8 q- b- r; ]* m/ ]2 g3 _
A(J, 0) = A(I, 0)/ v4 a) m, W3 x: N0 O7 A8 h4 O* F
A(I, 0) = D1 U* V9 P* N- r+ b( b, {8 ~
D = A(J, 1)
2 K. H" M/ ]3 I
A(J, 1) = A(I, 1)
; S I& k& b4 p, R. ]3 M- }' i4 ?5 F
A(I, 1) = D$ A, t, b; W: Y9 f" S
End If
9 b9 D$ n6 |! W2 v- p7 O
Next
/ M# ^9 s6 W, c4 W" s, v
Next6 g% x! p/ F/ Q$ d" l
'替换 J# M) ]4 u" H6 a8 D( x
For I = 0 To SS.Count - 16 W8 T0 O& \$ ]6 f
SS(A(I, 1)).TextString = I + 1
9 B& @3 M# E" b% L& |9 o% L9 d
Next
, Z% y+ \3 H& u4 k" Y! N/ `- t
End If+ T1 [0 Z" A# h$ E7 @0 B8 [
End If4 j9 r# |1 B, P& L
'删除用过的选择集9 }) T9 G: C" v. _
SS.Delete7 q- M6 |7 k, A
End With

复制代码

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

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

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

5# woaishuijia

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

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

通知

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

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

浏览过的版块