Трёхмерная графика, Пирамида Опции

[art88]

Задача
Изобразить линию сечения правильной шестигранной пирамиды плоскостью, заданной коэффициентами своего уравнения(Основание пирамиды лежит в плоскости XOY, высота совпадает с осью Z)
----------------------------------------------------------
Проблема
Подскажите, как лучше потроить усечённую пирамиду, если я знаю взаимное расположение плоскости и каждой грани(точку пересечения или то, что они параллельны или, что грань лежит в плоскости).
----------------------------------------------------------
Программа
Рисует пирамиду(DrawPyr), оси координат(DrawAxes), может находить взаимное расположение граней и плоскости(Interception).
(См. Pyramid.pas).

[volvo]

art88, погоди... Ты же написал, что

Программа
Рисует пирамиду(DrawPyr)

, и в то же время у тебя

Проблема
Подскажите, как лучше потроить усечённую пирамиду

... Так рисует или НЕ рисует?

[art88]

Процедура DrawPyr рисует пирамиду(не усечённую) с заданными параметрами.

[volvo]

Ну, попробуй вот это глянуть... Я только что выдрал это из своей старой программы, рисующей 3D поверхности, может это натолкнет тебя на какую-то идею...

{$n+}
uses graph;

type
  TPoint = record
    X, Y, Z: double;
  end;
  PTArr = ^TArr;
  TArr = array[1 .. pred(maxint div sizeof(TPoint))] of TPoint;

const
  R2D = 180 / Pi;

const
  rPyrBig   = 50;
  rPyrSmall = 20;
  hPyr = 140;


var
  centerX, centerY: integer;

const
  sqrt2 = 1.414213562;
function CoordX(X, Z: double): integer;
begin
  CoordX := trunc((X + CenterX) - Z);
end;
function CoordY(Y, Z: double): integer;
begin
  CoordY := Trunc(CenterY - Y + Z);
end;

procedure draw3DPnt(P: TPoint);
var
  NewZ: integer;
begin
  NewZ := trunc(P.Z / sqrt2);
  putpixel( CoordX(P.X, NewZ), CoordY(P.Y, NewZ), White);
end;

procedure Draw3DLine(P1, P2: TPoint);
var Z1, Z2: integer;
begin
  Z1 := trunc(P1.Z / sqrt2);
  moveto( CoordX(P1.X, Z1), CoordY(P1.Y, Z1) );
  Z2 := trunc( P2.Z / Sqrt2 );
  lineto( CoordX(P2.X, Z2), CoordY(P2.Y, Z2) );
end;

procedure Axis(Color: integer);
begin
  cleardevice;
  setcolor(Color);
  line(1, CenterY, GetMaxX, CenterY);
  line(CenterX, 1, CenterX, GetMaxY);
  line(CenterX - CenterY, GetMaxY,
       CenterX + CenterY, 1);
  setcolor(White);
  rectangle(1, 1, GetMaxX, GetMaxY)
end;

procedure Pyramide(RBig, RSmall, H, N, color: integer);
var
  curr_angle, DAngle: double;
  below, above: PTArr;
  i: integer;
begin
  getmem(below, N * sizeof(TPoint));
  getmem(above, N * sizeof(TPoint));

  DAngle := (360 div n) / R2D;
  curr_angle := 0.0; i := 0;
  repeat
    inc(i);
    below^[i].X := RBig*sin(curr_angle);
    below^[i].Z := RBig*cos(curr_angle);
    below^[i].Y := 0;

    above^[i].X := Rsmall*sin(curr_angle);
    above^[i].Z := Rsmall*cos(curr_angle);
    above^[i].Y := H;

    curr_angle := curr_angle + DAngle;
  until i = n;

  for i := 1 to n do begin
    if i > 1 then begin
      draw3dLine(below^[pred(i)], below^[i]);
      draw3dLine(above^[pred(i)], above^[i]);
    end;
    draw3dLine(below^[i], above^[i]);
  end;
  draw3dLine(below^[n], below^[1]);
  draw3dLine(above^[n], above^[1]);

  freemem(above, N * sizeof(TPoint));
  freemem(below, N * sizeof(TPoint));

end;

var
  Gd, Gm  : Integer;

begin
  Gd:= Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then Halt;

  centerx := GetMaxX div 2; centery := GetMaxY div 2;

  Axis(Red);
  Pyramide(rPyrBig, rPyrSmall, hPyr, 6, 15);

  ReadLn;
  CloseGraph;
end.

[art88]

volovo, насколько я понял твоя программа строит пирамиду с задаными радиусами верхнего и нижнего основания.
Дело в том, что мне не известен радиус вверхнего основания, да и ввобще в сечении плоскостью может получится и не шестиугольник вовсе(например если плоскость совпадает с YOZ).
В задаче же требуется изобразить пирамиду и ЛИНИЮ, по которой плоскость пересекает пирамиду.
-------------------------------
Я немного доделал программу и теперь она рисует один из частных случаев расположения пирамиды и плоскости, но не могу понять, почему требуемая линия лежит вне пирамиды(кроме случая совпадения секущей плоскости и XOY)??? (Видимо дело в процедуре Interception)

