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

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

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

 
 Ответить  Открыть новую тему 
> Трехмерные преобразования, переделка программы
сообщение
Сообщение #1





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

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


Здравствуйте!

Подскажите, как переделать программу:::
вращение октаэдра (ось вращения не совпадает с собственной осью фигуры)
а надо на основе этих же процедур преобразования реализовать вращение икосаэдра (20 граней треугольных, 12 вершин и 30 ребер)

текст ниже:

Код

Program Oktaedr1;
Uses crt,graph;
Type
  Oktaedr=record { Данные всех точек октаэдра }
    mass1:array [1..10] of record
      x3d,y3d,z3d:real;    { Координаты в трехмерном пространстве }
      x2,y2:integer;       { Новые координаты на экране }
      xold,yold:integer;   { Для стирания старого изображения }
    end;
{ Данные всех граней октаэдра }
    gran:array [1..10] of record
      a,b,c:integer;    { Номера точек }
      cl:integer;       { Цвет }
    end;
    npixel:integer;      { Реально используемое количество точек}
    plosk:integer;       { Реально используемое количество плоскостей }
  end;
  matr=array [1..4,1..4] of real;    { Тип "матрица" для преобразований (4x4) }


const S=200; { сторона октаэдра }

{-----------------------процедура вывода октаэдра на экран }
procedure otobragenie(var f:oktaedr);
var
  n:integer;
  t:array [1..3] of pointtype;
  o,a1,a2,a3,a4:real;
const
  EYEY=350;     { Расстояние до глаза }
  EYEL=200;     { Расстояние до экрана }
begin
  with f do
    for n:=1 to npixel do with mass1[n] do begin
{ Копируем старые значения }
    xold:=x2;yold:=y2;
{ Вычисляем значения координат с учетом положения }
{ Считаем что ось Y - вертикально, X - горизонтально }
{ Вычисляем координаты на экране }
    x2:=trunc(x3d*EYEL/(z3d-EYEY));
    y2:=trunc(y3d*EYEL/(z3d-EYEY));
  end;
{ Удаляем старые данные }
  setcolor(0);
  setfillstyle(1,0);
  with f do for n:=1 to plosk do begin
{размещаем октаэдр посередине экрана }
    t[1].x:=320+mass1[gran[n].a].xold;t[1].y:=240-mass1[gran[n].a].yold;
    t[2].x:=320+mass1[gran[n].b].xold;t[2].y:=240-mass1[gran[n].b].yold;
    t[3].x:=320+mass1[gran[n].c].xold;t[3].y:=240-mass1[gran[n].c].yold;
    fillpoly(3,t);
  end;
{ Рисуем изображение }
  setcolor(0);
  with f do for n:=1 to plosk do begin
    setfillstyle(1,gran[n].cl);
    t[1].x:=320+mass1[gran[n].a].x2;t[1].y:=240-mass1[gran[n].a].y2;
    t[2].x:=320+mass1[gran[n].b].x2;t[2].y:=240-mass1[gran[n].b].y2;
    t[3].x:=320+mass1[gran[n].c].x2;t[3].y:=240-mass1[gran[n].c].y2;
{ Проверяем направление обхода выводимой плоскости и выводим при правильном }
    a1:=t[2].x-t[1].x;
    a2:=t[3].y-t[2].y;
    a3:=t[3].x-t[2].x;
    a4:=t[2].y-t[1].y;
    o:=a1*a2-a3*a4;
    if (o<0) then
      fillpoly(3,t);
  end;
end;

{ Преобразование фигуры в каждом цикле }
procedure preobraz(var f:oktaedr;m:matr);
var
  nx,ny,nz:real;
  n:integer;
