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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
7 }1 J" f: J6 ]* V" r功能：
; j5 k0 B  V7 |! ~. K1.查找-替换
2.加编号排序
2我不知道咋怎
. u( ?+ h0 g# R
以前版主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
   
3.     With ThisDrawing
   8 g, N+ f& ^+ }- h
4.         '创建选择集,用于选择所有文字对象
   ( V7 i- W, h5 ~" l* ?' l
5.         Set SS = .SelectionSets.Add("SS"
   
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
   , c3 S. T( q4 q9 j
8.         Fd(0) = "TEXT"
   6 |) k; m5 N% U  V3 s
9.         '选择所有单行文字对象
   4 Z$ `8 }% R( m+ o6 v3 T5 c
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    $ j) T0 Q; E8 Q. C3 d
13.             '如果只有一个文字对象,则修改其为原字符串+1
    ( n3 |5 l. ?, D; @0 j% B
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    ' f/ G% l4 [1 w3 e& i
15.             If SS.Count = 1 Then
    
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    8 p2 ?* J: |+ N) P( h
17.             Else
    
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    
20.                 '如果用户没有取消则排序和修改
    
21.                 If Err <> -2147352567 Then
    " @2 e& C& f5 l8 D  c( a- c
22.                     If Err = 0 Then
    , |" m/ i% M3 [# ], b
23.                         '用户指定了点
    4 C  b7 K% v3 {# l; z3 t- W
24.                         P(0) = V(0)
    
25.                         P(1) = V(1)
    / `; c+ A% Y4 f: J, Y6 ^
26.                     Else
    - A) R: O! F7 ^0 ~6 A$ q& S, ]
27.                         '用户选择了计算所有单行文字的几何中心点
    * \2 \9 @" ]$ B5 `7 z4 a1 v- ~
28.                         For I = 0 To SS.Count - 1
    
29.                             V = SS(I).InsertionPoint
    
30.                             P(0) = P(0) + V(0) / SS.Count
    ( ~8 |  i# V7 k
31.                             P(1) = P(1) + V(1) / SS.Count
    
32.                         Next
    
33.                     End If
    
34.                     '指定起始角度和方向等参数
    
35.                     Do
    ( q. O& |$ g9 N& i; ?. v
36.                         Err.Clear
    - ^% g& q5 W! K( Q6 W/ L7 k. J
37.                         An = 0
    2 g+ g3 |  P# i1 p" ]; |
38.                         '定义关键字
    " Q7 K) g9 X' v5 S1 z8 N, j
39.                         .Utility.InitializeUserInput 0, "D"
    
40.                         '由用户在屏幕上指定起始角度或选项
    
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    1 S6 N7 D+ K# s, k0 z
42.                         '如果用户指定了角度或取消则退出循环向下进行
    
43.                         '如果用户输入了关键字
    ) @" l9 c" ^, n! w3 ~9 q: ^0 Q
44.                         If Err = -2145320928 Then
    & q3 w( \% j. ?- s$ Z
45.                             '获得用户输入的关键字
    4 b  V$ Q, o9 o3 Q4 i! y9 u
46.                             S1 = .Utility.GetInput
    ( j. P9 ]2 K, L+ v, g! x' b& f, O
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    4 ?: z0 ^4 u, L0 i
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    1 M! Y8 ~$ d+ ^
49.                             If S1 = "D" Then
    
50.                                 Err.Clear
    
51.                                 '再次定义关键字
    - H# W& r8 v. Y
52.                                 .Utility.InitializeUserInput 0, "L R"
    ! X. v5 I3 |( d$ [
53.                                 '由用户在屏幕上选择选项
    
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    
57.                             End If
    % V. p* g1 z' Q3 G4 [- J3 m( V
58.                         End If
    
59.                     Loop Until Err = -2147352567 Or An >= 0
    ! O( o. k7 V' E6 B
60.                     '如果用户没有取消则排序和修改
    1 x6 h9 {- g4 {4 ^0 p" Y- V
61.                     If Err <> -2147352567 Then
    
62.                         '重定义动态数组下标
    
63.                         ReDim A(SS.Count - 1, 1)
    $ {3 o. g$ h1 I4 T
64.                         For I = 0 To SS.Count - 1
    9 f3 h( Y' a* z+ _$ R! F* O' M
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    
67.                             A(I, 1) = I
    
68.                         Next
    
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
    6 z" T2 p0 K0 h8 j4 ^8 ]
73.                                     D = A(J, 0)
    ; D# D2 v: J2 p# p
74.                                     A(J, 0) = A(I, 0)
    ; T' L2 X; r7 `) K8 z& s" T8 m3 X
75.                                     A(I, 0) = D
    - }: q4 M5 a& M! J0 }
76.                                     D = A(J, 1)
    + [  ^' E8 X, \( ?# P. C+ b
77.                                     A(J, 1) = A(I, 1)
    
78.                                     A(I, 1) = D
    
79.                                 End If
    ; @$ Z6 W- w, V- i3 Q7 b
80.                             Next
    
81.                         Next
    3 z1 h( U% c2 f7 u, a/ w' A
82.                         '修改文字
    - y# x1 r9 ~& _: j( J: R
83.                         If S2 = "R" Then
    
84.                             '顺时针
    
85.                             For I = 0 To SS.Count - 1
    
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    
87.                             Next
    9 M( W8 j1 c2 e. [
88.                         Else
    0 C/ B  Z' o# l! @) ?
89.                             '逆时针
    ' z, \  A$ b: _7 u4 @+ }5 u5 O
90.                             For I = 0 To SS.Count - 1
    
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    5 q1 c& D) Z8 ^
92.                             Next
    
93.                         End If
    + B; o. N% t. N1 [/ e1 X* S
94.                     End If
    
95.                 End If
    
96.             End If
    ( H  B1 Q3 i4 T
97.         End If
    : X$ w+ c& m; S: G4 o* M: ^  [: X
98.         '删除用过的选择集
    
99.         SS.Delete
    
100.     End With

复制代码

taqqug

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