|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码! s- b3 T( H# y
) a% \) |( h$ w' E, A) _3 ~* z- Y
Sub A()& c1 D: r1 t6 e8 L4 ]% R1 C
On Error Resume Next6 ~3 N9 q4 U: X2 m" a+ v2 [/ {- ?
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
( {2 r9 v4 z8 L% s6 A2 i9 d With ThisDrawing
/ q2 x" ^" ~0 ^( q2 M3 B4 z Set SS = .SelectionSets.Add("SS") '新建选择集# c/ Q. D" |. j# N% M1 W# E
Ft(0) = 0 '定义选择规则为多段线% K$ L( c3 ^5 m$ h5 M
Fd(0) = "LWPolyLine"
9 T8 c0 K+ m3 Q SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
' t5 k0 U) S* t1 a: W9 Y For Each PL In SS '遍历选择集中多段线% m; h7 ~' w% ^9 F( ^
P = PL.Coordinates '获取多段线顶点坐标数组
2 r6 u- ~; M. W/ q If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形! v" G4 {* H: w/ `" S. ^* e) h
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心) F! E2 p+ r" q
C(1) = (P(1) + P(5)) / 2#6 A; i& B7 m: f7 L) z+ b
PL.Delete '删除多段线: q5 i& A5 R$ ~! A D
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半& f" h+ p! B+ @$ A
End If+ H. O. Y& h: J# m
Next+ o+ _; U0 r- N y u0 @* q$ R6 a2 n
SS.Delete '删除选择集& L; d; Q6 d. h
End With9 _6 N0 d# o$ J: l
End Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
