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 String
. e7 l) g+ Y4 Z: Z3 E9 T( s
On Error Resume Next
9 Z( t% J" y7 H2 H
With ThisDrawing
0 A9 L& O B3 E( e* Y+ N- y6 C
'创建选择集,用于选择所有文字对象( z6 O$ `, b' y, I$ w1 y( v. Q6 t
Set SS = .SelectionSets.Add("SS"; [ ~) d6 p' e- Z
'定义过滤器为选择单行文字对象
" f: h/ O# o3 x* ^* F8 A& Q
Ft(0) = 0# x, i% Y% ~! E* H8 U0 `
Fd(0) = "TEXT"7 g2 X0 Q- x# f' b7 _
'选择所有单行文字对象- x- h9 y/ b. o5 k: A& B, F
SS.Select acSelectionSetAll, , , Ft, Fd# M8 i3 g6 e, J" X
'当存在单行文字对象时排序和替换% z9 y5 W: ]) s3 y& D- }6 t3 S( b
If SS.Count > 0 Then" S5 {: S8 X- G- R# N& `
'如果只有一个文字对象,则修改其为原字符串+1
9 O- |; v: y! @. Q4 R) b$ x7 k
'如果有多个文字对象,则由用户指定中心点,起始角度和方向并修改文字: c0 d3 l9 I) W% O
If SS.Count = 1 Then
3 ~: S9 D f# @6 O+ V3 j9 m6 \
SS.Item(0).TextString = SS.Item(0).TextString & 1$ {4 B7 y: Y. t5 r+ {" X. P
Else
Y+ [6 e1 c/ X& z% s
'由用户在屏幕上指定中心点
7 w- h3 j3 C6 @: l& {( Z
V = .Utility.GetPoint(, "指定中心点或 <计算所有单行文字的几何中心点>:"# r2 `7 Z9 d4 {" m
'如果用户没有取消则排序和修改' \" G% |3 q4 w4 k+ S$ R1 I" W
If Err <> -2147352567 Then
; ^5 [. j3 q& I' t3 b1 d
If Err = 0 Then, O* ]# D! H# m) d
'用户指定了点3 B0 U0 x3 z4 D4 {$ e) G- q
P(0) = V(0)
3 n& K" k' s! x( C. q* v
P(1) = V(1)
7 ?6 P, c1 c! F1 M
Else
" \* O7 d3 D# P, ]9 b
'用户选择了计算所有单行文字的几何中心点% C8 f T3 o4 X8 l, @
For I = 0 To SS.Count - 11 M1 j: D0 ?" B& L+ P$ Q$ i( T
V = SS(I).InsertionPoint
$ Y" P- i3 `# x/ j J
P(0) = P(0) + V(0) / SS.Count
- O! h- B: j% v2 W `7 G& C
P(1) = P(1) + V(1) / SS.Count6 h/ s8 h7 q/ {% k6 |2 D, E. x4 K
Next0 M3 O9 y7 Z2 ?6 U
End If
3 W0 m2 x- o9 z
'指定起始角度和方向等参数# B: A) W, A& _/ B4 }. N7 b* I' S2 s
Do1 }2 n! M8 m" [' @$ ^0 U+ T
Err.Clear
) _$ B: X+ a0 `8 j3 [7 Z+ n0 ^
An = 0
" K3 Y% d9 z9 ^4 Q& ` N
'定义关键字
$ @; C) ?! N" A2 U% l- [$ N
.Utility.InitializeUserInput 0, "D"2 R: \: l3 z% F) r3 n5 {
'由用户在屏幕上指定起始角度或选项
7 o, r1 J, q/ J
An = .Utility.GetAngle(P, "指定起始角度或 [方向(D)] <0>:"
: e* x0 Z2 v& z/ x& K
'如果用户指定了角度或取消则退出循环向下进行* D/ |) X7 O5 A& y3 e
'如果用户输入了关键字
: ]! m- _; P' j0 o( B$ D
If Err = -2145320928 Then2 B0 E* r8 ?( {- Y1 m: ~" M9 x; ^/ m
'获得用户输入的关键字
) o Y" o4 F T
S1 = .Utility.GetInput
* P Z& F# ]5 j* J! X
'如果关键字为空说明是用户直接回车,则确定起始角度为0度并退出循环向下进行
6 n& r' W% r8 V; ?8 v
'如果关键字为"D"说明用户选择了"方向(D)"选项" i. q3 @6 C4 o3 m# h
If S1 = "D" Then
+ m" j( l* |: G
Err.Clear2 Y8 n+ R" H; ?6 |$ m- U
'再次定义关键字
3 A6 a2 Y8 m: K$ D2 N1 S
.Utility.InitializeUserInput 0, "L R", c" O& b4 c7 N- q
'由用户在屏幕上选择选项
& W; s8 h& P- X7 t$ P) K$ Y, c
S2 = .Utility.GetKeyword("指定方向 [逆时针(L)/顺时针(R)] <L>:"
- P! S5 I) s+ U5 ^1 I0 T8 @
'把起始角度改为负数,使其不能满足结束循环的条件,返回重新指定角度/ L. f0 E; m$ ~
An = -1, @" G0 @/ C5 E9 ?6 w; U9 B% m' D& {: ?
End If0 u! s* j* @7 p. u G' v
End If6 E8 [' W( `% R' [0 M
Loop Until Err = -2147352567 Or An >= 0
: _# m" @& K* l2 c v' O/ |' ?4 H
'如果用户没有取消则排序和修改
, N% p2 {2 k3 E' e3 E
If Err <> -2147352567 Then
3 @9 s2 K% o; P, N
'重定义动态数组下标
/ w9 J, |' N1 n
ReDim A(SS.Count - 1, 1)
M6 B5 A, s, W, Y0 v
For I = 0 To SS.Count - 1
# K. z% ]! D* Q# u
'计算所有单行文字对象相对于中心点的角度再减去起始角度的差,并记录其在选择集中的索引号
- h; |/ K$ k* E4 ^+ C! w3 I. K) } ]
A(I, 0) = .Utility.AngleToReal(.Utility.AngleFromXAxis(P, SS.Item(I).InsertionPoint) - An, acRadians). {* x* a6 u1 N& T1 F
A(I, 1) = I
- F5 W; ~4 k: y9 q! Z+ Y
Next Z+ }# V4 O2 Q( u; S4 l: u9 [# ^
'按相对角度从小到大的顺序排序% O( T: t* q# D8 R' o! S
For I = 0 To SS.Count - 2
9 E# }& N' Y" I# [# ~/ R
For J = I + 1 To SS.Count - 1
( f7 Q |' \, L& O' C$ s3 m' z
If A(J, 0) < A(I, 0) Then0 J" [3 _' @" w' M8 P' m2 h2 Y
D = A(J, 0)
[2 j4 J1 }& b8 k7 q
A(J, 0) = A(I, 0)
1 x. o- m8 E9 L2 w7 j1 P. Z& R& {3 Z
A(I, 0) = D
& O, w9 T' \- _' t: p6 q
D = A(J, 1)0 ?1 ?+ ^% U% K; x) p
A(J, 1) = A(I, 1)' `" l9 W6 l0 h5 }1 V3 K% p
A(I, 1) = D
( `4 ~% j& l/ r
End If
: `9 {4 u2 S. O/ s4 V* p
Next/ p' \& I7 c: |+ T* ~% P+ K
Next
4 ]: o: v6 ~7 U: B
'修改文字
) _; a6 r- |$ F& {( ]( `
If S2 = "R" Then
& \. k7 p& i. n1 p
'顺时针
6 X, U- s+ x; x2 o% s( w+ {
For I = 0 To SS.Count - 1
/ n, |6 z% H, v2 e0 n& M2 h1 U0 `+ T
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & SS.Count - I2 w; k/ E1 Q2 @- _ d5 M8 g, Y
Next ^: A! i7 E2 A3 j3 ]/ y
Else) h9 Z4 Y8 f- h0 P! I
'逆时针
. |& v; {5 P; {8 q
For I = 0 To SS.Count - 14 ?5 ?. ]$ p5 G/ S n
SS.Item(A(I, 1)).TextString = SS.Item(A(I, 1)).TextString & (I + 1)
* t, n" w( z! \( y! Q
Next
1 S* F# v( A: `% x1 {! q; U+ {+ D
End If0 X4 \ X0 H# J- n
End If
2 r7 [' `% j; i: ]: ]8 ^
End If
8 Q7 a8 c1 C$ ?9 ~
End If" F P* o5 y- f7 {3 k( d
End If
+ k" c" N# g; n
'删除用过的选择集
/ B+ S, b) h: ?- ^" g0 b( `
SS.Delete: f5 N8 U7 S! {. a1 p
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度顺（或逆）时针加编号排序?

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