|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
5 ^4 T2 t4 B- a6 | o; H4 [" I
i0 Q3 i# k* t; m3 L" \, USub A()
5 P9 a3 f3 q8 v% B- f% dOn Error Resume Next
$ M" x. g! R+ \7 | Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant% f: }- ~, E4 D0 G
With ThisDrawing; D" v# K2 ~' D6 b9 r
Set SS = .SelectionSets.Add("SS") '新建选择集
" H& U& i9 t6 u( w Ft(0) = 0 '定义选择规则为多段线; K! \7 l: B# \4 g0 L2 Y" y
Fd(0) = "LWPolyLine"
2 p7 J7 x* C1 |5 ?( a SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
5 X4 X! U9 u/ K, x" u1 L For Each PL In SS '遍历选择集中多段线
" a/ E$ B* d$ i0 d P = PL.Coordinates '获取多段线顶点坐标数组9 `; w9 p0 `: T! }
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形: ~/ b! ~) ~3 g4 N& ]" v
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
, {; a' Q: }! @6 k# I7 `0 ? C(1) = (P(1) + P(5)) / 2#
3 Q ~+ H1 Y: \! C$ ^5 { PL.Delete '删除多段线
9 t" O: A8 ?. Q6 b% l$ n .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
9 S4 w! j5 Q$ X' q( w$ L End If5 f; Z: V# c% }* G6 |3 s' N5 o* r
Next M+ W; @8 `4 ]3 K/ q
SS.Delete '删除选择集; w ? C. ?+ R6 v3 `
End With) B( h5 R. \- t+ T- j+ E! R
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
