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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
功能：
1.查找-替换
2.加编号排序
2我不知道咋怎
+ z4 J( M( ~/ A' j, u: z& N2 v
$ t8 F: U) F: I6 x5 ?以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia

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
   
2.     On Error Resume Next
   ! c3 {0 u4 \* b( c( h1 e" T
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   : u/ a/ u$ D9 r- e4 r) P
5.         Set SS = .SelectionSets.Add("SS"
   
6.         '定义过滤器为选择单行文字对象
   # ~( B8 d" d# k9 D  B
7.         Ft(0) = 0
   , C( `. `, c+ E
8.         Fd(0) = "TEXT"
   
9.         '选择所有单行文字对象
   
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    2 {. t. ]# T  t
12.         If SS.Count > 0 Then
    
13.             '如果只有一个文字对象,则修改其为原字符串+1
    4 ~% f  n7 |$ [" u/ G
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    - d% [: L* }( n. M$ \% y0 O
15.             If SS.Count = 1 Then
    
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    
17.             Else
    0 \. o! z/ s  w" g! W: q, p& O3 p7 o
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    ( T, P$ `5 j5 x" z7 B- p+ I+ j1 q
20.                 '如果用户没有取消则排序和修改
      k: U5 p! R% x; t% H
21.                 If Err <> -2147352567 Then
    6 ?2 s: n8 T% M! m- b
22.                     If Err = 0 Then
    
23.                         '用户指定了点
    
24.                         P(0) = V(0)
    
25.                         P(1) = V(1)
    
26.                     Else
    
27.                         '用户选择了计算所有单行文字的几何中心点
    
28.                         For I = 0 To SS.Count - 1
      Z6 W. n. F+ w% Y/ M1 z, U
29.                             V = SS(I).InsertionPoint
    # q+ d: y' a* i; [
30.                             P(0) = P(0) + V(0) / SS.Count
    
31.                             P(1) = P(1) + V(1) / SS.Count
    
32.                         Next
    
33.                     End If
    4 g+ S8 d, u4 Z" n! |; y
34.                     '指定起始角度和方向等参数
    
35.                     Do
    
36.                         Err.Clear
    5 M9 u! n$ y8 b% F
37.                         An = 0
    7 H/ M9 h3 a& w  T
38.                         '定义关键字
    + c& p: S& Z$ O) Y1 S6 I
39.                         .Utility.InitializeUserInput 0, "D"
    
40.                         '由用户在屏幕上指定起始角度或选项
    8 [; z! Z: E/ {- [7 v
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    
42.                         '如果用户指定了角度或取消则退出循环向下进行
    * Z1 Z) W9 @( S2 m. S* a
43.                         '如果用户输入了关键字
    ) {+ V9 Z+ Q2 u4 b
44.                         If Err = -2145320928 Then
    
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    ) C  J; V" {( Y3 \9 @2 `' Z' j
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
      R2 g9 d/ D- D7 m3 ?
49.                             If S1 = "D" Then
    7 c+ y/ U6 ~7 o6 t9 K8 U' o
50.                                 Err.Clear
    
51.                                 '再次定义关键字
    $ V( L) p4 F; |( k4 k
52.                                 .Utility.InitializeUserInput 0, "L R"
    2 ]) ^! X. _% w$ ^9 ]  v6 D" l6 Y; w
53.                                 '由用户在屏幕上选择选项
    : M1 A3 z) I1 D& c
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    : A6 T5 k; a/ W* ]/ X" f
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    " a3 h4 Q; @) q) ?  `
56.                                 An = -1
    2 x6 a9 _, H+ R
57.                             End If
    
58.                         End If
    - m3 B8 b# M5 r
59.                     Loop Until Err = -2147352567 Or An >= 0
    
60.                     '如果用户没有取消则排序和修改
    
61.                     If Err <> -2147352567 Then
    ' k1 [& g5 q$ L' l; {% w2 `7 Z
62.                         '重定义动态数组下标
    
63.                         ReDim A(SS.Count - 1, 1)
    
64.                         For I = 0 To SS.Count - 1
    . c7 @) E& J% L* b  M7 d
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    + j- E# A8 E9 g
67.                             A(I, 1) = I
    
68.                         Next
    
69.                         '按相对角度从小到大的顺序排序
    ( W8 M! b' M  J' f2 v5 N$ `0 r
70.                         For I = 0 To SS.Count - 2
    
71.                             For J = I + 1 To SS.Count - 1
      y9 n8 ^$ T5 Y
72.                                 If A(J, 0) < A(I, 0) Then
    
73.                                     D = A(J, 0)
    
74.                                     A(J, 0) = A(I, 0)
    ) p$ u3 z: A0 i# y' {
75.                                     A(I, 0) = D
    " p: o$ _: T/ N& Z; P* c& N
76.                                     D = A(J, 1)
    
77.                                     A(J, 1) = A(I, 1)
    " }6 K3 S5 f! K: z' B
78.                                     A(I, 1) = D
    
79.                                 End If
    
80.                             Next
    ' I  Z' I! y2 M4 Y' K
81.                         Next
    
82.                         '修改文字
    4 Q0 c! K4 O6 c8 m% g* E
83.                         If S2 = "R" Then
    $ r  i) p8 \# D- F" k9 p: U- e
84.                             '顺时针
    ) l! X' y) P" i& Y& w
85.                             For I = 0 To SS.Count - 1
    5 I1 C+ p. C9 P4 J
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    
87.                             Next
    2 z$ \2 L  S0 j' d& ]# v
88.                         Else
    9 h: a3 [% S$ U: h8 v
89.                             '逆时针
    $ N* J) ~& N  s7 s2 v
90.                             For I = 0 To SS.Count - 1
    7 f. w, P# z) \5 n4 K9 ~2 k
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    4 m6 v* _; m7 A0 d% `
92.                             Next
    
93.                         End If
    
94.                     End If
    $ f" W8 N8 ~; ^8 m
95.                 End If
    # ]& b5 o& N( w
96.             End If
    ) Y' T7 ~" N3 p5 U
97.         End If
    ) v+ g5 X) ~! g
98.         '删除用过的选择集
    
99.         SS.Delete
      t4 k  }, ]" x! D! q) o
100.     End With

复制代码

taqqug

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