|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
3 x& Z% h/ F( _8 [+ B
* q% `/ O$ O) t6 p K. Z0 USub A()) ^3 G) T1 |8 W7 X l
On Error Resume Next$ w' K4 |0 C2 W+ e- u/ s6 M
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
3 K$ i8 p# m* P5 i With ThisDrawing3 n. g, @& Q7 [! t
Set SS = .SelectionSets.Add("SS") '新建选择集
3 e3 g% a9 x2 V+ R Ft(0) = 0 '定义选择规则为多段线$ V ~6 ?0 D) o% o) ~$ k {
Fd(0) = "LWPolyLine"2 N' R; G9 T; p# x. p5 |4 l! k2 y
SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象- v9 c; o" ?, r+ W% c; ?1 _
For Each PL In SS '遍历选择集中多段线! d$ g. `- u w% G
P = PL.Coordinates '获取多段线顶点坐标数组% A" n& y# R; E1 O
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形! P z/ u' R/ f( t! c7 B
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
7 q, ?- Y9 a+ V# t C(1) = (P(1) + P(5)) / 2# `4 b" M3 n' D3 ^& {& \1 T
PL.Delete '删除多段线& k( ]" R: U2 o* c0 J
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
0 R4 H! e0 |8 Q End If
; a, u; a- [0 q) v; F1 e Next
9 @( _$ f3 l. i% E) W3 G' F SS.Delete '删除选择集! @* }& S. i4 P/ b
End With3 C3 R# y1 c* R6 \# l/ o0 n
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
