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

taqqug · 发表于 2011-4-14 11:10:30

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

请教一下大家，我想在CAD图纸中实现查找指定的文字，然后替换成想要的文字，还要按相对于指定点90度,顺（或逆）时针加编号排序，头疼在排序，请大家帮忙，谢谢！（如图）
功能：
1.查找-替换
2.加编号排序
2我不知道咋怎

以前版主woaishuijia 帮忙给过方法，但我想扩展一下功能，一直不得其解，还请大家帮忙！

woaishuijia · 发表于 2011-4-19 09:54:00

本帖最后由 woaishuijia 于 2011-4-23 10:56 编辑

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 String3 h% f8 x! K# B4 y
On Error Resume Next( d! e1 t1 K g O5 x8 |: r" V/ Q
With ThisDrawing
7 ^" M' j l5 A& ?, D
'创建选择集,用于选择所有文字对象
8 g/ m: i. q* O; ^* J I
Set SS = .SelectionSets.Add("SS"0 ]1 q0 j; s% | [! T6 v% t1 `
'定义过滤器为选择单行文字对象# ^- U, a/ x' L! O0 c; I/ d$ \6 W
Ft(0) = 0
! Z7 z! N; r0 D7 S5 W, B
Fd(0) = "TEXT"
' l8 p' ?9 F. |" S, h3 R
'选择所有单行文字对象% W3 v. L5 i5 d5 `7 n6 k
SS.Select acSelectionSetAll, , , Ft, Fd! C, v/ b3 s0 g6 G! o. ^% J; q
'当存在单行文字对象时排序和替换
6 d3 f% s3 y4 J% b
If SS.Count > 0 Then; A* V6 k; R- R7 o! @; R1 i; L; }
'如果只有一个文字对象,则修改其为原字符串+19 u0 ~/ E: ^5 E( E0 ?- ~ |
'如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字 E* I3 _1 ]( S# q6 N+ r
If SS.Count = 1 Then; H9 {0 d3 }& J* k
SS.Item(0).TextString = SS.Item(0).TextString & 1+ g$ b+ e+ c6 s& f8 n# B9 |
Else: {/ u6 B% K8 a" u+ J. w8 H
'由用户在屏幕上指定中心点/ n$ C$ `0 L4 l. g. v1 j
V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"
. ~& O" S" {# L) f" e9 b# V
'如果用户没有取消则排序和修改
/ t+ c& [) a; b. d) e
If Err <> -2147352567 Then f$ m7 e! V3 Z
If Err = 0 Then
7 R1 t% p' g# n" m- {) Y6 s
'用户指定了点( ^ D: S, @ ?/ s& X* g, Q
P(0) = V(0)
- G% \) M3 I9 c& q# d! p) X9 c
P(1) = V(1)( {$ v+ m3 d& F* U+ K
Else
t0 y8 k# b; S9 `/ O% V
'用户选择了计算所有单行文字的几何中心点
% D9 D E6 A9 O8 ~: X9 E
For I = 0 To SS.Count - 19 p- \% d0 k- [% k
V = SS(I).InsertionPoint
4 e$ t8 Y+ e: D- y( B
P(0) = P(0) + V(0) / SS.Count
/ T5 `$ Y( Q6 D& B1 C
P(1) = P(1) + V(1) / SS.Count
/ b3 B+ E" f) E
Next* Y0 y6 g5 W$ B
End If. w0 t+ H5 X4 }) O6 g
'指定起始角度和方向等参数8 n: l9 J. ~5 U4 Q3 J
Do
4 l6 t8 h8 C. N/ _: R3 @/ H( Y
Err.Clear" z) w: e4 I) y P @; A
An = 0
3 u D3 V8 r4 d4 W; d
'定义关键字+ d4 u& C* C/ v3 q* Q# Z
.Utility.InitializeUserInput 0, "D"* f9 G- y. n, G; M
'由用户在屏幕上指定起始角度或选项
9 D* ?5 H, r' V0 _
An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
" I3 K# o9 E' B, l- i' Z
'如果用户指定了角度或取消则退出循环向下进行6 f! g9 a7 n* v
'如果用户输入了关键字" H1 c4 }( n( z
If Err = -2145320928 Then# v- m9 c. I' m! s3 z. |; ^1 O1 G
'获得用户输入的关键字; B/ R+ R# ^: G* h$ ^0 C- h
S1 = .Utility.GetInput
'如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行' g0 X. U6 {* X+ o" b9 O: C' E1 O
'如果关键字为"D"说明用户选择了"方向(D)"选项
1 ^8 U- ]* C& A e
If S1 = "D" Then3 M8 U5 w0 R- r" M) i1 n( J; j. N
Err.Clear
! W: x: D9 @* o
'再次定义关键字 v/ I7 k$ \% Y
.Utility.InitializeUserInput 0, "L R"
( z- Z, `0 s% O; Y2 i# V4 L3 [# x
'由用户在屏幕上选择选项
, C# T% f; p2 t6 H
S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
~0 g+ W0 z( T, r- |6 x9 D! I
'把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度6 ~. ^/ y7 P J1 o# ]
An = -1
+ j2 S$ C3 @) Z3 V) y/ s _. |" F
End If
% w. w! @ t; I6 K: m
End If; h' b1 G$ ]9 X) [, Q
Loop Until Err = -2147352567 Or An >= 0
, X6 O+ J" k t9 t7 e2 ?
'如果用户没有取消则排序和修改
2 |2 r2 h: m% `( D+ g
If Err <> -2147352567 Then( K& m; B$ ?# x6 N/ ^/ ]; X
'重定义动态数组下标
' t: S J k# N& y
ReDim A(SS.Count - 1, 1)
/ C6 m( F3 V$ k% [5 S' ~. {, J
For I = 0 To SS.Count - 1
# K; X6 {& w8 j! s/ O
'计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号4 ]' T& B" H; }% l6 Y) \# ^
A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians). {$ v$ R# b- ?
A(I, 1) = I
1 d2 o, U; ?% n4 g0 V' u% x: L" S
Next& G8 L' n0 G7 d) x p
'按相对角度从小到大的顺序排序
' F, Z# n# W% G* P& x- y9 Y. o$ |
For I = 0 To SS.Count - 2- m, |% B6 i' `0 B" k
For J = I + 1 To SS.Count - 1- h+ r6 |2 T! P( k9 A
If A(J, 0) < A(I, 0) Then
, c! S% o% [% ~& ~
D = A(J, 0)
9 x5 b( I4 ]; x0 i4 ~8 h( _
A(J, 0) = A(I, 0), a* a& V% `1 t* |; R
A(I, 0) = D
|! g; S+ L% Z' H! e0 {5 _
D = A(J, 1)
( q6 S: y6 g; E1 A
A(J, 1) = A(I, 1)! Y+ h9 B9 e, t1 a: e7 a
A(I, 1) = D/ ^0 G) {" |+ \
End If
" s7 i8 i# `7 y$ b
Next
& P) O% p1 R9 F% x; O* L0 l
Next, y% \" X" g( ?# n" D
'修改文字
8 |) _) I& B2 ^# x9 Q) t
If S2 = "R" Then, U7 D" h* u. `
'顺时针# e# u9 _! Q- M; V4 m1 H
For I = 0 To SS.Count - 1
. r. I* z- E4 t
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I
# K* t6 y% d* T# r5 D6 c% [
Next* K% Q2 i2 h$ a
Else) j2 D% s6 ]& y! e" s
'逆时针9 x2 T: Q' ^. V6 }
For I = 0 To SS.Count - 1
3 I. ^3 j* Q7 J: x* E6 L& v
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)5 C$ ]2 l: r( p1 o% n1 _1 f+ v+ O3 |
Next
A( f2 w0 y) j. X9 J, f4 L
End If
! {% j# D( ~% h, @
End If
( x0 }/ I; l3 h8 `" b
End If
* ?% L6 S& _+ w) R9 g" N7 t' g4 t
End If% i1 ^3 ~* f. H' O% z2 X( o
End If, O2 u' h L& J# g
'删除用过的选择集; q( x" M4 I) i: x0 j; E9 Z
SS.Delete4 \$ y! g8 C9 I: ]/ M' @
End With

复制代码

taqqug · 发表于 2011-4-22 14:11:54

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

		自动登录	找回密码
密码			注册

全站		goto3d 说: 此次SW竞赛获奖名单公布如下，抱歉晚了，版主最近太忙：一等奖：塔山817；二等奖：a9041、飞鱼；三等奖：wx_dfA5IKla、xwj960414、bzlgl、hklecon；请以上各位和版主联系，领取奖金！！！	2022-03-11
全站		goto3d 说: 在线网校新上线表哥同事（Mastercam2022）+虞为民版大（inventor2022）的最新课程，来围观吧！	2021-06-26

通知

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

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。