module1.vb

苏金明编写的《用VB.NET和VC#.NET开发交互式CAD系统》一书的源代码

Imports System.Math

Module Module1

    Public Function LineLine(ByVal line1 As CLine, ByVal line2 As CLine) As Single()
        Dim reValue(4) As Single
        Dim xx1, yy1, xx2, yy2 As Single
        Dim x1, y1, x2, y2 As Single
        Dim n1, n2, n3, n4 As Single

        With line1
            If .LBegin.X > .LEnd.X Then
                xx2 = .LBegin.X
                yy2 = .LBegin.Y
                xx1 = .LEnd.X
                yy1 = .LEnd.Y
            Else
                xx1 = .LBegin.X
                yy1 = .LBegin.Y
                xx2 = .LEnd.X
                yy2 = .LEnd.Y
            End If
        End With

        With line2
            If .LBegin.X > .LEnd.X Then
                x2 = .LBegin.X
                y2 = .LBegin.Y
                x1 = .LEnd.X
                y1 = .LEnd.Y
            Else
                x1 = .LBegin.X
                y1 = .LBegin.Y
                x2 = .LEnd.X
                y2 = .LEnd.Y
            End If
        End With

        Dim kc1 As Single() = LineKX(New PointF(xx1, yy1), New PointF(xx2, yy2))
        Dim kc2 As Single() = LineKX(New PointF(x1, y1), New PointF(x2, y2))

        '如果两条直线段的斜率相同
        If kc1(0) = kc2(0) Then
            If x1 > xx2 Or x2 < xx1 Then
                reValue(0) = 0
            Else
                n1 = y1 + (-x1) * kc1(0)
                n1 = yy1 + (-xx1) * kc2(0)
                If n1 <> n2 Then
                    reValue(0) = 0
                Else
                    n3 = Max(xx1, x1)
                    n4 = Min(xx2, x2)
                    reValue(1) = n3
                    reValue(2) = y1 + (n3 - x1) * kc1(0)
                    If (n3 = n4) Then
                        reValue(0) = 1
                    End If
                    reValue(3) = n4
                    reValue(4) = y1 + (n4 - x1) * kc1(0)
                    reValue(0) = 2
                End If
            End If
        Else
            reValue(1) = (kc1(1) - kc2(1)) / (kc2(0) - kc1(0))
            reValue(2) = kc1(1) + reValue(1) * kc1(0)
            '如果交点横坐标在两条直线段的横坐标范围内
            If reValue(1) >= x1 And reValue(1) <= x2 And reValue(1) >= xx1 And reValue(1) <= xx2 Then
                reValue(0) = 1
            Else
                reValue(0) = 0
            End If
        End If

        Return reValue
    End Function

    '计算直线段的截距式方程
    Public Function LineKX(ByVal pB As PointF, ByVal pE As PointF) As Single()
        Dim kc(1) As Single
        '若直线段不为竖直线段
        If pB.X <> pE.X Then
            'Console.WriteLine(Str(pB.X) & Str(pB.Y))
            kc(0) = (pE.Y - pB.Y) / (pE.X - pB.X)
            '如果是竖直线段
        Else
            kc(0) = 10000
        End If
        '计算截距
        kc(1) = pB.Y - kc(0) * pB.X
        Return kc
    End Function
End Module