|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
% |7 C: `$ z" J' N% A k2 d5 V: d( W% }
Sub A()
- [, N) p. @& r3 zOn Error Resume Next+ O& ^' ~+ t4 m Z
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
J+ y3 R' y) Z" v' w With ThisDrawing
# v# C! ^# v7 X# h: }/ [) m Set SS = .SelectionSets.Add("SS") '新建选择集' g( J) F' J) b9 L w: U$ Z4 P/ S
Ft(0) = 0 '定义选择规则为多段线* }$ w6 P# v) j8 k, I5 t1 F6 J9 X3 j
Fd(0) = "LWPolyLine"
/ v' ~/ c: m- s7 ?6 F+ {* q& G7 O! S SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象, `8 V! {& @- ^2 N6 U2 Z
For Each PL In SS '遍历选择集中多段线 ?/ e4 E' M. p! h j x
P = PL.Coordinates '获取多段线顶点坐标数组! J5 K3 S" g4 `3 ?+ g
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
7 @. V/ G( h( D* Y/ ~ C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心5 x, X+ h* Z; C* Y- E* n0 |
C(1) = (P(1) + P(5)) / 2#. g* i$ |1 a9 U/ {' q0 W8 w; n
PL.Delete '删除多段线
& e* ~' E! A. u! a. N9 l& J .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
4 s) b) }0 q. j End If8 j9 t# ]# v/ r! I' D- j7 l/ _
Next* ]- }) B3 M8 O; W& ]# k1 a/ }/ R
SS.Delete '删除选择集
0 k e" z4 j: ^6 _4 c/ E) T- J End With- Q9 H6 P: }% J& u6 U% S# `* P
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
