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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
& S: ^7 L: ^$ C  J3 o功能：
( G+ U0 z" j3 B& Q1 _1 z1.查找-替换
2.加编号排序
: i. v' W8 n+ j+ u2我不知道咋怎

以前版主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
   3 c, Q7 c2 M5 \& I, }) X+ X
2.     On Error Resume Next
   
3.     With ThisDrawing
   / I% R' z( r/ P. o5 a2 q+ I
4.         '创建选择集,用于选择所有文字对象
   2 p! }/ M: S  f* D) w) u
5.         Set SS = .SelectionSets.Add("SS"
   . U: E2 U" E. Y) W6 E  v
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
   
8.         Fd(0) = "TEXT"
   / d1 i2 H% [2 G, I- Y
9.         '选择所有单行文字对象
   & M  H$ _0 p6 s3 T1 M: y
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    7 {8 V* y/ h3 b! }0 [6 \' |) ^
13.             '如果只有一个文字对象,则修改其为原字符串+1
    
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    ) Y4 I+ o, S, D
15.             If SS.Count = 1 Then
      v' a! j6 u+ P3 Q
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    
17.             Else
    
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    
20.                 '如果用户没有取消则排序和修改
    
21.                 If Err <> -2147352567 Then
    * V3 a: F, _2 D8 Q" e% q/ U
22.                     If Err = 0 Then
    
23.                         '用户指定了点
    
24.                         P(0) = V(0)
    + s7 S* e! L9 J5 `  i
25.                         P(1) = V(1)
    
26.                     Else
    . j# d) P" u- {4 ~$ G3 p6 a8 ?$ O
27.                         '用户选择了计算所有单行文字的几何中心点
    4 h6 F# C' t- m! b
28.                         For I = 0 To SS.Count - 1
    9 k4 X, E9 t/ K8 B5 |( @
29.                             V = SS(I).InsertionPoint
    : m! x" `2 Z7 |( ]5 {9 {
30.                             P(0) = P(0) + V(0) / SS.Count
    
31.                             P(1) = P(1) + V(1) / SS.Count
    
32.                         Next
    
33.                     End If
    
34.                     '指定起始角度和方向等参数
    
35.                     Do
    " x" Z' u/ ?6 M; G6 ]1 R6 y* t0 r" p
36.                         Err.Clear
    
37.                         An = 0
    
38.                         '定义关键字
    
39.                         .Utility.InitializeUserInput 0, "D"
    1 B6 w2 }5 X  v, X0 @# C1 W
40.                         '由用户在屏幕上指定起始角度或选项
    
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    # l9 r7 X+ D7 \0 ^
42.                         '如果用户指定了角度或取消则退出循环向下进行
    
43.                         '如果用户输入了关键字
    ; h. ]- K5 W0 x* ^$ F
44.                         If Err = -2145320928 Then
    
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    4 [' s4 T, o* w* ~1 ^; z9 \
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    % E5 F4 Z2 r1 m3 f7 |. ^
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    - R! x1 t: u3 {" M3 \4 w1 D0 K
49.                             If S1 = "D" Then
    
50.                                 Err.Clear
    * ^# `" c) Z2 U5 r9 u, T9 }8 v
51.                                 '再次定义关键字
    
52.                                 .Utility.InitializeUserInput 0, "L R"
    , X9 A/ S9 V8 W2 s
53.                                 '由用户在屏幕上选择选项
    " I$ P+ L% V3 N6 p) q- U, s
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    0 V% H7 V4 j- a
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    3 x8 f2 A8 o- B  z, ?$ ~! X
56.                                 An = -1
    * m9 t0 ^0 r: o" c9 j/ w
57.                             End If
    + L/ W- `' {6 Q- W! }
58.                         End If
    
59.                     Loop Until Err = -2147352567 Or An >= 0
    ) w) F+ \9 S* Y
60.                     '如果用户没有取消则排序和修改
    
61.                     If Err <> -2147352567 Then
    
62.                         '重定义动态数组下标
    . s* G* ^1 ~3 u
63.                         ReDim A(SS.Count - 1, 1)
    # \7 h7 k. w4 \% l2 k( K
64.                         For I = 0 To SS.Count - 1
    2 `' V! C7 ]0 p- V, c
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    ; p' m' R' S( d8 L: ]2 n
67.                             A(I, 1) = I
    3 U2 B7 o3 I# _5 |9 g* I
68.                         Next
    
69.                         '按相对角度从小到大的顺序排序
    8 Y: ]- K* w" Z
70.                         For I = 0 To SS.Count - 2
    " D' R, F4 u% T$ I  J
71.                             For J = I + 1 To SS.Count - 1
    0 E3 X$ I' ^% }$ n) J
72.                                 If A(J, 0) < A(I, 0) Then
    , n  M  O0 A0 s" g; ?# [$ X
73.                                     D = A(J, 0)
    * f; o" o- ^! ^. |: }9 u0 I
74.                                     A(J, 0) = A(I, 0)
    ( U5 F0 }( _5 T; }
75.                                     A(I, 0) = D
    4 j9 w. S% J1 d( T. B- ^
76.                                     D = A(J, 1)
    / x, a& ^5 Q4 g- o/ z
77.                                     A(J, 1) = A(I, 1)
    7 i' j$ {# L7 F
78.                                     A(I, 1) = D
    ( ~! W: \: Y( d3 \: `% {
79.                                 End If
    # M: {1 K, U3 o$ U0 ]) P0 q
80.                             Next
    
81.                         Next
    
82.                         '修改文字
    
83.                         If S2 = "R" Then
    
84.                             '顺时针
    
85.                             For I = 0 To SS.Count - 1
    6 q, n# l8 v# k5 Y. f
86.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
    ' _) T' _6 E7 p! N3 l$ q/ Y
87.                             Next
      O& K! q! A( A$ z" |
88.                         Else
    , T9 |5 O' _$ k8 N& ]
89.                             '逆时针
    
90.                             For I = 0 To SS.Count - 1
    
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    
92.                             Next
    $ ]  L  N: x! F! P+ T8 b7 J
93.                         End If
    
94.                     End If
    # g5 i; G" b% p# b5 w
95.                 End If
    
96.             End If
    1 s, I6 }2 V# K# _4 {
97.         End If
    8 l3 P. v+ L- Q3 w+ E  f
98.         '删除用过的选择集
    ) r8 }) f5 ^5 w  Q( I
99.         SS.Delete
    
100.     End With

复制代码

taqqug

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