|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
6 e \( ~: u, d; k" }
: q( ] x3 { J+ J% ySub A()# V# V, K% H2 d4 J9 y$ e
On Error Resume Next9 |* W1 G- n( z2 N* l6 m/ Q& ]
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant" }3 d; P# ?& h, M1 N7 J
With ThisDrawing
, S' ^4 {5 n$ q( w5 w Set SS = .SelectionSets.Add("SS") '新建选择集
b+ S' C A& T& n Ft(0) = 0 '定义选择规则为多段线
3 [4 y* f' Q$ L* a, ? ]' S Fd(0) = "LWPolyLine"
2 e4 R/ [! ], N% R SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
4 |7 z1 }0 U1 Z6 W2 w2 X For Each PL In SS '遍历选择集中多段线
$ u' u& c& a; i+ a# I& U" P C P = PL.Coordinates '获取多段线顶点坐标数组; L, {1 G* u$ s3 g* v) J4 i
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形* z' o. L: H4 |+ A- C7 D r
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
9 H. e/ N5 K6 m2 c C(1) = (P(1) + P(5)) / 2#
+ L- e& `) C% W' v' f, _ PL.Delete '删除多段线3 k! S7 T$ E5 {. B+ f' n' G$ M
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
% O- m+ S+ u& K: U4 e/ x End If
; N# y' T& {1 S/ t Next7 i: k# V% g+ s. w* b1 p( F! b- s
SS.Delete '删除选择集# B! C; h6 g* z" F, V$ K# c
End With
* C. u9 U7 o' y7 }& D3 K! dEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
