Doppelte Dreiecke in einem Array finden.... ?

[turboPASCAL]

Zitat von volkerw:

wenn m3DObject ein dreidimensionales Array aus Singlewerten ist, dann stellt m3DObject[i, j, 0] genau einen Wert dar,
oder sehe ich das falsch ?

Ja.

Delphi-Quellcode:

type
  TVertex = array [0..2] of Single;
  TFace = array [0..2] of TVertex;
  T3DObject = array of TFace;

var
  m3DObject: T3DObject;

es konnte auch so aussehen:

Delphi-Quellcode:

  m3DObject: array of record // Points for Faces 
                        VertexA: Record // Points A of Faces
                                   X, Y, Z: Single;
                                 end;
                        VertexB: Record // Points B of Faces
                                   X, Y, Z: Single;
                                 end;
                        VertexC: Record // Points C of Faces
                                   X, Y, Z: Single;
                                 end;
                      end;

m3DObject gibt also den Record "Points for Faces" zurück. Im oberen Code ist es halt ein
Eindimensionales Array von 0..2 für drei Arrays mit je drei Singlewerten.


Mit Corpsman Hilfe schaut das ganze nun so aus:

Delphi-Quellcode:

procedure TForm1.btnChkOfDuplicateClick(Sender: TObject);
const
  Toleranz = 0.00001;

  function Tollgleich(v1, v2: single): Boolean;
  begin
    result := abs(v1 - v2) <= Toleranz;
  end;

  function IsSame(v1: TFace; v2: Tface): boolean;
  begin
    result := false;
    if (tollgleich(v1[0, 0], v2[0, 0])) and (tollgleich(v1[0, 1], v2[0, 1]))
      and (tollgleich(v1[0, 2], v2[0, 2])) and (tollgleich(v1[1, 0], v2[1, 0]))
      and (tollgleich(v1[1, 1], v2[1, 1])) and (tollgleich(v1[1, 2], v2[1, 2]))
      and (tollgleich(v1[2, 0], v2[2, 0])) and (tollgleich(v1[2, 1], v2[2, 1]))
      and (tollgleich(v1[2, 2], v2[2, 2])) then Result := True;
  end;

  function RotFace(v1: TFace): Tface;
  begin
    result[0] := v1[1];
    result[1] := v1[2];
    result[2] := v1[0];
  end;
  
  function MirrowFace(v1: Tface): Tface;
  begin
    result[0] := v1[2];
    result[1] := v1[1];
    result[2] := v1[0];
  end;

var
  Aktuell, Gerade: TFace;
  i, n, d: integer;
begin
  StrOut(TRUE, 'Begin Check of Duplicate', clGreen, [fsBold]);

  finished := FALSE;
  btnCancel.Enabled := TRUE;
  ProgressBar1.Visible := TRUE;
  ProgressBar1.Position := 0;
  ProgressBar1.Max := High(m3DObject);
  d := 0;
  
  for n := 0 to High(m3DObject) do
  begin
    if finished then Break;
    Aktuell := m3DObject[n];
    for i := n + 1 to High(m3DObject) do
    begin
      if finished then Break;
      if i mod 100 = 0 then Application.ProcessMessages;
      ProgressBar1.Position := n;
      gerade := m3DObject[i]; // Die Bewegungsgruppe des Dreiecks besagt 6 Mögliche stellungen !!
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall1');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall2');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall3');
      end;
      Gerade := RotFace(gerade);
      Gerade := MirrowFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall4');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall5');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall6');
      end;
    end;
  end;

  ProgressBar1.Visible := FALSE;
  ProgressBar1.Position := 0;
  btnCancel.Enabled := FALSE;

  if not finished
    then StrOut(TRUE, format('DONE: Check of Duplicate. (%d)', [d]), clGreen, [fsBold])
    else StrOut(TRUE, 'CANCEL: Check of Duplicate.', clRed, [fsBold]);
end;