Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Вот есть одно затруднение... Не ясно. Плиз, срочно, хелп 
V
    Опции темы
NewDima
Дата 27.2.2006, 08:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 922
Регистрация: 20.2.2006
Где: <?here?>

Репутация: нет
Всего: 12
Есть одна задачка, в идеале она должна выщитывать обьем поверхности многоугольника в пространстве по заданным координатам его вершин, например:
Input.txt:
8
0 0 0
1 0 0
1 1 0
0 1 0
0 0 1
1 0 1
1 1 1
0 1 1
.
Вот текст написал, вроде как должна в массив mm записывать номера всех точек в массиве mas, которые принадлежат граням:


Код
Uses
     crt;

Const qqq=10;

Type
     nas = array[1..3, 1..qqq] of integer;
     vas = array[1..qqq-1, 1..qqq-1] of integer;

Var
    f: text;
    b: integer;
    mas: nas;
    mm: vas;

Procedure rd(var mas: nas);
Var
    f: text;
    i: integer;

Begin
  Assign(f, 'input.pas');
  Reset(f);
  read(f, b);
  For i:=1 to b do
  begin
    read(f, mas[1, i]);
    read(f, mas[2, i]);
    read(f, mas[3, i]);
  end;
  close(f); 
  end;

Function opred(p1, p2, p3, l: integer): shortint;
Var opr: longint;
Begin
  opr:=    (mas[1, l]-mas[1, p3])*(mas[2, p1]-mas[2, p3])*(mas[3, p2]-mas[3, p3]);
  opr:=opr+(mas[2, l]-mas[2, p3])*(mas[3, p1]-mas[3, p3])*(mas[1, p2]-mas[1, p3]);
  opr:=opr+(mas[3, l]-mas[3, p3])*(mas[1, p1]-mas[1, p3])*(mas[2, p2]-mas[2, p3]);
  opr:=opr-(mas[1, l]-mas[1, p3])*(mas[3, p1]-mas[3, p3])*(mas[2, p2]-mas[2, p3]);
  opr:=opr-(mas[2, l]-mas[2, p3])*(mas[1, p1]-mas[1, p3])*(mas[3, p2]-mas[2, p3]);
  opr:=opr-(mas[3, l]-mas[3, p3])*(mas[2, p1]-mas[2, p3])*(mas[1, p2]-mas[1, p3]);
  If opr>0 then opred:=1 else if opr<0 then opred:=-1 else opred:=0;
end;

Procedure chist(var das: array of integer; c: integer);
Var i: integer;
Begin
  For i:=0 to c do
    das[i]:=0;
End;

Procedure force;
Var i, j, k: integer;
    m, n, d: integer;
    off1, off2: shortint;
    w, p, cop: integer;
    das: array[1..qqq-1] of integer;
    min, pl: boolean;
    label back;
Begin
  w:=1;
  p:=1;
  chist(das, qqq-1);
  For i:=1 to b-4 do
  begin
      For j:=i+1 to b-3 do
      begin
      {back:
      min:=false;
      pl:=false;}
         For k:=j+1 to b-2 do
         begin
         back:
         min:=false;
         pl:=false;
              For m:=k+1 to b-1 do
              begin
              off1:=opred(i, j, k, m);
              if off1=0 then begin das[p]:=m; inc(p); end
                 else
                 if ((min) and (off1>0)) or ((pl) and (off1<0)) then
                 begin
                 chist(das, p);
                 p:=1;
                 inc(k);
                 goto back;
                 end
                 else
                 case off1 of
                      -1: min:=true;
                       1: pl:=true;
                       end;
              end;
{         if p>1 then}
            begin
            For cop:=1 to qqq-1 do mm[w, cop]:=das[cop];
            chist(das, p);
            mm[w, p]:=i;
            mm[w,p+1]:=j;
            mm[w,p+2]:=k;
            p:=1;
            inc(w);
            end;
         end;
      end;
  end;
end;

Begin
  clrscr;
  rd(mas);
  force;
  readln;  
  readln;
end.
smile


--------------------
Начинаем черкать!
PM ICQ   Вверх
NewDima
Дата 27.2.2006, 09:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 922
Регистрация: 20.2.2006
Где: <?here?>

Репутация: нет
Всего: 12
well, anybody...
Time is going...


--------------------
Начинаем черкать!
PM ICQ   Вверх
mes
Дата 27.2.2006, 10:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


любитель
****


Профиль
Группа: Участник Клуба
Сообщений: 7954
Регистрация: 14.1.2006

Репутация: нет
Всего: 250
а где вопрос smile

Это сообщение отредактировал(а) mes - 27.2.2006, 10:05


--------------------
http://opendots.net
PM MAIL WWW   Вверх
NewDima
Дата 27.2.2006, 10:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 922
Регистрация: 20.2.2006
Где: <?here?>

Репутация: нет
Всего: 12
Понял. вопрос большой, помогите избавиться от ошибки, у меня постоянно поподаются грани, которых в реальности не существуют (правда не слишком часто).
И вообще, может у кого какие идеи другим способом есть решить, а принцип моего решения в том, чтобы найти все грани перебором для каждых трех точек еще одной, и если она удовлетворяет уравнению (матричному оприделителю), и нет таких двух точек, которые лежали бы по разные стороны от этой плоскости, то эта точка входит в число точек грани, которую мы тут же запоминаем в массиве. Дальше дело техники поделить грани на треугольники и подщитать их площадь...
в общем, скажите все, что думаете!


--------------------
Начинаем черкать!
PM ICQ   Вверх
Akina
Дата 27.2.2006, 10:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: нет
Всего: 454
Задание не определено. По одному и тому же массиву вершин можно построить кучу разных многогранников.

Цитата(NewDima @ 27.2.2006, 11:16 Найти цитируемый пост)
в общем, скажите все, что думаете!

нельзя. цензура.


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
NewDima
Дата 28.2.2006, 11:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 922
Регистрация: 20.2.2006
Где: <?here?>

Репутация: нет
Всего: 12
Многоугольник выпуклый, не уточнил. Он один такой.


--------------------
Начинаем черкать!
PM ICQ   Вверх
Guedda
Дата 28.2.2006, 17:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Подрывник
****


Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: нет
Всего: 78
Ну и в чем загвоздка?


--------------------
Ll 2
PM MAIL WWW ICQ Skype GTalk   Вверх
sergejzr
Дата 28.2.2006, 18:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Un salsero
Group Icon


Профиль
Группа: Админ
Сообщений: 13285
Регистрация: 10.2.2004
Где: Германия г .Ганновер

Репутация: нет
Всего: 360
Модератор: Название темы должно отражать ее суть!


--------------------
Me.
FB.
LinkedIn.
ORCID.
YT.
PM WWW IM ICQ Skype GTalk Jabber AOL YIM MSN   Вверх
NewDima
Дата 2.3.2006, 02:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 922
Регистрация: 20.2.2006
Где: <?here?>

Репутация: нет
Всего: 12
Ну, ладно, я ужу сам решил, да, видать не умею я задание формировать


--------------------
Начинаем черкать!
PM ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0571 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.