CAD_VBA怎样文字查找替换并排序？

taqqug · 发表于 2011-3-24 21:10:33

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

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

x

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

         文字       文字                                           文字02          文字03

文字                            文字 ----------------  文字01                               文字04
         文字                                                             文字06
                        文字                                                                文字05

taqqug · 发表于 2011-3-24 21:15:04

最好给出代码，谢谢了!

woaishuijia · 发表于 2011-3-25 00:23:55

是否可以这样:
遍历所有文字对象并分别对其X和Y坐标加总平均,找出所有文字对象的几何中心点,再计算出所有文字对象相对于此点的角度,排序,按排序结果替换.
下面的代码仅供参考

Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, V As Variant, P(2) As Double, A() As Double, I As Integer, J As Integer, D As Double
4 z2 Y3 g7 B0 Q8 s1 s2 g
With ThisDrawing7 _# G, j& n& Y& l. i6 W3 E5 @ H5 X
'创建选择集,用于选择所有文字对象
) n: t v6 o6 h- V
Set SS = .SelectionSets.Add("SS")
' z" ] a, s6 `, i, r
'定义过滤器为选择单行文字对象
9 I6 p9 [3 n: c. S/ x
Ft(0) = 0% a0 A2 K6 ?& C9 G/ O# t
Fd(0) = "TEXT"8 l( Y) X; Q6 w* {, c- Q
'选择所有单行文字对象
5 j3 T4 }. j* }/ P1 f
SS.Select acSelectionSetAll, , , Ft, Fd
3 U: r! U. r$ `3 {, I+ x/ [
'当存在单行文字对象时排序和替换( E; ]+ E1 [2 v/ A& F' a' ~( s
If SS.Count > 0 Then
% A6 f5 c# m7 T: r+ T% k3 O$ r
'计算所有单行文字的几何中心
4 G: P$ h2 D3 @. n+ X
For I = 0 To SS.Count - 12 ]3 ~# h1 B G- f1 F- ]: i |
V = SS(I).InsertionPoint
. {) ], B9 I% f; @7 S4 u* C
P(0) = P(0) + V(0) / SS.Count3 K, P$ `! P2 |5 p; q
P(1) = P(1) + V(1) / SS.Count
1 k: M' a7 V4 s6 i8 O* D R" y
Next
8 v$ ~5 T+ g3 Y% n4 r
'重定义动态数组下标
, h8 i+ O z9 @0 p! G
ReDim A(SS.Count - 1, 1)2 f. j2 x, Y7 a1 l w9 U
For I = 0 To SS.Count - 1
7 h, N* f( v) V+ i& }
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号
% R+ @& l4 @# L7 w$ e
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)9 B6 m" N6 u2 A
A(I, 1) = I
4 p" k$ l2 ?0 L( E* w- e( D' K
Next2 }0 v9 e# m/ y: `! w+ G6 W/ h
'按角度从大到小的顺序排序* \% N$ u. c# W0 c" x2 j5 D% C
For I = 0 To SS.Count - 2
! Q; J4 S- h% T- \$ ^
For J = I + 1 To SS.Count - 10 D9 H3 s" r: V& \& s; U* _
If A(J, 0) > A(I, 0) Then
' R; p2 M" C. K. D2 [( ~9 D9 q7 W
D = A(J, 0)- @. F9 d6 x' J% i1 s4 d+ k
A(J, 0) = A(I, 0)
3 z* m* f6 p% k
A(I, 0) = D: m4 D. n' h) g7 G, K
D = A(J, 1)( e, H+ q2 R+ M6 o1 c( V
A(J, 1) = A(I, 1)
7 z: [5 B( f* A8 I
A(I, 1) = D
$ d* d) k0 ]+ P0 } N( T1 {9 s
End If
; `3 \+ H, v5 ]" M! B
Next
& w J5 h; e: u# h: L( y5 P
Next+ y6 ?9 J9 K( N r5 A
'替换
7 T+ Y% o5 c' W E; T+ A
For I = 0 To SS.Count - 1- W( }% _2 s B# [9 C$ X8 }
SS(A(I, 1)).TextString = I + 1. l6 u) ]* U! `4 Z/ j$ v
Next
) C a; E+ d- k" `5 H
End If
9 e! ]& M- d0 K+ V1 i& |+ N
'删除用过的选择集) l! m- I3 ^ r" O! Y
SS.Delete6 s( k* \! u. U7 ~, f0 N4 v# [, Y
End With

复制代码

taqqug · 发表于 2011-3-25 10:25:55

woaishuijia 你这个思路太好了，我用坐标比较，整了半天没整好，非常感谢！

woaishuijia · 发表于 2011-3-25 12:23:08

我又想了一下,只用加总平均的办法计算中心点未免有点太单一了.如果增加一个选项,由用户在屏幕上指定中心点会更好些

Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, V As Variant, P(2) As Double, A() As Double, I As Integer, J As Integer, D As Double
' q: O5 }2 e+ ^3 R) D% w- O
On Error Resume Next
& J3 Q$ r# m( G$ u
With ThisDrawing/ K; {6 K2 y* g6 x2 q8 Y( @6 G
'创建选择集,用于选择所有文字对象' W6 _: f# j+ N+ O( f1 T# d) p
Set SS = .SelectionSets.Add("SS")
! L) ?" I* I) D
'定义过滤器为选择单行文字对象
5 X" R4 S$ w$ @2 f: u' l9 L# B
Ft(0) = 0: v5 E1 d# a0 b8 R
Fd(0) = "TEXT"
) u/ O+ o6 I; m" F% b& u
'选择所有单行文字对象
3 U: m1 y6 L; p. k8 H+ R! b2 J) O
SS.Select acSelectionSetAll, , , Ft, Fd8 h& q( @4 j3 X" S# `
'当存在单行文字对象时排序和替换% M3 ]3 }* @ g* [
If SS.Count > 0 Then
3 c9 j' R {3 \" r' U
'由用户在屏幕上指定中心点
/ V5 H0 {4 a. E( K) ~6 j4 z2 P+ ^0 |4 q
V = .Utility.GetPoint(, "指定中心点<默认>:")1 v: i6 o0 ^6 u+ z1 ]
'如果用户没有取消则排序和替换( U4 B' k) Z9 c
If Err <> -2147352567 Then
. ~8 a# u+ f; A8 _' d" }: V+ E
'用户指定了点
- R) K6 [3 [0 b
If Err = 0 Then
7 D1 r, A+ N C" \4 o2 y7 ^
P(0) = V(0)
7 U1 A9 q; e M1 _/ a
P(1) = V(1), M# G* j0 ]7 f' ~3 u- d; R9 }( k' d
'用户选择了默认
. g3 @- D8 Q z9 _9 K, g5 \
Else
) ]( L5 I' w( q# }
'计算所有单行文字的几何中心
& ~2 n/ Z- ^' [
For I = 0 To SS.Count - 1$ @& [! o& w6 r# f1 @ X" Y' d
V = SS(I).InsertionPoint
( z$ n2 C, [5 z' _6 C; s
P(0) = P(0) + V(0) / SS.Count9 v" L0 Q, ]" ^
P(1) = P(1) + V(1) / SS.Count
2 q7 E+ a; u: g5 _# j' C5 V
Next
+ C! x! z, u4 e7 M! @7 \* C/ x
End If
c6 Y" N6 ^3 ]( b0 g% g# Z
'重定义动态数组下标* C, T5 P% x0 X/ Z3 h- ~( U2 Q
ReDim A(SS.Count - 1, 1)
' ~$ }. u+ i0 g* R* o" d" T
For I = 0 To SS.Count - 1. ]8 T) A7 W. m8 Z! x- v- o' I1 {
'计算所有单行文字对象相对于中心点的角度,并记录其在选择集中的索引号
+ P4 X' g a5 Y7 R) ]
A(I, 0) = .Utility.AngleFromXAxis(SS(I).InsertionPoint, P)
# |) n4 q# F5 P
A(I, 1) = I
" M/ M6 F; e6 p K; y) h8 Y# f8 B4 V
Next
( A- d) [4 Z0 J& q; j( p! E. H4 T
'按角度从大到小的顺序排序8 |+ e9 _1 l* j$ Z
For I = 0 To SS.Count - 25 y3 p* ]2 h. z/ J
For J = I + 1 To SS.Count - 1- L% v1 g* n" E; v6 e+ N) M7 P/ J j2 k! G
If A(J, 0) > A(I, 0) Then2 R# s" k* n$ q5 G( h' ^& n" U( ~" r# }
D = A(J, 0)
- a4 N0 @8 D8 W) ~' Q( r
A(J, 0) = A(I, 0)
) k6 L8 P4 k! R1 D* g2 ?' n. Q; e
A(I, 0) = D
4 ~# ^ T9 ^/ H8 A" N5 D
D = A(J, 1)
) u' @- d' [" {) H9 ^4 u
A(J, 1) = A(I, 1)# H( P$ ]4 e' N$ y. }' C
A(I, 1) = D' }" L& {' S' Z+ c K
End If
1 H+ [* F9 a; u) K! h6 n
Next$ o5 I& V+ I A" {& ]
Next+ i5 A% j2 \7 l6 m7 C' S4 \: M
'替换
$ `1 k2 {4 |3 b. q5 h) ]5 ?9 X
For I = 0 To SS.Count - 1, ?9 H# Y( Q. z. b
SS(A(I, 1)).TextString = I + 1
# c6 t! R* m9 H% K1 k
Next' J+ n0 ]" {! S4 S
End If
6 ? N* Z) ]% t+ x5 `- g
End If
5 y; d- g* G' S9 ]% U) J; \( _
'删除用过的选择集+ {. u7 e; A) Q
SS.Delete( i- z0 w2 S F: G% g
End With

复制代码

wangdy111 · 发表于 2011-3-26 11:15:07

版主真是高手，羡慕，我就会点autolisp基础，能编一点简单程序，请问，需要学vb编程吗，是不是够用就行，vb编程有什么好处

taqqug · 发表于 2011-4-14 11:00:27

5# woaishuijia

能不能做成这样，我们随意指定一点，然后从相对此点的90度方向开始顺时针编号，如图所示：
我考虑到用极坐标，但达不到效果，还想请教一下大家，谢谢了

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

通知

[已答复] CAD_VBA怎样文字查找替换并排序？

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