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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
5 j5 ^) F- c" P8 q' b功能：
1.查找-替换
5 U) v5 c4 L! c! g5 Z& ^! N$ @  u2.加编号排序
2我不知道咋怎
( g* \! ?+ k4 t. u# Z  S
9 Q* q3 ^8 `5 E3 Y9 A9 O- a以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia

" C3 o) z, `8 N( O+ X

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
   8 m3 V, z6 e+ Y* s8 I
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   , I" \1 R# B1 e  M
5.         Set SS = .SelectionSets.Add("SS"
   
6.         '定义过滤器为选择单行文字对象
   7 e% e/ T. E. U6 _
7.         Ft(0) = 0
   + T, ^5 O, g1 Q* \. H' u8 ]
8.         Fd(0) = "TEXT"
   ! ^: y2 X1 `; M
9.         '选择所有单行文字对象
   
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    $ ?2 [" c2 C" \- K, G3 g
13.             '如果只有一个文字对象,则修改其为原字符串+1
    
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    
15.             If SS.Count = 1 Then
    
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    
17.             Else
    ' t" v1 T1 Y1 {- P
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
      r* A+ F6 C  d! Y) g5 f# Z
20.                 '如果用户没有取消则排序和修改
    5 G2 N5 T3 \2 g* E2 o3 X
21.                 If Err <> -2147352567 Then
    
22.                     If Err = 0 Then
    5 y) B! }1 Z  ^# O5 n5 B0 }6 p, D
23.                         '用户指定了点
    7 S$ e0 F8 G+ P& Z# q( C
24.                         P(0) = V(0)
    + B. Z& X0 K1 B* T0 c3 `' W
25.                         P(1) = V(1)
    $ t) {. k: Q! m; s% {+ o
26.                     Else
    ; J  H7 F: _* I$ R0 w) U) S
27.                         '用户选择了计算所有单行文字的几何中心点
    
28.                         For I = 0 To SS.Count - 1
    
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
    
33.                     End If
    
34.                     '指定起始角度和方向等参数
    , |9 i! m" {& _  z1 J9 z0 j0 E) D4 y
35.                     Do
    4 k3 U: z! c# p- t2 D* m- C7 H$ y
36.                         Err.Clear
    
37.                         An = 0
    ! q6 s! ~" Z/ {) O) G. ], T* o1 I
38.                         '定义关键字
    
39.                         .Utility.InitializeUserInput 0, "D"
    7 j! C9 S+ Z/ F. f: N) V
40.                         '由用户在屏幕上指定起始角度或选项
    3 M6 W5 O# @8 c  v9 f+ n. ?
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    4 o& z8 H; g" u( C9 z; Y5 f' I
42.                         '如果用户指定了角度或取消则退出循环向下进行
    ) s, ~) `1 o5 q
43.                         '如果用户输入了关键字
    
44.                         If Err = -2145320928 Then
    ! v' }3 r  n5 p2 b2 H6 x
45.                             '获得用户输入的关键字
    6 `, O! L! N$ A& D3 J1 ]$ u9 O
46.                             S1 = .Utility.GetInput
    0 F. E- M. N2 E! a
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    - V( y) b  {2 k! h5 F% Z% W- p
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    7 f. I* i$ {. R
49.                             If S1 = "D" Then
    4 ]: K; g. H% y( J8 ~3 E* D. {
50.                                 Err.Clear
    
51.                                 '再次定义关键字
    : A3 V: K9 x" _2 d- t6 z! W7 y
52.                                 .Utility.InitializeUserInput 0, "L R"
    + s8 |. r: ?9 j: f9 Q
53.                                 '由用户在屏幕上选择选项
    9 g2 j4 J1 Z* W: m" G7 ~; }
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
      ^3 E' `+ {* C" }+ F  c6 x' J
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    
57.                             End If
    7 z# l# Z0 I" r7 v- B8 x
58.                         End If
    4 [3 X0 w. j& f" U+ S
59.                     Loop Until Err = -2147352567 Or An >= 0
    
60.                     '如果用户没有取消则排序和修改
    6 V# x& q$ e, l
61.                     If Err <> -2147352567 Then
    - O9 e5 f/ r' }% Y, z% w
62.                         '重定义动态数组下标
    
63.                         ReDim A(SS.Count - 1, 1)
    ! T0 K$ h2 t/ E7 ]- V4 C
64.                         For I = 0 To SS.Count - 1
    
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    
67.                             A(I, 1) = I
    ; c) `! J% _, B' f
68.                         Next
    7 l5 y% e0 ?2 X8 t' n2 t* @+ Z
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
    8 q- R, H: ?. j) I" C
73.                                     D = A(J, 0)
    9 ^  }  p5 k% l" Z
74.                                     A(J, 0) = A(I, 0)
    / L: p- A& @4 L! C
75.                                     A(I, 0) = D
    9 p, e7 G* u2 |: Z; I% K1 ?
76.                                     D = A(J, 1)
    
77.                                     A(J, 1) = A(I, 1)
    8 ?9 l8 U, V1 I; C
78.                                     A(I, 1) = D
    % j9 _1 X/ ?& ?2 V' f
79.                                 End If
    
80.                             Next
    
81.                         Next
    ( k+ K. M% r% Q% G) |# z
82.                         '修改文字
    : n3 K! P8 y+ x# T+ f: T/ B: ]
83.                         If S2 = "R" Then
    / Z, v$ y7 _: x9 \2 Q+ a# w
84.                             '顺时针
    
85.                             For I = 0 To SS.Count - 1
    3 X6 @) `* h" {5 e
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    
87.                             Next
    ! j( f& h( j/ M1 D, J
88.                         Else
    ! Y2 p  X/ D2 r+ ^2 `" Y9 a% S- K
89.                             '逆时针
    , `0 I0 v5 g9 s& v
90.                             For I = 0 To SS.Count - 1
    " w1 V) y! e; e
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    . m) x2 n3 w2 y  K
92.                             Next
    2 v) L% p  d0 }! ^; y
93.                         End If
    
94.                     End If
    
95.                 End If
    " t- f$ i% a7 C# \& S, s
96.             End If
    
97.         End If
    ! Z1 z5 t8 Z, j( ?
98.         '删除用过的选择集
    
99.         SS.Delete
    : \' o* A" a! s# d5 n; O
100.     End With

复制代码

taqqug

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