|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
( s ` Z% y' p# b0 c; a0 o0 j( d3 I% d# \- o4 k5 l
Sub A()2 g: p# ^+ a6 d9 _
On Error Resume Next
5 g/ W0 U5 L0 l8 s Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
5 |1 A% A3 e2 `5 [' c With ThisDrawing
6 |" n* u; `! h% ~ Set SS = .SelectionSets.Add("SS") '新建选择集' p8 I, l2 W: D2 l& \* V
Ft(0) = 0 '定义选择规则为多段线
, U" L+ g& t4 } Fd(0) = "LWPolyLine"
% m/ a- f& j( _7 R+ A SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
( A7 P( l d0 K' m) { For Each PL In SS '遍历选择集中多段线+ R0 k1 h+ F! L! A
P = PL.Coordinates '获取多段线顶点坐标数组
- y, B" u( l0 N2 y! _4 ]' L If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
2 |1 ^4 _6 u2 J7 \ C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
/ Z" W% j9 n, }9 N, ?. H C(1) = (P(1) + P(5)) / 2#$ [' E; {! R" }5 d h
PL.Delete '删除多段线5 y7 |* y' L( ?5 Q% ]" b8 x
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半8 [6 z" Z; g; _8 f5 Z9 U
End If
3 a6 r3 W; O9 v1 C Next
/ h% D' u# t8 w SS.Delete '删除选择集' i. B. O2 p& Y6 b) p0 N! A, x4 Q
End With, M5 `5 {6 r% f6 K! I
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
