|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码; S8 P0 r, X6 U' H: X& F# j6 r# K
9 X% i4 `& Q' V R7 Y9 s
Sub A()
& t3 n0 @' h0 F( {& l* A5 }On Error Resume Next: {9 `. j9 m. {7 ?9 \2 a- E" l
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
; Q1 x% V. R) O* p" V With ThisDrawing
% {7 x+ H* ^2 V& y0 U; ~ Set SS = .SelectionSets.Add("SS") '新建选择集0 z4 Y- F! J! {) F' D: ~; e# q
Ft(0) = 0 '定义选择规则为多段线* C- d5 k2 Z8 w+ ~& K- m
Fd(0) = "LWPolyLine" s( p; ]$ V3 G. B" }$ s$ R
SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
% |7 ~' c2 f7 J3 l* m" L For Each PL In SS '遍历选择集中多段线
# j$ V8 d. |7 I) x) g& }" L P = PL.Coordinates '获取多段线顶点坐标数组& }( N8 y/ l" P0 E( Z$ y9 n
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
2 E3 V: b# ~6 Z" V C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
\; A$ }+ C3 Q& P C(1) = (P(1) + P(5)) / 2#
4 A* B7 F! G! T5 [( |# t9 G8 `5 X PL.Delete '删除多段线
# D2 O* h6 ~. v' \ .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半6 u& J1 a1 r6 a
End If
" P/ K9 `, H3 y& { Next" R: p% } G4 j H( y" _
SS.Delete '删除选择集% y3 t" F- g& x4 G
End With
) N4 ~ d3 [% y6 u1 MEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