begin
{ Просто умножаем каждую точу на матрицу, описывающую изменения }
  for n:=1 to f.npixel do with f.mass1[n] do begin
    nx:=m[1,1]*x3d+m[1,2]*y3d+m[1,3]*z3d+m[1,4];
    ny:=m[2,1]*x3d+m[2,2]*y3d+m[2,3]*z3d+m[2,4];
    nz:=m[3,1]*x3d+m[3,2]*y3d+m[3,3]*z3d+m[3,4];
    x3d:=nx;y3d:=ny;z3d:=nz;
  end;
end;

{ Процедуры работы с матрицами }

{ Создание матрицы смещения }
procedure smeshenie(var mm:matr);
var n,m:integer;
begin
  for n:=1 to 4 do for m:=1 to 4 do
    if (n<>m) then mm[n,m]:=0 else mm[n,m]:=1;
end;

{ Создание матрицы вращения вокруг любой оси координат }
procedure rotate(var m:matr;a:real;n:integer);
var
  ax1,ax2:integer;
begin
  smeshenie(m);
  ax1:=n+1;if ax1=4 then ax1:=1;
  ax2:=ax1+1;if ax2=4 then ax2:=1;
  m[ax1,ax1]:=cos(a);
  m[ax1,ax2]:=-sin(a);
  m[ax2,ax1]:=sin(a);
  m[ax2,ax2]:=cos(a);
end;

{ Переменные программы }
var
  drv,mode:integer;  
  c:char;              { Символ, считанный с клавиатуры }
  fg:oktaedr;          { Данные октаэдра }
  rt:matr;             { Матрица вращения }

begin
{-----Инициализация графики----------}
  drv:=DETECT;
  mode:=VGAHI;
  initgraph(drv,mode,'');
  if (GraphResult=grOk) then
{Если инициализация прошла успешно, рисуем октаэдр}
begin
  with fg do begin
    npixel:=6;
    plosk:=8;
{ Задаем точки }
    mass1[1].x3d:=S;mass1[1].y3d:=0;mass1[1].z3d:=0;
    mass1[2].x3d:=0;mass1[2].y3d:=S;mass1[2].z3d:=0;
    mass1[3].x3d:=-S;mass1[3].y3d:=0;mass1[3].z3d:=0;
    mass1[4].x3d:=0;mass1[4].y3d:=-S;mass1[4].z3d:=0;
    mass1[5].x3d:=0;mass1[5].y3d:=0;mass1[5].z3d:=S;
    mass1[6].x3d:=0;mass1[6].y3d:=0;mass1[6].z3d:=-S;
{ Задаем грани и их цвет}
    with gran[1] do begin a:=1;b:=2;c:=5;cl:=1;end;
    with gran[2] do begin a:=2;b:=3;c:=5;cl:=7;end;
    with gran[3] do begin a:=3;b:=4;c:=5;cl:=2;end;
    with gran[4] do begin a:=4;b:=1;c:=5;cl:=3;end;
    with gran[5] do begin a:=2;b:=1;c:=6;cl:=4;end;
    with gran[6] do begin a:=3;b:=2;c:=6;cl:=5;end;
    with gran[7] do begin a:=4;b:=3;c:=6;cl:=9;end;
    with gran[8] do begin a:=1;b:=4;c:=6;cl:=8;end;
  end;
{ Поворачиваем фигуру, чтобы стояла не вертикально }
  rotate(rt,0.25,1);
  preobraz(fg,rt);
{ Создаем матрицу для вращения вокруг оси Y }
    rotate(rt,0.13,2);
{ Предварительно вычисляем плоские координаты }
    repeat
{ Выводим картинку }
      otobragenie(fg);
      delay(10000);      { Задержка используется для корректного отображения фигуры на экране }
      preobraz(fg,rt);     {Вращаем октаэдр}
      if (keypressed) then begin
        c:=readkey;
      end else c:=' ';
    until c=#27; {Пока не нажата клавиша ?Esc?}
    closegraph;
  end else begin {Выводим сообщение об ошибке инициализации графики}
    writeln;
    writeln('Error initialize !!!');
  end;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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