|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码
& m9 k* K* B. f1 d. O# H- C6 z
! G3 q8 b: n$ G: a' \0 ~; M/ \Sub A()
) ]3 s% s: F2 z+ {' WOn Error Resume Next: [; P8 e2 d P. f& D4 q' Q
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
$ Y8 [ x; M Z9 G1 i1 u. } With ThisDrawing$ s9 `$ N! t" G$ H# C, x
Set SS = .SelectionSets.Add("SS") '新建选择集
D4 B, G( s: |% _ D Ft(0) = 0 '定义选择规则为多段线
$ g3 F% O% J( K; v Fd(0) = "LWPolyLine"
3 ^6 G1 r& ^: X* @5 p2 F5 U7 h) H" T) T SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
; q0 o3 Q. v3 V For Each PL In SS '遍历选择集中多段线) Y6 m8 T0 p9 M; q
P = PL.Coordinates '获取多段线顶点坐标数组/ [: v& z% D" A9 j
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形3 q( W! z7 M$ L" @" p
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心! {! m/ d' r1 v; i8 v' |
C(1) = (P(1) + P(5)) / 2#1 R2 z) u! R6 H' [# B7 q! T- z4 D
PL.Delete '删除多段线
7 m1 E' d; t! f8 C! S .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
" R0 N7 @/ q1 h End If: |& }; t" P1 \0 V H
Next2 ~& J7 e* }4 J- v6 ^( c
SS.Delete '删除选择集
/ x: u+ j' J" \' Y& Y End With
9 J! P, W, Y; S6 tEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
