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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
5 \, P! j+ ~* ?! ]  t% q8 h功能：
1.查找-替换
3 T7 v7 ]* E; X3 p$ n2.加编号排序
, _2 G- p* h+ o& k  y) |0 G  c2我不知道咋怎

/ [6 ?8 O8 m3 ^+ C" X8 s8 F( @以前版主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
   * {5 d8 t9 g1 Q- t
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   
5.         Set SS = .SelectionSets.Add("SS"
   7 K2 J) |* A- J7 d9 X1 d  m
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
   
8.         Fd(0) = "TEXT"
   
9.         '选择所有单行文字对象
   . w* D# A  ]' v# u" i" W' H
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    ) p. d) E( ^/ j  ^
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    0 L+ C9 j( Q2 R8 V4 X7 {$ m0 H
13.             '如果只有一个文字对象,则修改其为原字符串+1
    
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    9 C! _3 n+ F! ~9 G0 K4 h/ n
15.             If SS.Count = 1 Then
    5 {* ~+ a# g* y
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    3 k5 p  z) F$ ~0 P# Q# D2 _
17.             Else
    
18.                 '由用户在屏幕上指定中心点
    9 S; `/ V5 Y: d5 Q
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    
20.                 '如果用户没有取消则排序和修改
    
21.                 If Err <> -2147352567 Then
    
22.                     If Err = 0 Then
    
23.                         '用户指定了点
    ; e7 U5 w0 U$ |" v9 L+ B8 w/ n
24.                         P(0) = V(0)
    + G8 ^/ M' S: G% W. J
25.                         P(1) = V(1)
    
26.                     Else
    
27.                         '用户选择了计算所有单行文字的几何中心点
    0 r% b* L1 I( g6 A
28.                         For I = 0 To SS.Count - 1
    " c9 p$ D6 k3 B8 t# f9 n
29.                             V = SS(I).InsertionPoint
    
30.                             P(0) = P(0) + V(0) / SS.Count
    
31.                             P(1) = P(1) + V(1) / SS.Count
    8 R8 E- ]: c4 a3 O! E- G( O5 E
32.                         Next
    ) A; S6 h, T! }5 T$ ~
33.                     End If
    
34.                     '指定起始角度和方向等参数
    0 v" v& S1 L- M$ C1 n- J
35.                     Do
    2 c8 ^" v6 l; J3 N' T
36.                         Err.Clear
    / Y2 Y& D/ D7 \$ C  @
37.                         An = 0
    . F1 a6 ]4 _6 i0 f* \3 t' Y+ B3 n+ W
38.                         '定义关键字
    - v5 P- w# d7 t5 M3 N% L0 A- |
39.                         .Utility.InitializeUserInput 0, "D"
    " u. z, B3 z* I& D; ~: D
40.                         '由用户在屏幕上指定起始角度或选项
    
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    
42.                         '如果用户指定了角度或取消则退出循环向下进行
    
43.                         '如果用户输入了关键字
    , V5 g- _& x+ l+ o
44.                         If Err = -2145320928 Then
    
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    8 {4 L6 c. J, I9 {8 F- I* K
49.                             If S1 = "D" Then
    - Z" _/ v6 w. j2 ^0 P- Q  Q! H
50.                                 Err.Clear
    * B$ X5 T9 @: L4 w
51.                                 '再次定义关键字
    ( L5 R- A0 G- c( \7 m
52.                                 .Utility.InitializeUserInput 0, "L R"
    
53.                                 '由用户在屏幕上选择选项
    
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    $ E& s. F6 w2 L
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    
57.                             End If
    : y* S# ^8 H$ `" j
58.                         End If
    
59.                     Loop Until Err = -2147352567 Or An >= 0
    . {$ ^, ^$ v5 B0 w' C) U9 X  u
60.                     '如果用户没有取消则排序和修改
    
61.                     If Err <> -2147352567 Then
    
62.                         '重定义动态数组下标
    * P! d  O! G2 ~1 a+ n6 B- c
63.                         ReDim A(SS.Count - 1, 1)
    
64.                         For I = 0 To SS.Count - 1
    , z6 n8 w& \# |& D. D5 K
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    , i8 Q2 ^3 D$ p, C' Y$ x
67.                             A(I, 1) = I
    3 y/ R4 n* ^: U' d2 q
68.                         Next
    ! \6 `! q2 e; R( {' |% t' u  a
69.                         '按相对角度从小到大的顺序排序
    
70.                         For I = 0 To SS.Count - 2
    
71.                             For J = I + 1 To SS.Count - 1
    3 D+ D0 `. a+ e8 K
72.                                 If A(J, 0) < A(I, 0) Then
      e) e; X8 Q: U3 q* Q  t
73.                                     D = A(J, 0)
    
74.                                     A(J, 0) = A(I, 0)
    
75.                                     A(I, 0) = D
    
76.                                     D = A(J, 1)
    
77.                                     A(J, 1) = A(I, 1)
    3 o7 [0 f. _8 G, ]0 F* e
78.                                     A(I, 1) = D
    * e2 R3 u0 F6 L5 W  s8 B' a) e2 g
79.                                 End If
    % w6 w+ o4 z6 w3 L* E( i3 z/ A: k5 s
80.                             Next
    ; F2 w+ Y+ n# L
81.                         Next
      ]- |0 T9 P/ Y8 X0 A+ U& |
82.                         '修改文字
    ) H0 X% T& v( }8 Y8 I; ]+ ~4 Z
83.                         If S2 = "R" Then
    / p0 I" C& e6 S; O+ Z! R& W9 k
84.                             '顺时针
    7 r0 x( g8 t5 Y9 L- |7 z
85.                             For I = 0 To SS.Count - 1
    
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    1 O& w% ]( `/ v# a1 J9 J. o1 ~/ E
87.                             Next
    
88.                         Else
    
89.                             '逆时针
    
90.                             For I = 0 To SS.Count - 1
    ! c4 Z! D8 h( _8 ?! O  d
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    2 U) }; g* b! C$ O0 N
92.                             Next
    8 [7 F) v) E( Q5 S4 D
93.                         End If
    
94.                     End If
    & O+ t; n: e: O7 Z
95.                 End If
    
96.             End If
    . \3 p/ H/ C: {3 c
97.         End If
    
98.         '删除用过的选择集
    7 r9 m* U7 s5 ^# q" Y
99.         SS.Delete
    / g" r. W& n6 j$ _
100.     End With

复制代码

taqqug

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