CAD_VBA文字相对于指定点90度顺（或逆）时针加编号排序?

taqqug · 发表于 2011-4-14 11:10:30

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

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

x

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

以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia · 发表于 2011-4-19 09:54:00

本帖最后由 woaishuijia 于 2011-4-23 10:56 编辑

Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, V As Variant, An As Double, P(2) As Double, A() As Double, I As Integer, J As Integer, D As Double, S1 As String, S2 As String! A& N, e/ x6 l) n
On Error Resume Next
; ?, D3 u8 h* q, v: s. o& c
With ThisDrawing
6 l N7 T7 g& Z. R/ g/ b+ y
'创建选择集,用于选择所有文字对象4 X: |& F5 S& J) |' O# g- t! n
Set SS = .SelectionSets.Add("SS"
6 O! D3 [9 _; a( Y; V6 d
'定义过滤器为选择单行文字对象
" q& P! C1 J4 |' w
Ft(0) = 0
+ B( B* W1 p! u: [1 A( P1 T- l
Fd(0) = "TEXT"3 [9 R' V! \0 ^+ x e( N$ |
'选择所有单行文字对象7 X+ G3 Y' C$ ?: t
SS.Select acSelectionSetAll, , , Ft, Fd5 g3 r. r8 h* g+ c& O. g8 c. }
'当存在单行文字对象时排序和替换6 M* W2 Z$ v. b8 w4 j, H3 q" A1 S
If SS.Count > 0 Then, k. x8 Q8 P6 Y k. t0 O2 |
'如果只有一个文字对象,则修改其为原字符串+11 x; w( {/ X" @9 k7 Y
'如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
3 V$ w7 e+ |! e" x( Z/ m/ S4 V% [- I
If SS.Count = 1 Then
3 d1 K: H/ [( w6 _ ~ a
SS.Item(0).TextString = SS.Item(0).TextString & 1
* a/ o y3 x# }1 ~& o8 w
Else# H4 x3 \, o( C# @! q; o$ ?8 v
'由用户在屏幕上指定中心点
5 p2 t/ k) W' V% v5 l/ m' N$ i
V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"! K) @2 `* q/ P, k! ] I' T u
'如果用户没有取消则排序和修改3 k) ~5 r6 P" o% V- }/ m" A" v
If Err <> -2147352567 Then
- ?/ D" s3 O( U3 _) w
If Err = 0 Then
( t7 W' `7 {6 E9 y8 s4 {
'用户指定了点5 b& i5 d/ T# j; Y( L+ n
P(0) = V(0)( y6 \2 m' q! |! L. _% B
P(1) = V(1)+ R& J- O4 x6 z2 I) o
Else8 b( t* u% J4 d1 l/ A* B4 B1 g
'用户选择了计算所有单行文字的几何中心点
* H9 @' l9 D3 L
For I = 0 To SS.Count - 1
4 P+ G v1 r# G1 f6 d
V = SS(I).InsertionPoint
2 a& G1 |* N$ R
P(0) = P(0) + V(0) / SS.Count
. j z1 L6 W- h* s
P(1) = P(1) + V(1) / SS.Count6 u6 @. |( D- N! a9 M" s8 p
Next
A8 K* N6 L# d/ \0 p( f1 @5 q
End If
6 [/ R8 M! {$ {& S
'指定起始角度和方向等参数3 A2 m, G( O; T6 f
Do W; t/ m$ n* Q8 k9 s
Err.Clear7 J2 S3 p8 A8 x. b7 t( B
An = 05 U7 Z; T( i; `* c
'定义关键字 r" C. j9 D, d, H
.Utility.InitializeUserInput 0, "D", C" W* i" [5 @% p! M
'由用户在屏幕上指定起始角度或选项* X; p- K4 G. R/ r
An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
- S4 W$ ]) b$ H% {
'如果用户指定了角度或取消则退出循环向下进行; Y8 f/ |2 E @0 S4 v8 W' @ g% O
'如果用户输入了关键字
`. K' \) }' }0 s( l/ T4 w
If Err = -2145320928 Then1 c s" [7 m4 x1 _9 U
'获得用户输入的关键字
7 [! j) E4 v k5 g
S1 = .Utility.GetInput
9 a1 _2 b. v$ H& y' Y
'如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行. y( x" S' i0 @7 c6 `0 \3 q
'如果关键字为"D"说明用户选择了"方向(D)"选项
4 h, v" B( o) x- b/ l
If S1 = "D" Then3 Z K0 R7 Q" R: P" W; G: t
Err.Clear4 X% y& w' t7 \' A# v Q
'再次定义关键字& R1 R6 }, \6 I4 o2 Q7 W" _% n
.Utility.InitializeUserInput 0, "L R"
0 F, O# m" D4 B6 M- b
'由用户在屏幕上选择选项+ s; i/ ^. ~+ a
S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"* W+ t3 m" @1 \9 V8 w
'把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度( Y5 A/ U: Q9 U- l1 T
An = -1# g, e# o' L- G- Z' a
End If
' m z9 r$ f* F3 ?! U0 Y
End If. X; Y' r7 t( W: f! T8 ]. v* C1 _
Loop Until Err = -2147352567 Or An >= 0* b# T P. G. d- D( T
'如果用户没有取消则排序和修改
7 F6 R; V$ j2 x. ^
If Err <> -2147352567 Then9 K3 C' H2 U+ m$ a8 Z
'重定义动态数组下标- d; \- t" L% [1 [
ReDim A(SS.Count - 1, 1)
+ p" S' h7 d' {5 Z% {2 N
For I = 0 To SS.Count - 14 J& l, N5 @( i! ?& P# ^ Z
'计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
6 l0 m/ b+ f: O$ {' \; q) W/ Q! e
A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians); N0 s* @% h7 U2 o1 H" E/ H0 E
A(I, 1) = I
$ j3 K0 y5 f/ P7 X8 O
Next
& n: F* e6 Y. V9 b0 b2 _; S2 ]
'按相对角度从小到大的顺序排序
% u# N7 E* P2 j. ?) y
For I = 0 To SS.Count - 2$ ]$ `& s% l6 Y( F
For J = I + 1 To SS.Count - 1
9 U, m0 U& B6 q
If A(J, 0) < A(I, 0) Then
. P4 r) X; |, K5 \/ _: y0 l2 m
D = A(J, 0)2 k; j2 }2 C$ F3 b- s3 e
A(J, 0) = A(I, 0); ` f; i$ Q, u) y2 u' s; ~
A(I, 0) = D
1 M5 @3 R" \+ z+ z
D = A(J, 1)9 j0 u- }1 t) z3 f- U* _) H
A(J, 1) = A(I, 1)8 @ v/ O/ V! I# |# g
A(I, 1) = D- E+ I7 d8 P2 x% r& Q) X( [
End If
% ]" e) F5 X1 A& ~+ q) W
Next
6 Y% p2 ^( L/ n" Z1 q) {
Next
% }( g7 w6 X: ^0 q2 I7 g- j
'修改文字0 X% A3 i& L7 U' W' X# u& |- A$ z
If S2 = "R" Then- Q. e' m* D& d2 a, K% m* @
'顺时针. S- N* H E$ y& I' Z% a7 k
For I = 0 To SS.Count - 1
% \$ O8 m3 i4 o+ \3 f8 A; c5 e4 w* j
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
9 D6 y6 E3 n3 k7 R* L
Next( X3 s. c$ [0 t }" h
Else4 P3 D; D5 ~: H7 L9 `& G
'逆时针' s6 d7 M4 h8 _0 ?2 x
For I = 0 To SS.Count - 1; G0 }( Y* i9 Z
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
8 ^, m2 ?2 b8 O- Z) x8 g3 t: D
Next. [) K% m9 p2 ]# ^* O: y
End If
Y" E& p4 w7 D) S1 \4 g% G/ ], \
End If$ I# ]# t( g" q
End If% P F( B: z9 N# k- }6 ]
End If& h6 _+ F, o% u C& ]
End If4 m% I1 }/ I" K* i- z
'删除用过的选择集% }2 F% i C; H d+ P5 Q
SS.Delete0 p. @/ q& J& ^7 u( K7 ~
End With

复制代码

taqqug · 发表于 2011-4-22 14:11:54

谢谢版主，后来我用了另一个方法也能达到这个效果，我将所有选择的文件相对于用户指定的中心点旋转90度，排序后再转回来就行了。方法简单些，但没版主的灵活，呵呵

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

全站		goto3d 说: 此次SW竞赛获奖名单公布如下，抱歉晚了，版主最近太忙：一等奖：塔山817；二等奖：a9041、飞鱼；三等奖：wx_dfA5IKla、xwj960414、bzlgl、hklecon；请以上各位和版主联系，领取奖金！！！	2022-03-11
全站		goto3d 说: 在线网校新上线表哥同事（Mastercam2022）+虞为民版大（inventor2022）的最新课程，来围观吧！	2021-06-26

通知

[已答复] CAD_VBA文字相对于指定点90度顺（或逆）时针加编号排序?

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