AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Schnittpunkt zweier Strecken ermitteln
Thema durchsuchen
Ansicht
Themen-Optionen

Schnittpunkt zweier Strecken ermitteln

Ein Thema von Namenloser · begonnen am 4. Okt 2007 · letzter Beitrag vom 18. Mär 2008
 
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#1

Schnittpunkt zweier Strecken ermitteln

  Alt 4. Okt 2007, 17:13
Hallo Community,

nachdem ich schon länger nach einer Funktion, die den Schnittpunkt von zwei Strecken errechnet, gesucht habe, bin ich heute bei Google fündig geworden und habe einen ActionScript-Code dafür gefunden. Diesen habe ich dann noch schnell in Delphi überetzt, et voilà: Es funktioniert tatsächlich

Die Funktion IntersectLines ist einmal überladen. Die erste Funktion erwartet Fließkommazahlen als Parameter, die zwiete arbeitet mit Points, wobei p1 und p2 die Endpuntke der ersten, und p2 und p3 die Endpunkte der zweiten Strecke markieren. Die Funktion gibt False zurück, wenn sich die Strecken nicht schneiden, andernfalls steht in output der Schnittpunkt.

Es gibt allerdings eine Division durch 0, wenn die Strecken exakt aufeinander liegen, man sollte diesen Fall also vorher im Programm abfangen.

Delphi-Quellcode:
type
  tvec2d = class
    x,
    y: extended;
    constructor create (ax,ay: extended);
    function plus(v: tvec2d): tvec2d;
    function minus(v: tvec2d): tvec2d;
    procedure multiply(f: extended);
  end;
  constructor tvec2d.create(ax, ay: extended);
  begin
    x := ax;
    y := ay;
  end;
  function tvec2d.minus(v: tvec2d): tvec2d;
  begin
    result := tvec2d.create(x-v.x,y-v.y);
  end;
  procedure tvec2d.multiply(f: extended);
  begin
    x := x*f;
    y := y*f;
  end;
  function tvec2d.plus(v: tvec2d): tvec2d;
  begin
    result := tvec2d.create(x+v.x,y+v.y);
  end;
function intersectlines(x1,y1,x2,y2,x3,y3,x4,y4: extended;
  var output: tpoint): boolean; overload;
var
  v0,v,v1: tvec2d; // strecke 1 [p1,p2,richtung]
  u0,u,u1: tvec2d; // strecke 2 [p1,p2,richtung]
  fdiv,
  t,s: extended;
  p: tvec2d;
begin
  result := false;
  // Strecke 1
  v0 := tvec2d.create(x1,y1);
  v := tvec2d.create(x2,y2);
  v1 := v.minus(v0);
  // Strecke 2
  u0 := tvec2d.create(x3,y3);
  u := tvec2d.create(x4,y4);
  u1 := u.minus(u0);

  fdiv := v1.x * u1.y - v1.y * u1.x;
  t := -(v0.x * u1.y - v0.y * u1.x - u0.x * u1.y + u0.y * u1.x) / fdiv;
  s := -(v0.x * v1.y - v0.y * v1.x + v1.x * u0.y - v1.y * u0.x) / fdiv;

  v1.multiply(t);
  // Punkt wo sie sich schneiden:
  p := v0.plus(v1);
  if ((t>0) AND (s>0)) AND ((t<1) AND (s<1)) then
  begin
    output := point(round(p.x),round(p.y));
    result := true;
  end;

  freeandnil(v0);
  freeandnil(v);
  freeandnil(v1);
  freeandnil(u0);
  freeandnil(u);
  freeandnil(u1);
  freeandnil(p);
end;

function intersectlines(p1,p2,p3,p4: TPoint;
  var output: tpoint): boolean; overload;
begin
  result := intersectlines(p1.x,p1.y,p2.X,p2.y,p3.X,p3.Y,p4.x,p4.y,output);
end;
Ich hoffe, das finden auch noch andere nützlich
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz