|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
; m w. ], C% `) Y6 i7 W7 M2 @6 j: Y/ i* V9 A5 x5 c2 V
Sub A()
( L. @+ F. i6 m {. R. |+ UOn Error Resume Next) Z0 r$ b H- p; l8 [
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
/ O4 I, T ^/ T3 N9 t1 _ With ThisDrawing
. w4 p; O5 W$ t6 e, p# U, _ Set SS = .SelectionSets.Add("SS") '新建选择集
p& g9 K$ D% x3 n Ft(0) = 0 '定义选择规则为多段线
. d# @" }0 b& ]% p Fd(0) = "LWPolyLine"( G4 @0 c0 u* t$ Q+ M& u2 }
SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象3 F; ~ y: B0 `+ k
For Each PL In SS '遍历选择集中多段线
, ]! Z7 p. D X: o, B/ E P = PL.Coordinates '获取多段线顶点坐标数组
6 k6 c1 a0 V, a$ n% E/ W If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形% G8 G2 \# ~* Z7 s1 K
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
* {2 y( v9 |' ]) }( b( K3 H3 Y C(1) = (P(1) + P(5)) / 2#/ m0 S0 I* E3 B0 ~9 [5 r6 S5 O
PL.Delete '删除多段线
0 n( V1 U6 {" h; p4 a0 M$ j .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
4 W+ b2 P7 P: q End If* T) _" S6 c% M2 R6 s8 S
Next( [# t) u+ Y& O3 S
SS.Delete '删除选择集
c1 B" T5 t0 S1 ~) h; `% ~ End With2 m1 H9 N3 L1 f" x# A5 d
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
