IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Трёхмерная графика, Пирамида
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  PYRAMID.PAS ( 2.66 килобайт ) Кол-во скачиваний: 350
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






art88, погоди... Ты же написал, что
Цитата
Программа
Рисует пирамиду(DrawPyr)
, и в то же время у тебя
Цитата
Проблема
Подскажите, как лучше потроить усечённую пирамиду
... blink.gif Так рисует или НЕ рисует?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Процедура DrawPyr рисует пирамиду(не усечённую) с заданными параметрами.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Ну, попробуй вот это глянуть... Я только что выдрал это из своей старой программы, рисующей 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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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

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


Прикрепленные файлы
Прикрепленный файл  PYRAMID2.PAS ( 3.2 килобайт ) Кол-во скачиваний: 297
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  PYR.PAS ( 4.31 килобайт ) Кол-во скачиваний: 332
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Ну надо же его куда-нибудь поставить. smile.gif Да и вообще, когда мы будем проводить сечение оно пройдёт или через вершину или через одно из боковых рёбер(в большинстве случаев), ну а если так, то мы сделаем LineTo и линия, соединяющая вершину с первой точкой совпадёт с боковым ребром.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Вообще хорошо бы делать MoveTo сразу в первую точку сечения, если она есть, этого можно добиться например заведя, какую-нибудь Булеву пременную, потавить на её истинность проверку и после перого перемещения сделать её FALSE, ну или что-нибудь в этом духе.
--------------------------
Для меня главное построить линию сечения.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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.


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

Алгоритмы построения полигона были где-то, по-моему, даже на форуме... Попробуй это реализовать.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  PYRAMIDA.PAS ( 4.41 килобайт ) Кол-во скачиваний: 317
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






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

Нет, ты не следовал моим указаниям, а посему ошибки у себя будешь искать сам... Я что написал?
Цитата
(читай комментарии)
По-твоему это для красоты? Ты не заметил, что СНАЧАЛА строится пирамида - я же написал:
Цитата
{ До этого места - никаких изменений }
(причем я основывался на СТАРОМ методе ее построения, а ты взял и все перепахал!!!) Я же в алгоритме считал, что массив Pyr к началу работы МОЕЙ части уже заполнен вершинами, лежащими в основании пирамиды, и I содержит увеличенное на 1 количество точек в основании пирамиды, именно на этом все построено, а ты что сделал? У тебя же это вообще не работает, при I = 0...

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

Извини, но я умываю руки... Если ты все делаешь не так, как тебе советуют - зачем советовать? unsure.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  INTER.PAS ( 4.26 килобайт ) Кол-во скачиваний: 277
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Неужели, ни у кого руки не доходят проверить мою программу? unsure.gif
Очень надо!!!!!!!!!!!!!! mega_chok.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






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


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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

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


Прикрепленные файлы
Прикрепленный файл  INT.PAS ( 4.31 килобайт ) Кол-во скачиваний: 280
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






Цитата
программа находит по одной точке пересечения плоскости и треугольника
Знаешь, почему это происходит? Программа-то может и находила бы больше, НО !!! smile.gif
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;


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


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  INT.PAS ( 4.31 килобайт ) Кол-во скачиваний: 253
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






dry.gif Опять начинается... Я же сказал, без Intercept := False не будет у тебя ничего чертиться !!!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  INT.PAS ( 4.33 килобайт ) Кол-во скачиваний: 260
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 7.10.2024 9:52
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name