|
|
Sub 长宽()
Dim startPnts As Variant, endPnts As Variant
Dim s1 As Variant, e1 As Variant
Dim l As Double, r As Double '左右坐标
Dim t As Double, b As Double '上下坐标
Dim x1 As Double, y1 As Double
Dim lineCount As Integer
lineCount = ThisDrawing.ModelSpace.Count
ReDim lineObj(0 To lineCount - 1) As AcadEntity
Set lineObj(0) = ThisDrawing.ModelSpace.Item(0)
startPnts = lineObj(0).StartPoint
endPnts = lineObj(0).EndPoint
r = Max1(startPnts(0), endPnts(0))
t = Max1(startPnts(1), endPnts(1))
l = Min1(startPnts(0), endPnts(0))
b = Min1(startPnts(1), endPnts(1))
For i = 0 To lineCount - 1
Set lineObj(i) = ThisDrawing.ModelSpace.Item(i)
s1 = lineObj(i).StartPoint
e1 = lineObj(i).EndPoint
r = Max(s1(0), e1(0), r) '求极值点
t = Max(s1(1), e1(1), t)
l = Min(s1(0), e1(0), l)
b = Min(s1(1), e1(1), b)
Next
xl = r - l
yl = t - b
MsgBox x1
MsgBox y1
End Sub
'以下为定义的求极值的函数
Public Function Min1(x As Variant, y As Variant)
If x
Public Function Min(x As Variant, y As Variant, z As Variant)
If x > y Then
x = y
If x > z Then
x = z
End If
Else
If x > z Then
x = z
End If
End If
Min = x
End Function
Public Function Max1(x As Variant, y As Variant)
If x > y Then
Max1 = x
Else
Max1 = y
End If
End Function
Public Function Max(x As Variant, y As Variant, z As Variant)
If x
运行结果为0,不知道是哪里出错了
|
|
置顶卡
