Anzeige
Archiv - Navigation
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schnittpunkt mit excel berechnen (2 Strecken)

Schnittpunkt mit excel berechnen (2 Strecken)
29.09.2006 23:25:38
Swen
Hallo an alle,
ich habe folgendes
In Zelle A3 Anfangspunkt (X-Wert) von Strecke 1
In Zelle B3 Anfangspunkt (Y-Wert) von Strecke 1
In Zelle A4 Endpunkt (X-Wert) von Strecke 1
In Zelle B4 Endpunkt (Y-Wert) von Strecke 1
In Zelle A5 Anfangspunkt (X-Wert) von Strecke 2
In Zelle B5 Anfangspunkt (Y-Wert) von Strecke 2
In Zelle A6 Endpunkt (X-Wert) von Strecke 2
In Zelle B6 Endpunkt (Y-Wert) von Strecke 2
Nun möchte ich gerne das geprüfft wird ob diese beiden
Strecken, es sind keine durchgängige Linien, sondern Strecken mit
Anfang und Ende sich schneiden!
Wenn die strecken sich schneiden soll die Variable blnSchneiden auf true gesetzt werden ansosnten auf false.
HAt jemand von euch eine Idee wie man dieses realisieren kann?
Gruß
Swen

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 10:29:54
Sigi
Hi Swen,
das hat wenig mit Excel zu tun, das ist Mathematik!
Im Prinzip so:
1. Für beide Strecken jeweils die Geradengleichungen (zwei Punkte beschreiben eine Gerade) aufstellen.
2. Schnittpunkt der Geraden suchen.
3. Prüfen, ob der Schnittpunkt auf der Strecke liegt.
Viel Erfolg!
Gruß
Sigi
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 11:44:46
Swen
Hallo Sigi,
hast du da ein beispiel wie dieses in vba aussehen könnte?
gruß
swen
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 13:09:06
Micha
Hallo Sven,
dies mal als Ansatz.....
p1x 3
p1y 17
p2x 18
p2y 21
r1x 6
r1y 25
r2x 20
r2y 7
a1 =p2y-p1y
a2 =r2y-r1y
b1 =p1x-p2x
b2 =r1x-r2x
c1 =a1*p1x+b1*p1y
c2 =a2*r1x+b2*r1y
sx = (c1*b2-c2*b1)/(a1*b2-a2*b1)
sy = (a1*c2-a2*c1)/(a1*b2-a2*b1)
sx 10,63803681
sy 19,03680982
if (sy > p1.y) and (s.y > p2.y) then False
if (sy > q1.y) and (s.y > q2.y) then False
if (sy if (sy if (sx > p1.x) and (s.x > p2.x) then False
if (sx > q1.x) and (s.x > q2.x) then False
if (sx if (sx viel Spaß
Micha
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 13:45:50
Swen
Hallo Micha,
danke für die hilfe ich werde mich mal dran setzen das zu
verstehen.
Zwei fragen habe ich aber noch zu deinem tip,
1.Was ist mit der zahl 10,63803681
hinter sx gemeint? Ist dieses das ergebnis?
2. Und dann noch die Frage sind in den bedingungen
mit IF alle möglichkeiten schon drin?
Vielen Dank!
Gruß
Swen
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 13:53:40
Micha
Hallo Swen,
Ja, das sind die Koordinaten des Schnittpunktes der beiden Strecken
für die X und Y werte die oben angenommen wurden.
Am einfachsten in einem Grafikprogramm überprüfen :-)
sx = 10,63803681 = WERT von X
sy = 19,03680982 = WERT von Y
Und nochmal Ja, das sind alle acht Möglichkeiten die eingehalten werden müssen, wenn der schnittpunkt auf den Strecken liegen soll.
Micha
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 19:30:16
Swen
Hallo an alle,
was mach ich den jetzt hier bei den
Bedingungen wann blnkreuz falsch.
For i = 3 To intZiel Step 2
Dim intP1x As Integer
intP1x = Worksheets("Layout3").Cells(i - 1, 4).Value
Dim intP1y As Integer
intP1y = Worksheets("Layout3").Cells(i - 1, 5).Value
Dim intP2x As Integer
intP2x = Worksheets("Layout3").Cells(i, 4).Value
Dim intP2y As Integer
intP2y = Worksheets("Layout3").Cells(i, 5).Value
Dim i2 As Integer
For i2 = 3 To intZiel Step 2
Dim intR1x As Integer
intR1x = Worksheets("Layout3").Cells(i2 - 1, 4).Value
Dim intR1y As Integer
intR1y = Worksheets("Layout3").Cells(i2 - 1, 5).Value
Dim intR2x As Integer
intR2x = Worksheets("Layout3").Cells(i2, 4).Value
Dim intR2y As Integer
intR2y = Worksheets("Layout3").Cells(i2, 5).Value
Dim intA1 As Integer
intA1 = intP2y - intP1y
Dim intA2 As Integer
intA2 = intR2y - intR1y
Dim intB1 As Integer
intB1 = intP1x - intP2x
Dim intB2 As Integer
intB2 = intR1x - intR2x
Dim intC1 As Integer
intC1 = intA1 * intP1x + intB1 * intP1y
Dim intC2 As Integer
intC2 = intA2 * intR1x + intB2 * intR1y
Dim intSx As Integer
intSx = (intC1 * intB2 - intC2 * intB1) / _
(intA1 * intB2 - intA2 * intB1)
Dim intSy As Integer
intSy = (intA1 * intC2 - intA2 * intC1) / _
(intA1 * intB2 - intA2 * intB1)
Dim blnKreuz As Boolean
If (sy > p1.y) And (s.y > p2.y) Then blnKreuz = False
ElseIf (sy > q1.y) And (s.y > q2.y) Then blnKreuz = False
ElseIf (sy ElseIf (sy ElseIf (sx > p1.x) And (s.x > p2.x) Then blnKreuz = False
ElseIf (sx > q1.x) And (s.x > q2.x) Then blnKreuz = False
ElseIf (sx ElseIf (sx Else: blnKreuz = True
End If
If blnKreuz = True Then
Worksheets("Layout3").Cells(i - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i, 7).Value = " * "
Worksheets("Layout3").Cells(i2 - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i2, 7).Value = " * "
blnKreuz = False
Exit For
End If
Next i2
Next i
gruß
swen
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 19:49:13
Micha
Hallo Swen,
Das ist natürlich Quatsch,
If (sy > p1.y) And (s.y > p2.y) Then blnKreuz = False
ElseIf (sy > q1.y) And (s.y > q2.y) Then blnKreuz = False
ElseIf (sy ElseIf (sy ElseIf (sx > p1.x) And (s.x > p2.x) Then blnKreuz = False
ElseIf (sx > q1.x) And (s.x > q2.x) Then blnKreuz = False
ElseIf (sx ElseIf (sx Du mußt schon deine Variablen verwenden
intSy intR2 etc
siehe mein code weiter unten im Forum
Micha
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 20:08:38
Swen
Hallo Micha, Hallo alle,
jetzt habe ich ein Problem mit den Variabeln
und zwar habe ich einen Überlauf...
wie kann ich diesen vermeiden ich habe folgende
datentypen schon versucht long double variant
For i = 3 To intZiel Step 2
Dim lngP1x As Long
lngP1x = Worksheets("Layout3").Cells(i - 1, 4).Value
Dim lngP1y As Long
lngP1y = Worksheets("Layout3").Cells(i - 1, 5).Value
Dim lngP2x As Long
lngP2x = Worksheets("Layout3").Cells(i, 4).Value
Dim lngP2y As Long
lngP2y = Worksheets("Layout3").Cells(i, 5).Value
Dim i2 As Integer
For i2 = 3 To intZiel Step 2
Dim lngR1x As Long
lngR1x = Worksheets("Layout3").Cells(i2 - 1, 4).Value
Dim lngR1y As Long
lngR1y = Worksheets("Layout3").Cells(i2 - 1, 5).Value
Dim lngR2x As Long
lngR2x = Worksheets("Layout3").Cells(i2, 4).Value
Dim lngR2y As Long
lngR2y = Worksheets("Layout3").Cells(i2, 5).Value
Dim lngA1 As Long
lngA1 = lngP2y - lngP1y
Dim lngA2 As Long
lngA2 = lngR2y - lngR1y
Dim lngB1 As Long
lngB1 = lngP1x - lngP2x
Dim lngB2 As Long
lngB2 = lngR1x - lngR2x
Dim lngC1 As Long
lngC1 = lngA1 * lngP1x + lngB1 * lngP1y
Dim lngC2 As Long
lngC2 = lngA2 * lngR1x + lngB2 * lngR1y
Dim lngSx As Long
lngSx = (lngC1 * lngB2 - lngC2 * lngB1) / _
(lngA1 * lngB2 - lngA2 * lngB1)
Dim lngSy As Long
lngSy = (lngA1 * lngC2 - lngA2 * lngC1) / _
(lngA1 * lngB2 - lngA2 * lngB1)
Dim blnKreuz As Boolean
If lngSy > lngP1y And lngSy > lngP2y Then
blnKreuz = False
ElseIf lngSy > lngR1y And lngSy > lngR2y Then
blnKreuz = False
ElseIf lngSy blnKreuz = False
ElseIf lngSy blnKreuz = False
ElseIf lngSx > lngP1x And lngSx > lngP2x Then
blnKreuz = False
ElseIf lngSx > lngR1x And lngSx > lngR2x Then
blnKreuz = False
ElseIf lngSx blnKreuz = False
ElseIf lngSx blnKreuz = False
Else:
blnKreuz = True
End If
If blnKreuz = True Then
Worksheets("Layout3").Cells(i - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i, 7).Value = " * "
Worksheets("Layout3").Cells(i2 - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i2, 7).Value = " * "
blnKreuz = False
Exit For
End If
Next i2
Next i
Gruß
Swen
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 21:56:53
Herby
Hallo swen,
die Angabe in der Zelladressen funktioniert m.E. so nicht Cells(i2-1,4).value. entweder nur so: Cells(i-1,4).value oder so: Cells(2*i-1,4).value. je nachdem was du willst.
Dim lngR1x As Long
lngR1x = Worksheets("Layout3").Cells(i2 - 1, 4).Value
Dim lngR1y As Long
lngR1y = Worksheets("Layout3").Cells(i2 - 1, 5).Value
Dim lngR2x As Long
lngR2x = Worksheets("Layout3").Cells(i2, 4).Value
Dim lngR2y As Long
lngR2y = Worksheets("Layout3").Cells(i2, 5).Value
Viele Grüße
Herby
AW: Schnittpunkt mit excel berechnen (2 Strecken)
30.09.2006 22:27:01
Swen
Hallo an alle,
so funtzt es, vielen dank an alle,
die mir geholfen haben.
Eine Frage habe ich noch, wie bekomme ich es hin das
ich wenn die Anfang- und Endpunkte der Daten sich kreuzen
blnkreuz als false gilt?
'***************************************************************************
'*** Es wird geschaut ob sich Nadel kreuzen und wenn dieses so ist dann
'*** wird diese markiert in der Spalte 7 mit einem " * "
'***************************************************************************
Dim intZiel As Integer
For intZiel = 1 To 10000
If Worksheets("Layout3").Cells(intZiel, 6).Value = " * " Then
Exit For
End If
Next intZiel
For i = 3 To intZiel Step 2
Dim dblP1x As Double
dblP1x = Worksheets("Layout3").Cells(i - 1, 4).Value
Dim dblP1y As Double
dblP1y = Worksheets("Layout3").Cells(i - 1, 5).Value
Dim dblP2x As Double
dblP2x = Worksheets("Layout3").Cells(i, 4).Value
Dim dblP2y As Double
dblP2y = Worksheets("Layout3").Cells(i, 5).Value
Dim i2 As Integer
For i2 = 3 To intZiel Step 2
If i2 i Then
Dim dblR1x As Double
dblR1x = Worksheets("Layout3").Cells(i2 - 1, 4).Value
Dim dblR1y As Double
dblR1y = Worksheets("Layout3").Cells(i2 - 1, 5).Value
Dim dblR2x As Double
dblR2x = Worksheets("Layout3").Cells(i2, 4).Value
Dim dblR2y As Double
dblR2y = Worksheets("Layout3").Cells(i2, 5).Value
Dim dblA1 As Double
dblA1 = dblP2y - dblP1y
Dim dblA2 As Double
dblA2 = dblR2y - dblR1y
Dim dblB1 As Double
dblB1 = dblP1x - dblP2x
Dim dblB2 As Double
dblB2 = dblR1x - dblR2x
Dim dblC1 As Double
dblC1 = dblA1 * dblP1x + dblB1 * dblP1y
Dim dblC2 As Double
dblC2 = dblA2 * dblR1x + dblB2 * dblR1y
Dim dblSx As Double
dblSx = (dblC1 * dblB2 - dblC2 * dblB1) / _
(dblA1 * dblB2 - dblA2 * dblB1)
Dim dblSy As Double
dblSy = (dblA1 * dblC2 - dblA2 * dblC1) / _
(dblA1 * dblB2 - dblA2 * dblB1)
Dim blnKreuz As Boolean
If dblSy > dblP1y And dblSy > dblP2y Then
blnKreuz = False
ElseIf dblSy > dblR1y And dblSy > dblR2y Then
blnKreuz = False
ElseIf dblSy blnKreuz = False
ElseIf dblSy blnKreuz = False
ElseIf dblSx > dblP1x And dblSx > dblP2x Then
blnKreuz = False
ElseIf dblSx > dblR1x And dblSx > dblR2x Then
blnKreuz = False
ElseIf dblSx blnKreuz = False
ElseIf dblSx blnKreuz = False
Else:
blnKreuz = True
End If
If blnKreuz = True Then
Worksheets("Layout3").Cells(i - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i, 7).Value = " * "
Worksheets("Layout3").Cells(i2 - 1, 7).Value = " * "
Worksheets("Layout3").Cells(i2, 7).Value = " * "
blnKreuz = False
Exit For
End If
End If
Next i2
Next i
Anzeige
AW: Schnittpunkt mit excel berechnen (2 Strecken)
01.10.2006 10:22:05
Micha
Hallo Swen
guten Morgen :-)
So kannst Du natürlich auch abfragen ob die endpunkte auf dem Schnittpunkt liegen
if (dblSx = dblR1x And dblSy = dblR1y) Or (dblSx = dblR2x And dblSy = dblR2y) Or ......
Micha
Schnittpunkt von Geraden als Diagramm
30.09.2006 14:44:03
Geraden
Hallo Swen,
ich hab mal den Schnittpunkt von Geraden ermittelt und diesen als Grafik dargestellt, damit brauchst du nur noch abzuprüfen, ob der Schnittpunkt auf einer der Strecken liegt (vgl. Tip von Micha)
https://www.herber.de/bbs/user/37097.xls
Viele Grüße
Herby
AW: Schnittpunkt von Geraden als Diagramm
30.09.2006 18:57:26
Geraden
Hallo Herby,
danke für diese Information das hilft mir
die Mathematik dahinter zu verstehen.
Ich versuche eine Lösung in VBA zu erstellen,
mal sehen wie weit ich komme.
Wenn du einen Lösungsvorschlag in VBA hast laß
es mich doch bitte wissen.
gruß
swen
Anzeige
Schnittpunkt von 2 Geraden per Makro berechnen
30.09.2006 19:26:50
2
Hallo Swen,
ich hab den Tip von Micha mal als Makro umgesetzt, allerdings ohne Überprüfung ob der Schnittpunkt zwischen den Endpunkten der Strecken liegen.
https://www.herber.de/bbs/user/37107.xls
Probiers mal aus.
Viele Grüße
Herby
AW: Schnittpunkt von Geraden als Diagramm
30.09.2006 19:29:59
Geraden
Hallo,
da will ich mich doch auch noch mal melden.....

Function geschnitten() As Boolean
Dim p1x, p1y, p2x, p2y, q1x, q1y, q2x, q2y
Dim za1, za2, zb1, zb2, zc1, zc2
Dim sx, sy
p1x = Range("i4") 'die Zellbezüge bitte anpassen
p1y = Range("j4")
p2x = Range("i5")
p2y = Range("j5") ' erste Gerade
q1x = Range("m4")
q1y = Range("n4")
q2x = Range("m5")
q2y = Range("n5") ' zweite Gerade
'zwischenrechnungen
za1 = p2y - p1y
za2 = q2y - q1y
zb1 = p1x - p2x
zb2 = q1x - q2x
zc1 = za1 * p1x + zb1 * p1y
zc2 = za2 * q1x + zb2 * q1y
sx = (zc1 * zb2 - zc2 * zb1) / (za1 * zb2 - za2 * zb1)
sy = (za1 * zc2 - za2 * zc1) / (za1 * zb2 - za2 * zb1)
geschnitten = True
If sy > p1y And sy > p2y Then geschnitten = False
If sy > q1y And sy > q2y Then geschnitten = False
If sy < p1y And sy < p2y Then geschnitten = False
If sy < q1y And sy < q2y Then geschnitten = False
If sx > p1x And sx > p2x Then geschnitten = False
If sx > q1x And sx > q2x Then geschnitten = False
If sx < p1x And sx < p2x Then geschnitten = False
If sx < q1x And sx < q2x Then geschnitten = False
'MsgBox geschnitten
End Function

viel Erfolg
Micha
Anzeige
AW: Schnittpunkt von Geraden als Diagramm
30.09.2006 21:51:09
Geraden
Hallo Micha,
hab deine funktion mal kopiert und verschiedene Werte eingegeben. Funktioniert super !
Kleine einschränkung:
Bei parallelen Strecken gibts noch ne kleine Definitionslücke. Der Rückgabewert der Funktion ist da #WERT. Kleiner Tip: Damit die Funktion im Tabellenblatt bei jeder Zelländerung reagiert habe ich den Befehl Application.Volatile zu Beginn der Funktion noch eingefügt.
Danke, jetzt habe ich das Ganze als Excelformel, als Excelprocedure und nun noch als Funktion. Es kann nichts mehr schief gehen :)
Viele Grüße
Herby

112 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige