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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
6 c7 ]/ M4 H; Y5 x$ D1 s4 Z* Z% F% m功能：
& y# @+ j1 p& a: }1.查找-替换
: C* g/ B8 o0 j8 W- j' h. x9 n6 W, I, I2.加编号排序
/ d* R$ R* o' Q9 _2我不知道咋怎

1 h; J* Z0 Z, \+ p以前版主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
   " z8 U7 P3 Z. Z( y" Z. \% M: Z
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   # r; l7 ?5 k) N) ]- n
5.         Set SS = .SelectionSets.Add("SS"
   
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
   + _1 q- ]" E& C! z1 j1 ~: m2 ^
8.         Fd(0) = "TEXT"
   8 C6 [  R- R" q% J' Q! Q7 u# C
9.         '选择所有单行文字对象
   
10.         SS.Select acSelectionSetAll, , , Ft, Fd
      K2 {2 f) L" n1 V6 J
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    
13.             '如果只有一个文字对象,则修改其为原字符串+1
    
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    
15.             If SS.Count = 1 Then
    7 h0 I- M- I: `
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    
17.             Else
    9 G0 j1 d0 c) e0 A7 S
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    
20.                 '如果用户没有取消则排序和修改
    - [' z) U# \! f7 C& g! M; k
21.                 If Err <> -2147352567 Then
    - z1 D& P7 [( o: f$ Z0 y
22.                     If Err = 0 Then
    % w" d" h. T$ O# N
23.                         '用户指定了点
    : Z. F% Q) a/ t  n+ q8 g" z- R
24.                         P(0) = V(0)
    
25.                         P(1) = V(1)
    ' l  X/ M; ~1 P; V- y  D* t) u
26.                     Else
    - b  B6 W9 H+ M5 _2 p, E; t
27.                         '用户选择了计算所有单行文字的几何中心点
    9 ]3 P4 ~3 G# c
28.                         For I = 0 To SS.Count - 1
    
29.                             V = SS(I).InsertionPoint
    5 q" t( D, a/ H+ J, I
30.                             P(0) = P(0) + V(0) / SS.Count
    
31.                             P(1) = P(1) + V(1) / SS.Count
    & t: l3 I7 e! j, h! b
32.                         Next
    
33.                     End If
    9 u/ p: q8 U$ P1 w; c0 w( ], a
34.                     '指定起始角度和方向等参数
    : H8 x( Y. Z0 X7 n
35.                     Do
    
36.                         Err.Clear
    
37.                         An = 0
    , G2 h8 [& _. X# y
38.                         '定义关键字
    ' v; S9 ~" t% q' u
39.                         .Utility.InitializeUserInput 0, "D"
    7 A. q) Z0 P- E5 K
40.                         '由用户在屏幕上指定起始角度或选项
    
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    
42.                         '如果用户指定了角度或取消则退出循环向下进行
    
43.                         '如果用户输入了关键字
    8 y) I: Q0 l: y1 s
44.                         If Err = -2145320928 Then
    
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    % x; ]+ H0 w, l& f
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    
49.                             If S1 = "D" Then
    4 _4 N( U. S5 k4 n& I; p, X- H! y
50.                                 Err.Clear
    " U3 t* A7 \4 }9 K
51.                                 '再次定义关键字
    
52.                                 .Utility.InitializeUserInput 0, "L R"
    
53.                                 '由用户在屏幕上选择选项
    , x" l0 i! i* e) c
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    
57.                             End If
    ; d2 p% k1 D/ ~2 K4 y
58.                         End If
    $ N4 I' ~* J4 p" O9 u; l
59.                     Loop Until Err = -2147352567 Or An >= 0
      i. P0 |/ v* d2 A5 H: s
60.                     '如果用户没有取消则排序和修改
    " ~) z! Z5 U" v. R) u- ]
61.                     If Err <> -2147352567 Then
    0 y- q5 _, a% X. v2 a2 ]
62.                         '重定义动态数组下标
    * B* P, y4 p7 |" P5 w
63.                         ReDim A(SS.Count - 1, 1)
    
64.                         For I = 0 To SS.Count - 1
    2 m& }5 w; G1 T3 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
    + @6 S! s/ J" s" N8 g( S8 P
71.                             For J = I + 1 To SS.Count - 1
    ; e3 k, x3 t7 \# v8 m+ u
72.                                 If A(J, 0) < A(I, 0) Then
    ) o8 M) R+ V2 I
73.                                     D = A(J, 0)
    
74.                                     A(J, 0) = A(I, 0)
    
75.                                     A(I, 0) = D
    ! x! w& x6 }; L% T
76.                                     D = A(J, 1)
    
77.                                     A(J, 1) = A(I, 1)
    , v' ^8 Z5 D' t, J5 x- s! E+ V
78.                                     A(I, 1) = D
    
79.                                 End If
    $ B& P* F" N* e
80.                             Next
    
81.                         Next
    
82.                         '修改文字
    
83.                         If S2 = "R" Then
    
84.                             '顺时针
    0 t4 `8 A" H: e2 v, s3 u
85.                             For I = 0 To SS.Count - 1
    ) a( U- j/ K7 k* q9 q/ u
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    
87.                             Next
    $ F' ]- D! X' `2 l# ~" U* w8 {
88.                         Else
    $ ?: ^7 @2 M* W& \- H4 }* }( a
89.                             '逆时针
    ) @: e6 B* J8 W3 s1 _0 {
90.                             For I = 0 To SS.Count - 1
    1 S) ]! h6 w# J/ Z* A* g
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    
92.                             Next
    
93.                         End If
    # {8 ]( B& V* \$ g2 t( J$ e" {) L* G1 G
94.                     End If
    
95.                 End If
    
96.             End If
    
97.         End If
    
98.         '删除用过的选择集
    , r$ o" o8 Z7 G8 U; }+ S4 z4 s
99.         SS.Delete
    
100.     End With

复制代码

taqqug

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