Сообщение отредактировано: art88 - 13.02.2006 23:14

[art88]

Я нашёл ошибку в Interception, обобщил задачу, решаемую программой(до требуемой), но всё равно кроме случая, когда плоскость проходит через все боковые рёбра(типа A=0 B=0 C=1 D=50) программа работает не корректно(например A=0 B=1 C=0 D=0 - вертикальная плоскость).
Принцып работы программы такой: идём по ребрам, ищем точки пересеченя, соединяем.
-------------------------------------------------
Помогите пожалуйста найти ошибку/и, а то у меня две задачи осталось сдать(эта и освещённый шар), а время поджимает!

[volvo]

art88, я очень глубоко не разбирался, просто сразу бросилось в глаза: почему ты сразу же после отрисовки пирамиды ставишь указатель (MoveTo) на ее вершину? Ты что, заранее уверен, что сечение пойдет через вершину? Тогда расскажи, почему?

[art88]

Ну надо же его куда-нибудь поставить. Да и вообще, когда мы будем проводить сечение оно пройдёт или через вершину или через одно из боковых рёбер(в большинстве случаев), ну а если так, то мы сделаем LineTo и линия, соединяющая вершину с первой точкой совпадёт с боковым ребром.

[art88]

Вообще хорошо бы делать MoveTo сразу в первую точку сечения, если она есть, этого можно добиться например заведя, какую-нибудь Булеву пременную, потавить на её истинность проверку и после перого перемещения сделать её FALSE, ну или что-нибудь в этом духе.
--------------------------
Для меня главное построить линию сечения.

[volvo]

art88, кажется я понял, в чем ошибка... Я бы на твоем месте попробовал сделать вот так (читай комментарии):

var
  j: integer; 
  curr_intr: integer; { здесь будет храниться количество точек пересечения секущей с гранями }
  arrIntr: array[1 .. 20] of tPoint; { здесь - соответственно - сами эти точки ... }

begin
  Gd:= Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then Halt;

  DrawAxes(green);
  DrawPyr(rPyr, hPyr, white);

  plane.A:= A; plane.B:= B; plane.C:= C; plane.D:= D;
  { До этого места - никаких изменений }
  curr_intr := 0; 

  { А теперь - the main stuff }

  for j := 2 to i do begin { сначала работаем с ОСНОВАНИЕМ пирамиды }

    lin.bol := pyr[pred(j)]; { Начало отрезка }
    if j <> i then lin.eol := pyr[j]
    else lin.eol := pyr[1]; { Конец отрезка }

    Interception(lin, plane); { находим точку пересечения секущей с этим ребром}
    { здесь надо бы еще проверять, принадлежит ли эта точка ребру... }
    if not paral then begin
      inc(curr_intr); arrIntr[curr_intr] := pInt; { добавляем точку пересечения в список }
    end;
  end;

  { теперь переходим к боковым граням пирамиды, производим с ними ту же операцию }
  lin.bol.x := 0;
  lin.bol.y := 0;
  lin.bol.z := hPyr;
  for j := 1 to pred(i) do begin

    lin.eol := pyr[j];

    Interception(lin, plane);
    if not paral then begin
      inc(curr_intr); arrIntr[curr_intr] := pInt;
    end;
  end;

  { Вот теперь - самое интересное !!! }
  ...
  ReadLn;
  CloseGraph;
end.

А самое интересное - это то, что у тебя есть после всех этих операций список точек пересечения секущей плоскости с пирамидой... НО этого недостаточно. Чтобы правильно отрисовать нужную тебе кривую, ты должен построить из этих точек выпуклый полигон, то есть определить порядок соединения точек... И когда ты найдешь этот порядок, просто в соединяй точки... Все.

Алгоритмы построения полигона были где-то, по-моему, даже на форуме... Попробуй это реализовать.

[art88]

volovo, следуя твоим указаниям я переделал программу(см. Pyramida.pas), добавил поцедуру, рисующую замкнутую кривую(DrawCut), добавил в процедуре Intrception проверку на принадлежность точки отрезку(intercept), но точки пересечения находятся не правильно,точнее находится одна точка, являющаяся центром основания пирамиды.

[volvo]

следуя твоим указаниям я переделал программу

Нет, ты не следовал моим указаниям, а посему ошибки у себя будешь искать сам... Я что написал?

(читай комментарии)

По-твоему это для красоты? Ты не заметил, что СНАЧАЛА строится пирамида - я же написал:

{ До этого места - никаких изменений }

