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

taqqug

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
  V. ~, a- \7 }+ O功能：
1.查找-替换
  ?8 [3 b* V, ~6 M0 O+ q) b" o2.加编号排序
2我不知道咋怎

- j+ i& H/ X" p" F( \7 g5 c以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia

8 j) T$ ]4 p% Q- i# i' j, a$ ~

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
   * D3 W* P' Q5 t- j6 U* }" O
2.     On Error Resume Next
   # s0 C$ F$ b( {' g3 p, c. m, N( G4 X& q
3.     With ThisDrawing
   
4.         '创建选择集,用于选择所有文字对象
   % U; W/ v/ O. j$ c, q! a
5.         Set SS = .SelectionSets.Add("SS"
   4 o  q* q- k) [, ]+ V8 m# z
6.         '定义过滤器为选择单行文字对象
   
7.         Ft(0) = 0
     `1 v/ I5 a% B! A* r0 ~( a: H
8.         Fd(0) = "TEXT"
   / Q* E& X6 b% t3 z$ K
9.         '选择所有单行文字对象
   
10.         SS.Select acSelectionSetAll, , , Ft, Fd
    
11.         '当存在单行文字对象时排序和替换
    
12.         If SS.Count > 0 Then
    
13.             '如果只有一个文字对象,则修改其为原字符串+1
    ; k: d9 a* w& Q6 m+ j
14.             '如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字
    $ c0 F8 r% R, Z7 A' z  ~
15.             If SS.Count = 1 Then
    
16.                 SS.Item(0).TextString = SS.Item(0).TextString & 1
    8 D) O9 j9 s  P
17.             Else
    
18.                 '由用户在屏幕上指定中心点
    
19.                 V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
    ' c2 m% v. M+ |  F
20.                 '如果用户没有取消则排序和修改
    9 L/ v1 P, X" `. D
21.                 If Err <> -2147352567 Then
    / [- y9 J. Z  r! `9 \9 g
22.                     If Err = 0 Then
    
23.                         '用户指定了点
    / c) I; ~& C5 F  S5 j
24.                         P(0) = V(0)
    9 i8 c8 f- u& O; F# N
25.                         P(1) = V(1)
    : |0 s+ N+ [7 z* O9 p: Q7 `
26.                     Else
    + W2 o) |5 B2 I+ w& i& X
27.                         '用户选择了计算所有单行文字的几何中心点
    
28.                         For I = 0 To SS.Count - 1
    
29.                             V = SS(I).InsertionPoint
    
30.                             P(0) = P(0) + V(0) / SS.Count
    ; j( A- s; W" u! C- z$ x9 E
31.                             P(1) = P(1) + V(1) / SS.Count
    
32.                         Next
    4 Y8 N. [4 h6 T1 \4 \2 m  [' g
33.                     End If
    
34.                     '指定起始角度和方向等参数
    
35.                     Do
    
36.                         Err.Clear
    3 M6 L) ?+ z) `' j/ V  {7 p: h' M
37.                         An = 0
    / u9 h$ q3 L# Q& E" ]
38.                         '定义关键字
    % w0 q6 ^2 o& y2 t, }# f
39.                         .Utility.InitializeUserInput 0, "D"
    
40.                         '由用户在屏幕上指定起始角度或选项
    3 A8 O$ m& Q% M7 U
41.                         An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
    
42.                         '如果用户指定了角度或取消则退出循环向下进行
    # S  B: p. Y/ ]9 U" D3 O
43.                         '如果用户输入了关键字
    6 k) S, p, k; S# N/ N
44.                         If Err = -2145320928 Then
    
45.                             '获得用户输入的关键字
    
46.                             S1 = .Utility.GetInput
    0 P6 C' O9 I/ P. x( Y, m0 v7 b# u5 h
47.                             '如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
    , \% s5 J4 E" c+ E2 {, {
48.                             '如果关键字为"D"说明用户选择了"方向(D)"选项
    ! g) f1 l  w  x+ a% ^
49.                             If S1 = "D" Then
    6 e% }2 z3 D" e( Y$ x$ k! H/ Q2 [/ A
50.                                 Err.Clear
    
51.                                 '再次定义关键字
    # x) H4 {, g2 _' V, r
52.                                 .Utility.InitializeUserInput 0, "L R"
    + X# y1 l1 e1 Z! d2 @: Y! ~1 O
53.                                 '由用户在屏幕上选择选项
    
54.                                 S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
    ' K+ i7 p" R4 x$ M: i) B, I9 [, `
55.                                 '把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度
    
56.                                 An = -1
    " Y# _" d$ I9 s9 P7 F
57.                             End If
    
58.                         End If
    1 z# I9 t8 D; x; Q6 h
59.                     Loop Until Err = -2147352567 Or An >= 0
    
60.                     '如果用户没有取消则排序和修改
    # q4 N; L) Q) e# m- r, O6 d" |, P+ G
61.                     If Err <> -2147352567 Then
    7 F* C$ k" i* M
62.                         '重定义动态数组下标
    
63.                         ReDim A(SS.Count - 1, 1)
    - J" i9 B3 z6 `- V; M- k
64.                         For I = 0 To SS.Count - 1
    ; A+ f, `3 n0 I5 ?- _8 d
65.                             '计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
    6 c  k" M* [$ y
66.                             A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians)
    - Z# D  O* M. v) d7 R# G5 D
67.                             A(I, 1) = I
    
68.                         Next
    
69.                         '按相对角度从小到大的顺序排序
    * [$ O3 P- f3 \
70.                         For I = 0 To SS.Count - 2
    1 S6 U1 p4 @: M$ Z* ~- a7 m/ O
71.                             For J = I + 1 To SS.Count - 1
    ( G1 D: y! H: {+ d  T* r. G, m
72.                                 If A(J, 0) < A(I, 0) Then
    
73.                                     D = A(J, 0)
      X. k; X  C3 p) R* e
74.                                     A(J, 0) = A(I, 0)
    
75.                                     A(I, 0) = D
    
76.                                     D = A(J, 1)
    
77.                                     A(J, 1) = A(I, 1)
    
78.                                     A(I, 1) = D
    ) H0 y0 D9 _! x
79.                                 End If
    
80.                             Next
    ' Y+ S8 S0 G; `- Q( @; k
81.                         Next
    
82.                         '修改文字
    
83.                         If S2 = "R" Then
    
84.                             '顺时针
    7 c+ |# J# o/ T" A; G" E+ y! b$ L
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
    
88.                         Else
    + u9 j# H0 `+ ]0 A: z% t
89.                             '逆时针
    
90.                             For I = 0 To SS.Count - 1
    
91.                                 SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
    4 o  z) ^+ u% {& b# o
92.                             Next
    
93.                         End If
    5 _6 f* E2 \% n1 ]' [
94.                     End If
    
95.                 End If
    4 v1 ^  }# L1 N& J
96.             End If
    4 }! j, t8 W0 m2 b
97.         End If
    
98.         '删除用过的选择集
    5 z, {' V" {2 t5 \7 I3 E
99.         SS.Delete
    * p+ F4 s: T4 b* }
100.     End With

复制代码

taqqug

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