|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码" F3 y2 u4 X4 m
0 [- a' S' L; {; |% j1 |! P1 {% gSub A()8 ?( e9 N" e$ s# B
On Error Resume Next
" a4 T, {! K5 B4 Z7 e5 @ Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant
- F y( Y. K5 M0 n) s- }3 Z With ThisDrawing
6 \; I/ T( \) ?# R- o, y Set SS = .SelectionSets.Add("SS") '新建选择集
* i; V5 ]: H( i1 v: o; [ Ft(0) = 0 '定义选择规则为多段线
4 n& [# I# w1 ^7 ?/ u3 H6 s$ t8 ^ Fd(0) = "LWPolyLine"
+ @, f6 L* G4 ]% w4 p SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象, t% M U. k1 H! }9 ?7 z
For Each PL In SS '遍历选择集中多段线
1 p/ m! V! H" Z2 l) X& o P = PL.Coordinates '获取多段线顶点坐标数组
# a+ }( n) j& a If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形9 y1 M/ z7 K9 C9 b
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心
% D1 P6 N" @2 G! M5 _ C(1) = (P(1) + P(5)) / 2#4 W9 G# S4 C, {6 ]& G1 b
PL.Delete '删除多段线
* I8 k4 \& r, s" u/ W9 a, G .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
6 V8 y4 U: l9 }9 z End If: G: ~* H9 u# P. c2 c) y# Z
Next& a) k, ]- o( C# A7 n
SS.Delete '删除选择集
0 M: ?& x$ ]8 Y+ l9 H) B: C End With
" O0 ]2 _: d6 IEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
