Schnittpunkt dreier Kugeln berechnen

[WL]

Hallo,

ich habe so etwas (Schnittpunkt zweier Kreise) mal hier https://www.roboternetz.de/community...sitionsscanner gebraucht:

Sub Schnitt_kreis(xm1 As Single , Ym1 As Single , R1 As Single , Xm2 As Single , Ym2 As Single , R2 As Single , Xs1 As Single , Ys1 As Single , Xs2 As Single , Ys2 As Single , M As Integer)
Dx = Xm2 - Xm1
Dy = Ym2 - Ym1
A2 = Dx * Dx : Temp = Dy * Dy : A2 = A2 + Temp
R12 = R1 * R1
R22 = R2 * R2
H = -4 * A2
If H = 0 Then
   M = 1
   Exit Sub
End If
Hi = R12 - R22 : Hi = Hi - A2
B2 = Hi * Hi : B2 = B2 / H : B2 = B2 + R22
If B2 < 0 Then
   M = 1
   Exit Sub
End If
B = Sqr(b2)
Temp = R12 - B2
Y = Sqr(temp)
A = Sqr(a2)
Xk = Dx / A
Yk = Dy / A
Xh = Xk * Y : Xh = Xh + Xm1
Yh = Yk * Y : Yh = Yh + Ym1
If B2 = 0 Then
   M = 0
   Xs1 = Xh : Ys1 = Yh
   Exit Sub
End If
Xl = Xk * B
Yl = Yk * B
Xs1 = Xh - Yl
Ys1 = Yh + Xl
Xs2 = Xh + Yl
Ys2 = Yh - Xl
M = -1
End Sub

Der Algorithmus ist von hier http://www.antonis.de/faq/progs/_inhalt.htm

[Podi]

Ich würde das ganze iterativ lösen, mit Vektorrechnung. die maximale Ausdehnung des Raumes ist a*b*c

