Private Sub GeneriereV(ByVal x1 As Double, ByVal y1 As Double, _
                   ByVal x2 As Double, ByVal y2 As Double, _
                   ByVal winkel As Double, _
                   ByRef xv As Double, ByRef yv As Double)
 
'Schneller Vorschlag
'funktioniert wenn x1 > x2 und y1 > y2
'oder wenn x1 < x2 and y1 < y2 (also nur in 2 Quadranten)
 
Const eps As Double = 0.0001
Const PI As Double = 3.14159265358979
'Länge bestimmen
Dim l As Double: l = Abs(x1 - x2) ^ 2 + Abs(y1 - y2) ^ 2
If l < eps Then xv = x1: yv = y1: Exit Sub
l = Sqr(l)
 
Dim winkel1 As Double: winkel1 = Asin(Abs(y2 - y1) / l)
If x1 > x2 And y1 >= y2 Then winkel1 = winkel1 + PI
 
'Endpunkt der zweiten Linie berechnen
'Winkel (wie üblich) im Bogenmass
yv = y1 + l * Sin(winkel + winkel1)
xv = x1 + l * Cos(winkel + winkel1)
 
 
'gegebene Linie zeichnen
With Line1
   .x1 = x1: .y1 = y1: .x2 = x2: .y2 = y2
End With
 
'berechnete Linie zeichnen
With Line2
   .x1 = x1: .y1 = y1: .x2 = xv: .y2 = yv
End With
 
End Sub
 
 
Public Function Asin(ByVal x As Double) As Double
   If x >= 1 Then Asin = Atn(1): Exit Function
   If x <= -1 Then Asin = -Atn(1): Exit Function
   Asin = Atn(x / Sqr(-x * x + 1))
End Function