|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码4 T$ L: t5 q/ p0 E. B) ?5 C% Y8 J
: d8 `, a' u7 C9 Z, LSub A()7 A/ h2 v; _! f$ v( e s N
On Error Resume Next
9 ~$ d; ~& U4 }8 A6 d Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
0 W4 v- I# i3 a2 X6 M5 ^/ w With ThisDrawing
! n; J5 k! j4 D( g) ^! k) ]2 H Set SS = .SelectionSets.Add("SS") '新建选择集
7 z* O! \5 j" T5 _" V( r Ft(0) = 0 '定义选择规则为多段线9 P1 j+ p0 p: T7 m$ O9 N
Fd(0) = "LWPolyLine"
# D+ x; _- I/ w' M ]& Q# Z) N SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象5 E. H+ ~2 B" d5 |# E4 v: S
For Each PL In SS '遍历选择集中多段线
& q$ a- p& L& K, V4 y, @ P = PL.Coordinates '获取多段线顶点坐标数组$ K$ L' r! C4 `) X
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
* v8 L, ^( j8 b! K C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
0 P) b; I9 a0 Y& f ^5 a$ ^$ L C(1) = (P(1) + P(5)) / 2#) @& K' K4 m$ ~3 q8 g( [. u8 A
PL.Delete '删除多段线+ a: U0 ?) u3 q# j/ u
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
$ Y9 l' r' n# P @3 X End If
+ Q7 g( x% Q; _/ B) E j: B Next
. s1 h: t! g2 z" o; E/ W5 y( [ SS.Delete '删除选择集0 V8 g8 A" l; T) M
End With
7 w& C' u4 |: @. T& u7 @. {9 R! hEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