Den maximal möglichen Raum in 27 Kugeln aufteilen, die Mittelpunkte jeweils an den Ecken (4), in der Mitte der Kanten (16), in der Mitte der Flächen (6) und einer in der Mitte des Körpers (1)
Die Koordinaten der Punkte können so sehr einfach errechnet werden, die benötigte Kugelgröße auch. Der Radius der Kugeln beträgt den R=GrößteKante*1,5/4. (Eigendlich R=3.Wurzel{Größtekante^2+Größtekante^2+Größtekante ^2}/4=Größstekante*1,44.../4

Nun wird nacheinander für jeden der Kugeln überprüft ob die drei "Messabstände" durch gehen:
A_x: Vektor von Nullpunkt zu Satelit x
P_y: Vektor des Kugelmittelpunktes
a_x: Messabstand zu Satelit x
R: (Abstand der Kugelmittelpunkte)*0,75=Größtekante*1,5/4

Den Betrag des Verbindungsvektor berechnen ap_x=|(A_x-P_y)| und prüfen ob ap_x>(a_x-R) und ap_x<(a_x+R) ist.
Falls diese Bedingung für einen der drei Sateliten nicht erfüllt ist kann man zum nächsten Punkt gehen.

Sobald ein Punkt alle Bedingungen der Sateliten erfüllt kann wird der Raum verkleinert, mit dem Kugelmittelpunkt in der Mitte.
Der neue Raum hat dann die Kantenlänge R*2 und bekommt wieder die 27 Punkte. Nun wird das ganze wiederholt.

Da der neue Raum größer ist als die bisherige Kugel ist es egal das sich die Kugeln überschneiden, es ist aber nur eine minimale Menge an Wurzelrechnungen nötig (beim Betrag des Verbindungsvektors).

Als Abbruchkriterium ist dann:
R<Gewünschte Genauigkeit: Letzter Kugelmittelpunkt ist die Position mit Genauigkeit R

1000%ig ist die Lösung auch nicht, es sollte aber funktionieren wenn die gewünschte Genauigkeit größer ist als die Messungenauigkeit^3 der Abstände. Denkfehler vorbehalten!
Im Prinzip kann man auch mehr Punkte nehmen, da steigt aber meiner meinung nach auch der Rechenaufwand stark an (viele nicht-Treffer)

Ansonsten wäre der noch der analytische Weg, die drei Messkugeln als Vektor definieren und durch ein Gleichungsystem die Schnittpunkte ermitteln (viel spaß ^^), was durchaus schief gehen kann.

Grüße
Podi

[dj_cyborg]

Hallo,

und vielen Dank für Eure Antworten.

Da ich nicht gerade das riesige Mathegenie bin habe ich es doch mit einer automtischen Suche gemacht.


Begrenzt durch maximale Suchdurchgänge und dem Abgleich der Abweichung der berechneten Radien von den Zielradien lassen sich auch ganz gut Falsche Eingangswerte erkennen. Die Zeit ist durch eine dynamische Schrittanpassung auch nicht so lang wie ich dachte.

Habe mein Excel Testprgramm und den Code mal angehangen.

Vielen Dank für Eure hilfe.

Option Explicit

Dim P(5)        As Double
Dim S1(5)       As Double
Dim S2(5)       As Double
Dim S3(5)       As Double

Sub GetGPSPos()

Dim iStepCount  As Integer
Dim iStepLimit  As Integer
Dim iStep       As Integer
Dim i           As Integer

Dim dError      As Double
Dim dTolerance  As Double

Dim Mybook      As Workbook
Dim MySheet     As Worksheet

Dim StartTime As Date
Dim EndTime As Date

'Zeitmessung
StartTime = Timer

'Excelwerte holen
Set Mybook = ActiveWorkbook
Set MySheet = Mybook.ActiveSheet

For i = 0 To 3
    S1(i) = MySheet.Cells(2, i + 2)
    S2(i) = MySheet.Cells(3, i + 2)
    S3(i) = MySheet.Cells(4, i + 2)
    P(i) = 0
Next


'Grenzen festlegen
dTolerance = 1      'benötigte Toleranz
iStepCount = 0      'Durchlaufzähler rücksetzen
iStepLimit = 1000   'Durchlaufgrenze festlegen

Do
'Durchlaeufe zählen
iStepCount = iStepCount + 1

'Gesamtabweichung berechnen
dError = GetError

'Schritt festlegen
iStep = Fix(dError / 3)
If iStep = 0 Then
    iStep = 1
End If


'X-Check
P(0) = P(0) + iStep
If GetError > dError Then
    P(0) = P(0) - (2 * iStep)
    If GetError > dError Then
        P(0) = P(0) + iStep
    End If
End If


'Y-Check
P(1) = P(1) + iStep
If GetError > dError Then
    P(1) = P(1) - (2 * iStep)
    If GetError > dError Then
        P(1) = P(1) + iStep
    End If
End If


'Z-Check
P(2) = P(2) + iStep
If GetError > dError Then
    P(2) = P(2) - (2 * iStep)
    If GetError > dError Then
        P(2) = P(2) + iStep
    End If
End If


'Ergebnis prüfen
If dError < dTolerance Or iStepCount >= iStepLimit Then

    'Zeitmessung ende
    EndTime = Timer


    'Werte Ausgeben
    MySheet.Cells(5, 2) = P(0)
    MySheet.Cells(5, 3) = P(1)
    MySheet.Cells(5, 4) = P(2)
    MySheet.Cells(5, 6) = dError
    MySheet.Cells(5, 7) = iStep
    MySheet.Cells(5, 8) = iStepCount
    MySheet.Cells(5, 9) = Format(EndTime - StartTime, "0.0")
    
    'Schleife beenden
    Exit Do

End If

Loop

End Sub

'Distanz berechnen
Function GetR(P1() As Double, P2() As Double) As Double

GetR = Sqr(((P1(0) - P2(0))) ^ 2 + ((P1(1) - P2(1))) ^ 2 + ((P1(2) - P2(2))) ^ 2)

End Function

Function GetError() As Double

'Distanz berechnen
S1(4) = GetR(S1, P)
S2(4) = GetR(S2, P)
S3(4) = GetR(S3, P)

'Abweichung berechnen
S1(5) = S1(4) - S1(3)
S2(5) = S2(4) - S2(3)
S3(5) = S3(4) - S3(3)

'Gesamtabweichung berechnen
GetError = Abs(S1(5)) + Abs(S2(5)) + Abs(S3(5))

End Function

US-GPS.zip