(причем я основывался на СТАРОМ методе ее построения, а ты взял и все перепахал!!!) Я же в алгоритме считал, что массив Pyr к началу работы МОЕЙ части уже заполнен вершинами, лежащими в основании пирамиды, и I содержит увеличенное на 1 количество точек в основании пирамиды, именно на этом все построено, а ты что сделал? У тебя же это вообще не работает, при I = 0...

Кроме того, мое замечание о построении выпуклой оболочки ты тоже предпочел не заметить?

Чтобы правильно отрисовать нужную тебе кривую, ты должен построить из этих точек выпуклый полигон

Ну, так пеняй на себя, потому что ты можешь даже получить правильные точки, но вот соединяться они будут в неверном порядке, как результат на экране будет бред...

Извини, но я умываю руки... Если ты все делаешь не так, как тебе советуют - зачем советовать?

[art88]

И снова здраствуйте....
Вот уже которую неделю, я тщетно пытаюсь написать программу, изображающую сечение пирамиды.
Профессор сказал, что решение этой задачи с отысканием точек пересечения и последующим построением их оболочки(полигона) слишком сложно.
Поэтому пришлось начинать всё заново и вот, что получилось(см. Inter.pas)
-------------------------
Принцип такой:
Рисуем пирамиду, заполняем массив её вершинами(procedure DrawPyr)
Разбиваем основание на треугольники(общая вершина - щентр основания)(procedure GenTri).
Находим пересечение плоскоти с каждой стороной треугольника.
Если нашли две точки соединяем.
Аналогично для боковых граней(общей вершиной треугольников будет вершина пирамиды).
-------------------------
Принцип новый проблеммы старые: сечение не рисуется.
-------------------------
Помогите, пожалуйста, найти ошибку.
P.S.:
Обещаю следвать всем советам.

[art88]

Неужели, ни у кого руки не доходят проверить мою программу?
Очень надо!!!!!!!!!!!!!!

[volvo]

art88, ну НЕ НАХОДИТ твоя процедура Interception пересечений отрезка с плоскостью... Я только что попробовал чуть ли не вручную разбить на треугольники... Разбивается нормально, пересечений НЕТ! Ищи ошибку в Interception...

[art88]

Поменял пару знаков в процедуре interception, убрал проверку на кол-во точек пересечения и программа строит
6 точек пересечения плоскости (0,0,1,50) и пирамиды, но линиями их не соединяет.(т.е программа находит по одной точке пересечения плоскости и треугольника).

Сообщение отредактировано: art88 - 12.03.2006 0:43

[volvo]

программа находит по одной точке пересечения плоскости и треугольника

Знаешь, почему это происходит? Программа-то может и находила бы больше, НО !!!
1.

procedure Interception(l: tLine; s: tPlane);
var
  p: tVector;
  M, N, t: real;
begin
  intercept := false; { <--- У тебя этого не было !!!}
  p.x:= (l.bol.x - l.eol.x);
  p.y:= (l.bol.y - l.eol.y);
  p.z:= (l.bol.z - l.eol.z);
  M:= s.A*p.x + s.B*p.y + s.C*p.z;
  N:= s.A*l.eol.x + s.B*l.eol.y + s.C*l.eol.z + s.D;
  if M <> 0 then begin
    t:= (N)/M;
    if (0 <= t) and (t <= 1) then begin
      intercept:= true;
      pInt.x:= (l.eol.x + p.x*t);
      pInt.y:= (l.eol.y + p.y*t);
      pInt.z:= (l.eol.z - p.z*t);
    end
  end;
end;

А если эту строку НЕ добавить, то после того, как хотя бы один раз intercept будет True, значение False он уже никогда не примет... Это первое.
2.

procedure PlaneTri(p: tPlane; t: tTriangle);
var
  c: integer;
  l: tLine;
  aInt: array[1..3] of tPoint; { <--- У тебя стояло 1 .. 2 }

Если оставить 1 .. 2, то возможна порча значений, хранящихся в стеке ПОСЛЕ aInt (это могут быть данные или код программы)...
3. Измени направление вектора AC в треугольнике (процедура PlaneTree):

 { вместо }
  l.bol:= t.c;
  l.eol:= t.a;
  { поставь }
  l.bol:= t.a;
  l.eol:= t.c;

После внесения изменений ЧЕГО-ТО чертится, но я не уверен, что именно то, что нужно. Проверь... Кстати, можно внести еще несколько мелких улучшений, чтобы сократить объем программы. Нужно?

[art88]

Внёс все изменения, действительно что-то чертится, но это явно не линия пересечения. В случае горизонтальной плоскости(0,0,1,50) построенные отрезки действительно содержат точки пересечения плоскости и рёбер, но во-первых эти отрезки выходят за пирамиду а во-вторых не соединяются друг с другом.

[volvo]

Опять начинается... Я же сказал, без Intercept := False не будет у тебя ничего чертиться !!!

[art88]

Volvo, извини запостил не ту программу(она вообще без изменений).