Einzelnen Beitrag anzeigen

Bjoerk

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

AW: Volumen und Mittelpunkt von einem 3D-Raum berechnen?

  Alt 12. Feb 2018, 08:55
Ist quasi ein räumliches N-Eck (Polyeder). Die Eingabe ist etwas aufwendiger als beim 2D N-Eck weil man zusätzlich die Begrenzungsebenen eingeben muss. Die Begrenzungsebenen müssen mathematisch positiv eingegeben werden.

Beispiel Würfel:
Delphi-Quellcode:
procedure TPolyederForm.TestButton3Click(Sender: TObject);
begin
  FPolyeder.Clear;

  FPolyeder.AddPoint(0, 0, 0);
  FPolyeder.AddPoint(8, 0, 0);
  FPolyeder.AddPoint(0, 5, 0);
  FPolyeder.AddPoint(8, 5, 0);
  FPolyeder.AddPoint(0, 0, 3);
  FPolyeder.AddPoint(8, 0, 3);
  FPolyeder.AddPoint(0, 5, 3);
  FPolyeder.AddPoint(8, 5, 3);

  FPolyeder.AddPlane([0, 2, 3, 1]);
  FPolyeder.AddPlane([4, 5, 7, 6]);
  FPolyeder.AddPlane([0, 1, 5, 4]);
  FPolyeder.AddPlane([2, 6, 7, 3]);
  FPolyeder.AddPlane([1, 3, 7, 5]);
  FPolyeder.AddPlane([0, 4, 6, 2]);

  FPolyeder.Calc;
end;
TPolyeder:
Delphi-Quellcode:
function TPolyeder.Determinant(const A, B, C: integer): double;
begin
  Result := FPoints[A].X * (FPoints[B].Y * FPoints[C].Z - FPoints[B].Z * FPoints[C].Y)
    - FPoints[A].Y * (FPoints[B].X * FPoints[C].Z - FPoints[B].Z * FPoints[C].X)
    + FPoints[A].Z * (FPoints[B].X * FPoints[C].Y - FPoints[B].Y * FPoints[C].X);
end;

procedure TPolyeder.Calc;
var
  I, J, A, B, C: integer;
  Det: double;
begin
  FVolumen := 0;
  FCenter.X := 0;
  FCenter.Y := 0;
  FCenter.Z := 0;
  for I := 0 to FPlanes.Count - 1 do
  begin
    A := FPlanes[I].Items[0];
    B := FPlanes[I].Items[1];
    for J := 2 to FPlanes[I].Count - 1 do
    begin
      C := FPlanes[I].Items[J];
      Det := Determinant(A, B, C);
      FVolumen := FVolumen + Det;
      FCenter.X := FCenter.X + (FPoints[A].X + FPoints[B].X + FPoints[C].X) * Det;
      FCenter.Y := FCenter.Y + (FPoints[A].Y + FPoints[B].Y + FPoints[C].Y) * Det;
      FCenter.Z := FCenter.Z + (FPoints[A].Z + FPoints[B].Z + FPoints[C].Z) * Det;
      B := C;
    end;
  end;
  if FVolumen <> 0 then
  begin
    FVolumen := FVolumen / 6;
    FCenter.X := FCenter.X / 24 / FVolumen;
    FCenter.Y := FCenter.Y / 24 / FVolumen;
    FCenter.Z := FCenter.Z / 24 / FVolumen;
  end
  else
  begin
    FCenter.X := 0;
    FCenter.Y := 0;
    FCenter.Z := 0;
  end;
end;
LG Thomas
  Mit Zitat antworten Zitat