Отрезкм Опции

[Reflex]

Нуно сделать прогу, которая по двух отрезках находила их пересечение. Искала, но ни одна программа не работает

[Tan]

в смысле ты задаёшь координаты двух отрезков и тебе надо найти точку их пересечения ?

[Reflex]

да

[Tan]

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

[Reflex]

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

[Perfez]

Лови:
 Intersection.pas ( 1.23 килобайт ) Кол-во скачиваний: 399

[Reflex]

Не работает
1 0
2 0
1 0
3 0
и я так поняла, что она не показывает мн-во пересечений(координаты точки или отрезка) помогите, очень нужно

[Perfez]

что она не показывает мн-во пересечений(координаты точки или отрезка)

Разве две прямые линии могут пересекаться в двух разных точках?

[Lapp]

Отведай мою стряпню..

type
  tPoint=record
    x,y:real
  end;
  tLine=record
    P1,P2:tPoint
  end;

procedure InterSection(L1,L2:tLine;var P:tPoint);
var
  k1,k2:real;
begin
  with L1 do k1:= (P2.y-P1.y)/(P2.x-P1.x);
  with L2 do k2:= (P2.y-P1.y)/(P2.x-P1.x);
  P.x:= (L1.P1.y - L2.P1.y + L2.P1.x*k2 - L1.P1.x*k1) / (k2-k1);
  with L1 do P.y:= P1.y + (P.x-P1.x)*k1;
end;

var
  L1,L2:tLine;
  P:tPoint;

begin
  with L1 do begin
    P1.x:=-2;
    P1.y:=-2;
    P2.x:=+2;
    P2.y:= 0;
  end;
  with L2 do begin
    P1.x:= 0;
    P1.y:= 1;
    P2.x:=+2;
    P2.y:=-2;
  end;
  InterSection(L1,L2,P);
  with P do WriteLn('X=',x:7:3,'  Y=',y:7:3);
  ReadLn
end.

Добавлено через 3 мин.
Эта процедура выдаст ошибку, если отрезок расположен вдоль у.
Но этот случай гораздо проще, и его можно рассмотреть отдельно.

[volvo]

Эта процедура выдаст ошибку, если отрезок расположен вдоль у.

Не только... Эта процедура выдаст ошибку ВСЕГДА, когда отрезки только касаются друг друга, но не пересекаются:

  with L1 do begin
    P1.x:= 1;
    P1.y:= 2;
    P2.x:= 5;
    P2.y:=10;
  end;
  with L2 do begin
    P1.x:= 1;
    P1.y:= 0;
    P2.x:= 5;
    P2.y:= 8;
  end;

результат: (k1 = k2), divizion by zero

Сообщение отредактировано: volvo - 17.04.2007 10:11

[Lapp]

Эта процедура выдаст ошибку ВСЕГДА, когда отрезки только касаются друг друга, но не пересекаются:
...
результат: (k1 = k2), divizion by zero

Не совсем понял, при чем здесь касание...
k1=k2 означает параллельность прямых, что естественно, тоже особый случай.
В любом случае - volvo, спасибо за исправление.

2 reflex:
Да, нужно проверять также на параллельность, то есть равенство k1 и k2.

[Reflex]

Код

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.

помогите найти ошибку.

[Lapp]

помогите найти ошибку.

Легко.
Твоя ошибка уже в том, что ты не указала, в чем она состоит. А желающим помочь самим догадываться, что должна делать программа, что она вводит в начальных данных (даже нет приглашений на ввод!!), где и как проявляется ошибка... Во всем тексте ни одного комментария!

М

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