|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码! H2 Y: \# o* M- ?3 _, X3 W' R- g
: \: D1 S4 D r
Sub A(), d2 ^8 U! h' q
On Error Resume Next
4 H* d% L3 `- ]' ~5 ~ Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant+ Z. b0 _" o0 j6 z7 _) ~
With ThisDrawing f8 |7 j9 A- ~; H
Set SS = .SelectionSets.Add("SS") '新建选择集 ?/ Y! @& a& `; t# f
Ft(0) = 0 '定义选择规则为多段线5 c& ~7 y( Y5 n7 {, O
Fd(0) = "LWPolyLine"
" k6 ?; d0 Z L* k2 K% L6 C: n& n- X SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象: }/ |$ k7 ^# W& ~/ A
For Each PL In SS '遍历选择集中多段线
8 [0 h* D- B3 ? P = PL.Coordinates '获取多段线顶点坐标数组- ]0 a* L# J1 f3 f: V1 B
If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形
i, F7 T1 A' L9 O6 x+ i0 c0 f4 L b C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心# m& Y K2 J2 e# I
C(1) = (P(1) + P(5)) / 2#
: }6 J/ X: E( R# }; @1 E: m$ M" X PL.Delete '删除多段线' y8 ^: T2 q2 L$ ~) a) j/ `1 {
.ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
7 }: k/ o+ [! N End If. }; B* p5 y7 v; M Y
Next# S. }8 p8 d$ K8 @
SS.Delete '删除选择集7 a2 i9 f9 I& J
End With
. q4 I5 e* U( f* dEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
