.NET编程求出四个端点组成的两条直线的相交点

tcsl9621

 '''求出两直线的交点
    Public Function inters(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d, Optional ByVal type As Boolean = True) As Point3d
        If Math.IEEERemainder(Math.Abs(getangle(p1, p2) - getangle(p3, p4)), Math.PI) = 0 Then
            Return Nothing
        End If
        Dim a1, a2, b1, b2, c1, c2, c3, x1, x2, y1, y2, x, y, z As Double
        Dim lp As Point3d
        x1 = p1.X
        y1 = p1.Y
        x2 = p3.X
        y2 = p3.Y
        a1 = p2.Y - p1.Y
        b1 = p2.X - p1.X
        a2 = p4.Y - p3.Y
        b2 = p4.X - p3.X
        c1 = a1 / b1
        c2 = a2 / b2
        c3 = (p2.Z - p1.Z) / b1
        x = (y2 - c2 * x2 + c1 * x1 - y1) / (c1 - c2)
        If b1 = 0 Then
            x = p1.X
            c1 = 1.0E+20
            c3 = c1
        End If
        If b2 = 0 Then
            x = p3.X
            c2 = 1.0E+20
        End If
        y = c1 * (x - x1) + y1
        z = c3 * (x - x1) - p1.Z
        If x - x1 = 0 Then
            y = c2 * (x - x2) + y2
        End If
        lp = New Point3d(x, y, z)
        Dim d1, d2, d3, d4, od1, od2, od3, od4 As Double
        d1 = p1.DistanceTo(p2)
        d3 = p3.DistanceTo(p4)
        od1 = lp.DistanceTo(p1)
        od2 = lp.DistanceTo(p2)
        od3 = lp.DistanceTo(p3)
        od4 = lp.DistanceTo(p4)
        If type Then
            Return lp
        ElseIf od1 <= d1 And od2 <= d1 And od3 <= d3 And od4 <= d3 Then
            Return lp
        Else
            Return Nothing
        End If
    End Function

望各位多指点。我没发现只好自已编了一个，但我怕出毛病。

tcsl9621

    '''求出两直线的交点
    Public Function inters(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d, Optional ByVal type As Boolean = True) As Point3d
        If Math.IEEERemainder(Math.Abs(getangle(p1, p2) - getangle(p3, p4)), Math.PI) = 0 Then
            Return Nothing
        End If
        Dim a1, a2, b1, b2, c1, c2, c3, x1, x2, y1, y2, x, y, z As Double
        Dim lp As Point3d
        x1 = p1.X
        y1 = p1.Y
        x2 = p3.X
        y2 = p3.Y
        a1 = p2.Y - p1.Y
        b1 = p2.X - p1.X
        a2 = p4.Y - p3.Y
        b2 = p4.X - p3.X
        c1 = a1 / b1
        c2 = a2 / b2
        c3 = (p2.Z - p1.Z) / b1
        x = (y2 - c2 * x2 + c1 * x1 - y1) / (c1 - c2)
        If b1 = 0 Then
            x = p1.X
            c1 = 1.0E+20
            c3 = c1
        End If
        If b2 = 0 Then
            x = p3.X
            c2 = 1.0E+20
        End If
        y = c1 * (x - x1) + y1
        z = c3 * (x - x1) - p1.Z
        If x - x1 = 0 Then
            y = c2 * (x - x2) + y2
        End If
        lp = New Point3d(x, y, z)
        Dim d1, d2, d3, d4, od1, od2, od3, od4 As Double
        d1 = p1.DistanceTo(p2)
        d3 = p3.DistanceTo(p4)
        od1 = lp.DistanceTo(p1)
        od2 = lp.DistanceTo(p2)
        od3 = lp.DistanceTo(p3)
        od4 = lp.DistanceTo(p4)
        If type Then
            Return lp
        ElseIf od1 <= d1 And od2 <= d1 And od3 <= d3 And od4 <= d3 Then
            Return lp
        Else
            Return Nothing
        End If
    End Function

 

自己编的，请大家评评。

tcsl9621

望大侠指点。我对自己编的这个东东不放心。呵……如果程序有就太好了。

Real_King

单一直线还不错，但是遇到复杂的多段线呢？