Отрезкм |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Отрезкм |
Reflex |
Сообщение
#1
|
Пионер Группа: Пользователи Сообщений: 118 Пол: Женский Репутация: 0 |
Нуно сделать прогу, которая по двух отрезках находила их пересечение. Искала, но ни одна программа не работает
-------------------- Нам не дано предугадать как наше слово отзовется...
|
Reflex |
Сообщение
#2
|
Пионер Группа: Пользователи Сообщений: 118 Пол: Женский Репутация: 0 |
Код type point = record x, y: real; end; procedure min(var point11,point12:point); var tmp : point; begin if (point11.x<point12.x) or (point11.y<point12.y) then exit; tmp:=point11; point11:=point12; point12:=tmp; end; function inside(p1,p2,p3:point):boolean; begin inside:=false; if p1.y=p2.y then begin if (p1.x<=p3.x) and (p2.x<=p1.x) then inside:=true; end else if (p1.y<=p3.y) and (p2.y<=p1.y) then inside:=true; end; function conect(point11, point12, point21, point22: point;var pretpoint: point): boolean; var d, d1, d2, t1, t2: real; p1,p2:point; var f : boolean; comp : real; const epsilon = 10E-4; begin conect := false; f:=false; d := (point12.y - point11.y)*(point21.x - point22.x) - (point21.y - point22.y)*(point12.x - point11.x); if abs(d) < epsilon then begin comp:=abs(abs((point12.x-point11.x)*(point21.x-point11.x) +(point12.y-point11.y)*(point21.y-point11.y)) -sqrt(sqr(point12.x-point11.x)+sqr(point11.y-point12.y)) *sqrt(sqr(point21.x-point11.x)+sqr(point11.y-point21.y))); { writeln(comp:0:6);} if comp<epsilon then begin if point11.y=point12.y then begin if (point11.x<=point21.x) and (point12.x>=point21.x) then begin if (point11.x<=point22.x) and (point12.x>=point22.x) then begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point22.x; p2.y:=point22.y; f:=true; conect:=true; end else begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end; end else if (point11.x<=point22.x) and (point12.x>=point22.x) then begin p1.x:=point22.x; p1.y:=point22.y; p2.x:=point11.x; p2.y:=point11.y; f:=true; conect:=true; end else begin p1.x:=point11.x; p1.y:=point11.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end; end else if (point11.y<=point21.y) and (point12.y>=point21.y) then begin if (point11.y<=point22.y) and (point12.y>=point22.y) then begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point22.x; p2.y:=point22.y; f:=true; conect:=true; end else begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end; end else if (point11.y<=point22.y) and (point12.y>=point22.y) then begin p1.x:=point22.x; p1.y:=point22.y; p2.x:=point11.x; p2.y:=point11.y; f:=true; conect:=true; end else begin p1.x:=point11.x; p1.y:=point11.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end end; if f then if (p1.x<>p2.x) or (p1.y<>p2.y) then begin write(p1.x:0:6,' ',p1.y:0:6,' ',p2.x:0:6,' ',p2.y:0:6) end else begin write(p1.x:0:6,' ',p1.y:0:6); end else begin if (point11.x=point21.x) and (point11.y=point21.y) then begin writeln(point11.x:0:6,' ',point11.y:0:6); conect:=true; exit; end else if (point11.x=point22.x) and (point11.y=point22.y) then begin writeln(point11.x:0:6,' ',point11.y:0:6); conect:=true; exit; end else if (point12.x=point21.x) and (point12.y=point21.y) then begin writeln(point12.x:0:6,' ',point12.y:0:6); conect:=true; exit; end else if (point12.x=point22.x) and (point12.y=point22.y) then begin writeln(point12.x:0:6,' ',point12.y:0:6); conect:=true; exit; end; end; exit; end; d1 := (point12.y-point11.y)*(point21.x-point11.x)-(point21.y-point11.y)*(point12.x-point11.x); d2 := (point21.y-point11.y)*(point21.x-point22.x)-(point21.y-point22.y)*(point21.x-point11.x); t1:=d1/d; t2:=d2/d; if not ((t1<=1)and(t1>=0)and(t2>=0)and(t2<=1)) then begin exit; end; write(point11.x+(point12.x-point11.x)*t2:0:6,' ',point11.y+(point12.y-point11.y)*t2:0:6); { pretpoint.x := point11.x+(point12.x-point11.x)*t2; pretpoint.y := point11.y+(point12.y-point11.y)*t2;} conect := true end; var res,p1,p2,p3,p4: point; begin read(p1.x,p1.y,p2.x,p2.y,p3.x,p3.y,p4.x,p4.y); min(p1,p2); min(p3,p4); if conect(p1, p2, p3, p4, res) then else writeln('Empty'); end. помогите найти ошибку. -------------------- Нам не дано предугадать как наше слово отзовется...
|
Текстовая версия | 3.05.2024 8:51 |