|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码3 \9 r' K( n! G9 i2 z
4 I5 w; D( f2 z+ n3 e Y: \
Sub A()' U& ~/ \2 I7 J3 f
On Error Resume Next. I9 h8 J6 ? w$ x& w, O
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
3 D6 |0 k, f% Y9 ?. x With ThisDrawing
# V! x& x" ?4 K Set SS = .SelectionSets.Add("SS") '新建选择集
/ i1 z1 M' `3 U- b6 t; V Ft(0) = 0 '定义选择规则为多段线
1 V+ J/ V7 r. n* Q1 j Fd(0) = "LWPolyLine"
! d0 k y) o- p3 i6 x9 q9 e SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象! ~1 n; K$ o/ D5 T- f9 u) G
For Each PL In SS '遍历选择集中多段线9 v) Q& v& V. p2 T" I
P = PL.Coordinates '获取多段线顶点坐标数组/ m* |- v& T6 T) `6 W' s. O) c. g
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形3 m) ?% N8 _3 F' A7 x) W
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
% h! b: e% [. m: N; } C(1) = (P(1) + P(5)) / 2#
3 p* E8 X& z5 g7 G PL.Delete '删除多段线
% A9 ~% g; n/ f& b, A .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半- {2 t0 G$ O. f" ]. n
End If
% f6 h! d% u8 p0 h5 S" X/ W8 m7 C Next
- b" r# k8 Z, @5 e5 {0 a; B- r1 z SS.Delete '删除选择集
n( N$ o8 k0 ~6 _4 j End With
( C% ]/ t4 B9 W1 Y% @9 M8 |End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
