|
|
发表于 2008-6-9 13:41:27
|
显示全部楼层
来自： 中国辽宁营口
VBA代码! ~- x0 v: ]' `
" z7 j4 {* O% Y" J
Sub A()
' f$ Q% W0 r! r8 d$ w6 x' q: TOn Error Resume Next5 M$ q$ ~4 U0 W) l
Dim SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, PL As AcadLWPolyline, C(2) As Double, P As Variant- l, \% L) ` c% X0 e6 s0 C
With ThisDrawing
/ p6 @( q3 p* t8 o# i Set SS = .SelectionSets.Add("SS") '新建选择集, i% ^+ v2 e$ c# ^! f, o
Ft(0) = 0 '定义选择规则为多段线9 F" k g9 M$ f0 o# o1 w
Fd(0) = "LWPolyLine"
! D$ x( t3 k$ Q7 M/ J) x4 n O4 N SS.SelectOnScreen Ft, Fd '从屏幕上选取多段线对象
# U) U- `5 \$ K+ D4 q& V* T6 m* k For Each PL In SS '遍历选择集中多段线
! [2 n W+ ?/ c' _, w" ~ P = PL.Coordinates '获取多段线顶点坐标数组
$ F: n. I0 M1 O/ I+ E& A, M If UBound(P) = 7 And PL.Closed Then '图省事，只检查多段线是否为四个顶点及是否闭合，没严格检查是否矩形) ^. w( X% Q: K( K K8 t2 s& z
C(0) = (P(0) + P(4)) / 2# '取第1、第3顶点的中点为圆心- D& Y2 c& m% k
C(1) = (P(1) + P(5)) / 2#% v+ A6 L9 O% R6 g4 ?; r* A
PL.Delete '删除多段线
$ f, F0 C# K2 C, V .ModelSpace.AddCircle C, Sqr((P(0) - P(4)) ^ 2 + (P(1) - P(5)) ^ 2) / 2# '画圆，半径为第1、第3顶点连线长度的一半
/ {5 P# u3 @- r End If+ ^; }$ Y$ N7 O- n- z. L" X9 E
Next
- V3 q; x4 X# O! Z' p SS.Delete '删除选择集4 { ~3 G2 _# f; q; `0 y; n
End With
% i$ X6 L8 A* d* d- BEnd Sub |
评分
-
查看全部评分
|
发表于 2008-3-18 15:32:33
楼主
