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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
功能：
( k! L1 |8 \% L/ B: s2 w% I1.查找-替换
  f) s( e9 `$ t2.加编号排序
2我不知道咋怎
8 b" ^) a) T4 d4 \" _3 B
1 b# G. p! @, `7 S5 P9 \/ C以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia

$ B$ M. ~2 i0 q1 ]% |

1.     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
   + J" J6 G% z7 t9 h; I8 x( L6 Y, n
2.     On Error Resume Next
   , a8 U7 K; d" s1 k0 R
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   # `$ |4 D- {4 }, w$ L9 j
5.         Set SS = .SelectionSets.Add("SS"
   % S; B& a; c! @5 n! L
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
   
8.         Fd(0) = "TEXT"
   8 @7 p7 o9 Q; e! i
9.         '选择所有单行文字对象
   0 _: W2 ?: A, B
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    
13.             '如果只有一个文字对象,则修改其为原字符串+1
    
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    
15.             If SS.Count = 1 Then
    9 M% R" g( G. g( f1 p- J! D
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    % w, ^- X' ?$ m; K! q1 w6 u
17.             Else
    2 e/ L" u4 T" q% D& n" m
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    
20.                 '如果用户没有取消则排序和修改
    
21.                 If Err <> -2147352567 Then
    2 l8 [/ u4 c, ?( s$ o7 |) @
22.                     If Err = 0 Then
    
23.                         '用户指定了点
    : u2 b1 n9 x4 H+ ~& r
24.                         P(0) = V(0)
    9 h4 J/ z8 V) h8 U& C
25.                         P(1) = V(1)
    
26.                     Else
    
27.                         '用户选择了计算所有单行文字的几何中心点
    ; g/ M: g8 H8 b
28.                         For I = 0 To SS.Count - 1
    # ]' E' t9 U* C7 d8 T
29.                             V = SS(I).InsertionPoint
    
30.                             P(0) = P(0) + V(0) / SS.Count
    
31.                             P(1) = P(1) + V(1) / SS.Count
    
32.                         Next
    * _% s0 t4 g' D- N/ l8 h' N
33.                     End If
    ' B- @1 ?  J8 I1 V# ]
34.                     '指定起始角度和方向等参数
    1 x1 E* i5 a2 ?$ l" Y3 n
35.                     Do
    
36.                         Err.Clear
    4 f4 X6 k& m* N; F/ D! v  {9 l
37.                         An = 0
    6 K  P$ X, P  l. V2 Y. P
38.                         '定义关键字
    ' s. J; P& w; Z& S$ X3 a  [) o
39.                         .Utility.InitializeUserInput 0, "D"
    ) c4 V0 n' k' m& r. ?0 J, L
40.                         '由用户在屏幕上指定起始角度或选项
    
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    9 i8 ?9 j4 d9 ]. i: f& g
42.                         '如果用户指定了角度或取消则退出循环向下进行
    , j4 ~2 ~' I+ J% f$ D, V
43.                         '如果用户输入了关键字
    $ z  A) [4 |. @7 b7 P+ p
44.                         If Err = -2145320928 Then
    6 l+ t) A6 Q$ c" M
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    
49.                             If S1 = "D" Then
    
50.                                 Err.Clear
    $ q2 ~1 `! q' K% [& B
51.                                 '再次定义关键字
    0 {  W/ q- u: I2 i% z2 ^
52.                                 .Utility.InitializeUserInput 0, "L R"
    & @- t4 z: w0 g; `
53.                                 '由用户在屏幕上选择选项
    
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    " s9 y" p/ P) A- D+ q
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    $ A8 s! E6 X4 e. i$ {. v' W
57.                             End If
    ! [4 l* }$ v# m; T! h7 a1 k
58.                         End If
    
59.                     Loop Until Err = -2147352567 Or An >= 0
    
60.                     '如果用户没有取消则排序和修改
    ( n: S% U- a3 }- N
61.                     If Err <> -2147352567 Then
    ( v# _: w" r( \( ?- P2 B: b+ w- O
62.                         '重定义动态数组下标
    
63.                         ReDim A(SS.Count - 1, 1)
    5 ?- O) Q- C$ a7 _7 |5 F" V
64.                         For I = 0 To SS.Count - 1
    
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    " w- E, t. y6 O3 B  O8 n8 H
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    - T( x: w* Y# G# G$ V8 t% M8 ]
67.                             A(I, 1) = I
    6 P% E# j  s( C
68.                         Next
    $ O: X6 c- b* g
69.                         '按相对角度从小到大的顺序排序
    
70.                         For I = 0 To SS.Count - 2
    
71.                             For J = I + 1 To SS.Count - 1
    
72.                                 If A(J, 0) < A(I, 0) Then
    0 c. W2 E: z2 v/ m  b* g$ Z
73.                                     D = A(J, 0)
    
74.                                     A(J, 0) = A(I, 0)
    
75.                                     A(I, 0) = D
    
76.                                     D = A(J, 1)
    ! f( \8 m" L& y3 G) A- H
77.                                     A(J, 1) = A(I, 1)
      u+ z% g, V) P7 g* n& Z0 I
78.                                     A(I, 1) = D
    ; P5 h+ r. @! g( V9 f1 w' U4 @" K
79.                                 End If
    
80.                             Next
    
81.                         Next
    
82.                         '修改文字
    ; l; A+ b; q' o" y$ {9 v. N. h
83.                         If S2 = "R" Then
    # Q8 s1 d" v) H+ T& {0 |$ c2 X
84.                             '顺时针
    
85.                             For I = 0 To SS.Count - 1
    ( h0 M! L7 ~8 S# O% j1 ?
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    7 O9 H$ X& S6 e; p$ M
87.                             Next
    % I. ^: k. x5 ?7 P
88.                         Else
    # x" g' }7 l+ I6 w$ c2 M4 {
89.                             '逆时针
    
90.                             For I = 0 To SS.Count - 1
    
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    
92.                             Next
    
93.                         End If
    
94.                     End If
    
95.                 End If
    $ [4 _6 n6 H. k" d! W# @6 L. e
96.             End If
    " l9 k5 I  i# a0 s; F% f
97.         End If
    
98.         '删除用过的选择集
    % D2 N' n" ]2 N7 G; M/ l0 r
99.         SS.Delete
    
100.     End With

复制代码

taqqug

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