|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
VBA代码
' b, B5 r: K, o% q, N% a: g8 |* b
+ M7 \9 d% {. Q9 a1 k. _; fSub A()4 C) g6 S# L- G) O, O
On Error Resume Next
I* R( q4 v9 I( A Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant$ l( @5 o6 i" I8 s4 J" D- t$ c
With ThisDrawing
* U* ^) W N+ a$ T1 \' a+ z Set SS = .SelectionSets.Add("SS") '新建选择集
: q& U% T8 E4 G' @9 `# C Ft(0) = 0 '定义选择规则为多段线
5 A4 ?* j6 }9 X( D$ K: p2 y& r Fd(0) = "LWPolyLine"# F8 G4 |& ?7 L9 V
SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
0 m1 ^2 {% t* s& C m For Each PL In SS '遍历选择集中多段线# @& {3 M3 h9 t6 |$ ~+ E
P = PL.Coordinates '获取多段线顶点坐标数组6 J0 W# _2 C a) D& }+ \
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
F2 ^' o9 h/ F" d3 j0 ^ C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
; u( ~( S* K$ {* Z) w C(1) = (P(1) + P(5)) / 2#$ g; I- X' Y" ~ m* t: |+ f! R
PL.Delete '删除多段线 p! o' G, z- C
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半3 w" Z* C% l' d* \, h9 ~0 f+ R& z6 H% b
End If+ s7 ^/ M- J: s
Next
U3 u \+ o, [0 d" b/ [+ h SS.Delete '删除选择集+ \ k1 N* E) q* z
End With& p0 o' O- D# X+ u
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
