kinglau 发表于 2006-3-14 09:47:00

写了段求长宽的程序,怎么没结果,请指点

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,不知道是哪里出错了

kinglau 发表于 2006-3-14 16:04:00

没人说几句么?

cdb 发表于 2006-3-14 16:25:00

xl = r - l
yl = t - b
中的xl、yl有问题,应为x1、y1
页: [1]
查看完整版本: 写了段求长宽的程序,怎么没结果,请指点