#define Real Single
'+------------------------------------------------------------------------------------------+
'|           AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”ö�üáߎę֚Üñ±¸©ø°|
Const Author="3D-GeradenSchnitt.Bas v017f ©2007 by ytwinky, MD"'                            |
'|                                                                                          |
'|   Zweck : Bestimmen des räumlichen Schnittpunktes zweier Geraden                         |
'+------------------------------------------------------------------------------------------+
Type Rec3D
  x As Real
  y As Real
  z As Real
End Type

Dim As Rec3D A, B, C, D, P
'Eindeutiger Schittpunkt
a.x=1
a.y=-1
a.z=-4
b.x=2
b.y=-4
b.z=7
c.x=-1
c.y=2
c.z=0
d.x=-2
d.y=3
d.z=4
'Geradenfehler 1
'a.x=5
'a.y=8
'a.z=7
'b.x=-3
'b.y=4
'b.z=4
'c.x=6
'c.y=-1
'c.z=13
'd.x=3
'd.y=-4
'd.z=-4
'Geradenfehler 2
'a.x=2
'a.y=-1
'a.z=0
'b.x=3
'b.y=-1
'b.z=1
'c.x=1
'c.y=0
'c.z=-1
'd.x=2
'd.y=-2
'd.z=3
Function GS3D(A As Rec3D, B As Rec3D, C As Rec3D, D As Rec3D) As Rec3D
  Dim As Real u, v, dx=a.x-c.x, dy=c.y-a.y, dz=c.z-a.z
  Dim As Real Det(1 To 3)={b.y*d.x-b.x*d.y, b.z*d.y-b.y*d.z, b.z*d.x-b.x*d.z}
  Dim P As Rec3D
  If Det(1) Then 'diese Berechnung sollte Okay sein, die Ergebnisse sind identisch(soweit möglich)
    u=(d.y*dx+d.x*dy)/Det(1)
    v=(b.y*dx+b.x*dy)/Det(1)
  ElseIf Det(2) Then
    u=(d.y*dz-d.z*dy)/Det(2)
    v=(b.y*dz-b.z*dy)/Det(2)
  ElseIf Det(3) Then
    u=(d.z*dx+d.x*dz)/Det(3)
    v=(b.z*dx+b.x*dz)/Det(3)
  End If
  If (Det(1) Or Det(2) Or Det(3)) And (dx*Det(2)+dy*Det(3)-dz*Det(1))=0 Then
    p.x=a.x+u*b.x
    p.y=a.y-u*b.y
    p.z=a.z-u*b.z
    Return P
  Else
    Print "Kein eindeutiger Schnitt.."
    Print "u=" &u
    Print "v=" &v
    Print "D=" &(dx*Det(2)+dy*Det(3)-dz*Det(1))
    Print "D1=" &Det(1)
    Print "D2=" &Det(2)
    Print "D3=" &Det(3)
    GetKey
    End
  End If
End Function

Print Author
P=GS3D(A, B, C, D)
Print "P.x=" &P.x
Print "P.y=" &P.y
Print "P.z=" &P.z
GetKey
End