Einzelnen Beitrag anzeigen

Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#12

AW: Punkte in ein Polygon überführen

  Alt 12. Mai 2016, 09:58
Jens, du hast völlig recht. Das geht mit dem Delauny auch für meine Zwecke.

Delphi-Quellcode:
procedure TPBDelaunyTriangulation.PolygonsMesh(Value: TAreas; const dX, dY: double); // PB = Paul Bourke;
var
  Line, Horz, Vert: TFloatLine;
  I, J, Row, Col: integer;
  P: TFloatPoint;
  MaxX, MinX, MaxY, MinY: double;
  AxisHorz, AxisVert: TFloats;
  Nodes: TFloatPoints;
begin
  // TAreas = Liste von Polygonen; Polygon[Index].Count = 1 .. N;
  // - Polygon[Index].Count = 1; -> Punkt;
  // - Polygon[Index].Count = 2; -> Linie;
  // - Polygon[Index].Count > 2 and Counterclockwise; -> pos. Fläche;
  // - Polygon[Index].Count > 2 and not Counterclockwise; -> neg. Fläche;
  AxisHorz := TFloats.Create;
  AxisVert := TFloats.Create;
  Nodes := TFloatPoints.Create;
  try
    // I von III: Nodes ermitteln;
    for I := 0 to Value.Count - 1 do // Alle Flächen, Punkte und Linien;
      for J := 0 to Value[I].Count - 1 do
      begin
        AxisHorz.Add(Value[I].Items[J].Y);
        AxisVert.Add(Value[I].Items[J].X);
      end;
    AxisHorz.RemoveSameValues; // Sortieren und Doppel rauslöschen;
    AxisVert.RemoveSameValues;
    AxisHorz.Refine(dX); // ggf. Zwischenwerte einfügen, so daß der Abstand..
    AxisVert.Refine(dY); // ..zwischen 2 Achsen <= dX bzw. dY wird;
    MinX := Value.MinX; // Unten/Links;
    MinY := Value.MinY;
    MaxX := Value.MaxX; // Oben/Rechts;
    MaxY := Value.MaxY;
    // Schnittpunkte ermitten;
    // *** Kriterium für TAreas.PtIn:
    // - Wenn in einer pos. Fläche und nicht in einer neg. Fläche;
    // - Polygonlinien können sich berühren:
    // - Value.PtIn führt für pos. Flächen Inflate(+1mm) und für neg. Flächen Inflate(-1mm) durch;
    // - Value.PtIn gibt den Index des Polygons zurück, in dem sich der Punkt befindet;
    // *** Kriterium für Line.Intersect;
    // - Gibt nur Schnittpunkte zurück, die sich innerhalb der Strecken A1A2 und B1B2 befinden;
    for Row := 0 to AxisVert.Count - 1 do
    begin
      Vert.P1 := FloatPoint(AxisVert[Row], MinY);
      Vert.P2 := FloatPoint(AxisVert[Row], MaxY);
      for I := 0 to Value.Count - 1 do
        for J := 0 to Value[I].Count - 1 do
        begin
          Line.P1 := Value[I].Items[J];
          Line.P2 := Value[I].NextItems[J];
          if Line.Intersect(Vert, false, P) then // 1 von 3: Schnittpunkte VertLines / PolygonLines;
            if Value.PtIn(P) > -1 then Nodes.Add(P);
      end;
      for Col := 0 to AxisHorz.Count - 1 do
      begin
        Horz.P1 := FloatPoint(MinX, AxisHorz[Col]);
        Horz.P2 := FloatPoint(MaxX, AxisHorz[Col]);
        for I := 0 to Value.Count - 1 do
          for J := 0 to Value[I].Count - 1 do
          begin
            Line.P1 := Value[I].Items[J];
            Line.P2 := Value[I].NextItems[J];
            if Line.Intersect(Horz, false, P) then // 2 von 3: Schnittpunkte HorzLines / PolygonLines;
              if Value.PtIn(P) > -1 then Nodes.Add(P);
          end;
        if Vert.Intersect(Horz, false, P) then // 3 von 3: Schnittpunkte HorzLines / VertLines;
          if Value.PtIn(P) > -1 then Nodes.Add(P);
      end;
    end;
    Nodes.RemoveSameValues; // Doppel rauslöschen;
    // II von III: Delauny;
    Clear;
    for I := 0 to Nodes.Count - 1 do
      Add(Nodes.X[I], Nodes.Y[I]);
    Mesh;
    // III von III: Nicht vorhandene Knoten und Elemente rauslöschen;
    for I := FTrianglesCount downto 1 do // Delauny ist 1-basiert;
      if Value.PtIn(IncircleCenter[I]) < 0 then
        DeleteTriangle(I);
    for I := FNodesCount downto 1 do // ..
      if not NeedNode[I] then
        DeleteNode(I);
    RefreshCapacity;
    Assert(CheckMesh, 'PolygonsMesh.CheckMesh');
    // Ggf. die Dreiecke in Tetragons überführen -> QuadMesh;
  finally
    AxisHorz.Free;
    AxisVert.Free;
    Nodes.Free;
  end;
end;
  Mit Zitat antworten Zitat