Построение эквидистантного контура к замкнутому невыпоклуму многограннику

Автор темы schukin 
ОбъявленияПоследний пост
ОбъявлениеЗапущен новый раздел «Задачки и головоломки»29.08.2019 00:42
ОбъявлениеОткрыта свободная публикация вакансий для математиков26.09.2019 16:34
ОбъявлениеКниги по математике и экономике в добрые руки!10.08.2023 09:45
Форумы Список тем Новая тема
30.11.2009 14:10
schukin
Построение эквидистантного контура к замкнутому невыпоклуму многограннику
Здравствуйте!
Возникла задача построения эквидистантного кунтура к невыпоклуму многограннику.

Исходные данные:
набор координат вершин многогранника в последовательном порядке обхода контура (по часовой или против).

Необходимо определить наборы точек эквидистантных контуров как внешних так и внутренних (величина смещения для эквидистант = а).

Готового решения я не жду. Помогите хотябы с пониманием такого алгоритма (в частности, как определять характер нормалей к сторонам многогранника - внешняя или внутренняя?)

Буду благодарен за любую помощь



Редактировалось 1 раз(а). Последний 30.11.2009 14:18.
Ответить Цитировать
01.12.2009 00:30
museum
Что-то непонятное
Первое непонятное - это исходные данные:
Цитата

Исходные данные:
набор координат вершин многогранника.
- Набор вершин худо-бедно определяет выпуклый многогранник, как выпуклую оболочку, но для невыпуклого (при размерности оного более двух) - уже не сильно понятно.
Второе непонятное (тоже и исходные данные):
Цитата

в последовательном порядке обхода контура (по часовой или против)
. - что озачает порядок обхода контура многогранника?

Выскажу гипотезу: речь идет о плоском многоугольнике.
Ответить Цитировать
01.12.2009 14:07
schukin
уточнение вопроса
Цитата

Выскажу гипотезу: речь идет о плоском многоугольнике.

Да, действительно, прошу прощения за неточность
Вершины предствляют собой точки на плоскости А1(x1;y1), А2(x2;y2), ... , АN(xN;yN).
При этом еще раз подчеркну что, набор координат вершин многогранника задан в последовательном порядке обхода контура (по часовой или против).

PS
я пытаюсь реализовать такой алгоритм в Object Pascal
Ответить Цитировать
03.11.2022 08:13
basilcat
эквидистантный контур расчёт полный случай
Цитата
schukin
Цитата

Выскажу гипотезу: речь идет о плоском многоугольнике.

Да, действительно, прошу прощения за неточность
Вершины предствляют собой точки на плоскости А1(x1;y1), А2(x2;y2), ... , АN(xN;yN).
При этом еще раз подчеркну что, набор координат вершин многогранника задан в последовательном порядке обхода контура (по часовой или против).

PS
я пытаюсь реализовать такой алгоритм в Object Pascal

https://voloshinov.ru/simplex/functions/W3/index.htm






Алгоритм построения эквидистантного контура:


function EExecW3(X,Y: TObj; var OOO: TObj; Att: TAtt; Sg1,Sg2: integer; OW: pointer): boolean;
var X1,X2,X3,X4,X5,Y1,Y2,Y3,Y4,Y5: complex;
Value,Dx,RR,AX,AY,BX,BY,Rx,Ry: real;
XD1,Yd1,Xd2,Yd2: real;
XP,YP: complex;
Iz: boolean;
I,J,N,N1,N2: integer;
Cst,E,E1,E2,OB,OB1,OB2,OB3,OB4,Pnt1,Pnt2,Pnt3,Pnt4,Pnt5,Pnt6,Pnt7,Pnt8,Pnt,Distance: TObj;
Criterium: boolean;
A,B,C,D: complex;
AA,BB,CC,DD,Xc,Yc,R: real;
Otr1,Otr2,Dug1,Dug2: TObj;
Xt,Yt: complex;
Prizn,Found: boolean;
Xb,Yb,Xe,Ye: real;
NN: integer;
XStart,YStart,XEnd,YEnd: real;
BlockIJ: boolean;
label l_dd,l_od,l_do,fin,lab100,lab101,lab200,lab400;

procedure LineLine(Sg: integer);
begin
if (E1 is TOLine) and (E2 is TOLine) then
begin
EExecDC0(E1,E2,Y,OB,Pnt1,Pnt2,Att0,Att5,Att5,-1,1,Sg,NIL,NIL,NIL);
Pnt1.Destroy;
Pnt2.Destroy;
NeedCorrect:=FALSE;
if OB is TOEmpty then begin OB.Destroy; NeedCorrect:=TRUE end else
begin
XD1:=TODuga(OB).X1; YD1:=TODuga(OB).Y1;XD2:=TODuga(OB).X2; YD2:=TODuga(OB).Y2;
AX:=TOLine(E1).X2.Re;AY:=TOLine(E1).Y2.Re;
BX:=TOLine(E2).X1.Re;BY:=TOLine(E2).Y1.Re;
OB.Tag:=1;
Criterium:=(Abs(XD1-AX)<Eps) and (Abs(YD1-AY)<Eps) and (Abs(XD2-BX)<Eps) and (Abs(YD2-BY)<Eps);
if Criterium then
with TOKontur(OOO).Spis do Add(OB) else
begin
{ликвидация дуги}
NeedCorrect:=TRUE;
OB.Destroy;
end;
end;
if NeedCorrect then
begin
{коррекция концов отрезков}
EExecP2(E1,E2,Pnt,Att5,1,1,NIL);
if Pnt is TOPoint then
begin
XP:=TOPoint(Pnt).X; YP:=TOPoint(Pnt).Y;
TOLine(E1).X2:=XP; TOLine(E1).Y2:=YP;
TOLine(E2).X1:=XP; TOLine(E2).Y1:=YP;
end;
Pnt.Destroy;
end;
end;
end; // LineLine

function PointInCircle(Lin: TOLine; Dug: TODuga): integer;
var CX,CY,XC,YC,R: real;
begin
CX:=(Lin.X1.Re+Lin.X2.Re)/2;
CY:=(Lin.Y1.Re+Lin.Y2.Re)/2;
XC:=Dug.XC.Re;
YC:=Dug.YC.Re;
R:=Abs(Dug.R.Re);
if Dist(Xc,Yc,Cx,Cy)<R then Result:=-1 else Result:=1;
end; // PointInCircle

procedure DugLine(Sgg: integer);
var
P1,P2,Cst1,Cst0,N1,N2,F: TObj;
Q1,Q2,Q3: integer;
Fi,Dl: real;
SG: integer;
Prizn: boolean;
begin
if (E1 is TODuga) and (E2 is TOLine) then
begin
Q1:=-1{PointInCircle(TOLine(E2),TODuga(E1))}{*Sign(TODuga(E1).R)};
Q2:=Q1;
Q3:={Sign(TODuga(E1).R)*Sign(TOChisl(Y).C.Re)}1;
{E1.FAtt.LV:=0;E2.FAtt.LV:=0;}
EExecDA(E1,E2,Y,OB1,Pnt1,Pnt2,OB2,Pnt3,Pnt4,Att0,Att5,Att5,Att0,Att5,Att5,Q1,Q2,Q3,NIL,NIL,NIL,NIL,NIL,NIL);
Pnt1.Destroy; Pnt2.Destroy; Pnt3.Destroy; Pnt4.Destroy;
if OB1 is TOEmpty then OB1.Destroy else
begin
Prizn:=TRUE;
TODuga(OB1).R.Re:=-TODuga(OB1).R.Re; OB1.Tag:=1;
if Prizn {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do Add(OB1) else {ликвидация дуги} OB1.Destroy;
end;
if OB2 is TOEmpty then OB2.Destroy else
begin
Prizn:=TRUE;
Ob2.Tag:=1;
if Prizn {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do Add(OB2) else {ликвидация дуги} OB2.Destroy;;
end;
end;
end; // DugLine

procedure LineDug(Sgg: integer);
var
P1,P2,Cst1,Cst0,N1,N2,F: TObj;
Fi,Dl: real;
Q1,Q2,Q3: integer;
Sg: integer;
Prizn: boolean;
begin

if (E1 is TOLine) and (E2 is TODuga) then
begin
Q1:=-1{PointInCircle(TOLine(E1),TODuga(E2))}{*Sign(TODuga(E2).R)};
Q2:=Q1;
Q3:={Sign(TODuga(E2).R)*Sign(TOChisl(Y).C.Re)}1;
EExecDA(E2,E1,Y,OB1,Pnt1,Pnt2,OB2,Pnt3,Pnt4,Att0,Att5,Att5,Att0,Att5,Att5,Q2,Q1,Q3,NIL,NIL,NIL,NIL,NIL,NIL);
Pnt1.Destroy; Pnt2.Destroy; Pnt3.Destroy; Pnt4.Destroy;
if OB1 is TOEmpty then OB1.Destroy else
begin
Prizn:=TRUE;
OB1.Tag:=1;
if Prizn {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do Add(OB1) else {ликвидация дуги} OB1.Destroy;
end;
if OB2 is TOEmpty then OB2.Destroy else
begin
Prizn:=TRUE;
TODuga(OB2).R.Re:=-TODuga(OB2).R.Re; OB2.Tag:=1;
if Prizn {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do Add(OB2) else {ликвидация дуги} OB2.Destroy;;
end;
end;
end; // LineDug

procedure DugDug;
var Sga,Sgb,Sgc,SV1,SV2,Q1,Q2,Q3: integer;
P1,P2,Cst1,Cst0,Cst100,N1,N2,F,Vekt1,Vekt2,Txt: TObj;
Temp1Att,Temp2Att,Sg1,Sg2,Sg3: integer;
begin
if (E1 is TODuga) and (E2 is TODuga) then
begin
Temp1Att:=E1.FAtt.Lv;
Temp2Att:=E2.FAtt.Lv;
E1.FAtt.Lv:=0;
E2.FAtt.Lv:=0;{}
SV1:=TODuga(E1).Vid; SV2:=TODuga(E2).Vid;
Q1:=-1;
Q2:=-1;
Q3:=1;

EExecD7(E1,E2,Y,OB1,Pnt1,Pnt2,OB2,Pnt3,Pnt4,nAtt,nAtt,nAtt,NAtt,nAtt,nAtt,Q1,Q2,Q3,NIL,NIL,NIL,NIL,NIL,NIL);
TODuga(E1).Vid:=SV1; TODuga(E2).Vid:=SV2;

if OB1 is TOEmpty then OB1.Destroy else
begin
if True {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do
begin
if not TODuga(OB1).Zamkn then
Add(OB1); OB1.Tag:=1;
end else {ликвидация дуги} OB1.Destroy;
end;
if OB2 is TOEmpty then OB2.Destroy else
begin
if True {критерий включения дуги в состав контура} then
with TOKontur(OOO).Spis do
begin
if not TODuga(OB2).Zamkn then
Add(OB2); TODuga(OB2).R.Re:=-TODuga(OB2).R.Re; OB2.Tag:=1{} {OB2.Destroy}
end else {ликвидация дуги} OB2.Destroy;
end;

E1.FAtt.Lv:=Temp1Att;
E2.FAtt.Lv:=Temp2Att;

end;

end; // DugDug

var BBB,RRR: boolean;
begin
BBB:=SysVar.AllowComplex;
SysVar.AllowComplex:=FALSE;

if (X is TOKontur) and (Y is TOChisl) then
begin
if TOKontur(X).Zamkn then
BEGIN
OOO:=TOKontur.Create(Att,OW);
N:=TOKontur(X).Spis.Count - 1;
for I := 0 to TOKontur(X).Spis.Count - 1 do
begin
E:=TOKontur(X).Spis;
if E.Obj='O' then
begin
EExecO7(E,Y,OB,Att0,1,SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
OB.Tag:=0;
end;
if E.Obj='D' then
begin
EExecO7(E,Y,OB,Att0,1,SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
OB.Tag:=0;
TODuga(OB).Vid:=TODuga(E).Vid;
if TODuga(OB).Vid=2 then TODuga(OB).Vid:=0;
end;
end;

{goto fin;}


I:=0;
lab101:;
NN:=I;
RRR:=TOKontur(X).Start(XStart,YStart,I);
if not RRR then goto fin;

Found:=FALSE;
while I<N do
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[I+1];
TOKontur(X).Finish(XEnd,YEnd,I);
if Dist(XStart,YStart,XEnd,YEnd)<Eps then
begin
Found:=TRUE;
if Found then goto lab100;
end;


LineLine(1);
DugLine(1);
LineDug(1);
DugDug;

Inc(I);
end;

// в случае многосвязных контуров замыкание нужно проверять не по первому элементу
lab100:;
{if N>1 then} {при нуле, как было раньше сопряжения дублируются из-за замыкания}
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[NN];

LineLine(1);
DugLine(1);
LineDug(1);
DugDug;
Inc(I);
end;
if I<N then goto lab101;


END;

if not TOKontur(X).Zamkn then
BEGIN
OOO:=TOKontur.Create(Att,OW);
N:=TOKontur(X).Spis.Count - 1;
for I := 0 to TOKontur(X).Spis.Count - 1 do
begin
E:=TOKontur(X).Spis;
if E.Obj='O' then
begin
EExecO7(E,Y,OB,Att0,1,SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
end;
if E.Obj='D' then
begin
EExecO7(E,Y,OB,Att0,1,SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
end;
end;


for I := 0 to TOKontur(X).Spis.Count - 1 do
begin
E:=TOKontur(X).Spis;
if E.Obj='O' then
begin
EExecO7(E,Y,OB,Att0,1,-1*SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
end;
if E.Obj='D' then
begin
EExecO7(E,Y,OB,Att0,1,-1*SG2,NIL);
with TOKontur(OOO).Spis do Add(OB);
end;
end;



N:=TOKontur(X).Spis.Count - 1;
N1:=TOKontur(OOO).Spis.Count - 1;
I:=0;
while I<N do
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[I+1];

LineLine(1);
DugLine(1);
LineDug(1);
DugDug;

Inc(I);
end;
I:=N+1;
while I<N1 do
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[I+1];

LineLine(-1);
DugLine(-1);
LineDug(-1);
DugDug;
Inc(I);
end;

if TOKontur(X).Spis.Count>0 then
begin
R:=TOChisl(Y).C.Re;
if TObj(TOKontur(X).Spis[0]) is TOLine then
begin
Xc:=TOLine(TOKontur(X).Spis[0]).X1.Re;
Yc:=TOLine(TOKontur(X).Spis[0]).Y1.Re;
Xb:=TOLine(TOKontur(OOO).Spis[N+1]).X1.Re;
Yb:=TOLine(TOKontur(OOO).Spis[N+1]).Y1.Re;
Xe:=TOLine(TOKontur(OOO).Spis[0]).X1.Re;
Ye:=TOLine(TOKontur(OOO).Spis[0]).Y1.Re;
end;
if TObj(TOKontur(X).Spis[0]) is TODuga then
begin
Xc:=TODuga(TOKontur(X).Spis[0]).X1;
Yc:=TODuga(TOKontur(X).Spis[0]).Y1;
Xb:=TODuga(TOKontur(OOO).Spis[N+1]).X1;
Yb:=TODuga(TOKontur(OOO).Spis[N+1]).Y1;
Xe:=TODuga(TOKontur(OOO).Spis[0]).X1;
Ye:=TODuga(TOKontur(OOO).Spis[0]).Y1;
end;

OB:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),Xb,Yb,Xe,Ye,0,circ_arc,NAtt,Nil);;
TOKontur(OOO).Spis.Add(OB);

if TObj(TOKontur(X).Spis[N]) is TOLine then
begin
Xc:=TOLine(TOKontur(X).Spis[N]).X2.Re;
Yc:=TOLine(TOKontur(X).Spis[N]).Y2.Re;
Xb:=TOLine(TOKontur(OOO).Spis[N]).X2.Re;
Yb:=TOLine(TOKontur(OOO).Spis[N]).Y2.Re;
Xe:=TOLine(TOKontur(OOO).Spis[N1]).X2.Re;
Ye:=TOLine(TOKontur(OOO).Spis[N1]).Y2.Re;
end;
if TObj(TOKontur(X).Spis[N]) is TODuga then
begin
Xc:=TODuga(TOKontur(X).Spis[N]).X2;
Yc:=TODuga(TOKontur(X).Spis[N]).Y2;
Xe:=TODuga(TOKontur(OOO).Spis[N1]).X2;
Ye:=TODuga(TOKontur(OOO).Spis[N1]).Y2;
Xb:=TODuga(TOKontur(OOO).Spis[N]).X2;
Yb:=TODuga(TOKontur(OOO).Spis[N]).Y2;
end;

OB:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),Xb,Yb,Xe,Ye,0,circ_arc,NAtt,Nil);;
TOKontur(OOO).Spis.Add(OB);
end;

(*
if N>1 then {при нуле, как было раньше сопряжения дублируются из-за замыкания}
begin
E1:=TOKontur(OOO).Spis[N];
E2:=TOKontur(OOO).Spis[0];

LineLine(-1);
DugLine;
LineDug;
DugDug;
end;
*)

END;
{привести контур к последовательному виду}

{TOKontur(OOO).Ordnung(FALSE);}//!!

{нужен тест на повторяющиеся элементы}
{goto fin;}
I:=0; BlockIJ:=FALSE;
while I<= TOKontur(OOO).Spis.Count - 2 do
begin
J:=I+1;
while J<= TOKontur(OOO).Spis.Count - 1 do

begin

E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[J];

{Пересечение двух линейных элементов}
if (E1 is TOLine) and (E2 is TOLine) then
begin
EExecP2(E1,E2,Pnt1,Att5,1,1,NIL);
if not (Pnt1 is TOEmpty) then
begin
if not ((KrajOtr(Pnt1,E1)) or (KrajOtr(Pnt1,E2))) then
begin
A:=TOLine(E1).X1;
B:=TOLine(E1).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+1,Otr1,[zn_Plus]) ;
C:=TOLine(E1).X2;
D:=TOLine(E1).Y2;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+2,Otr1,[zn_Plus]) ;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);


A:=TOLine(E2).X1;
B:=TOLine(E2).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+1,Otr1,[zn_Plus]) ;
C:=TOLine(E2).X2;
D:=TOLine(E2).Y2;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+2,Otr1,[zn_Plus]) ;

E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
end
end;
Pnt1.Destroy;
goto lab200;
end;

{Пересечение прямой и дуги}
if (E1 is TOLine) and (E2 is TODuga) then
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[J];
BlockIJ:=FALSE;
EExecP6(E1,E2,Pnt1,Pnt2,Att5,Att5,1,1,NIL,NIL);

if not (Pnt1 is TOEmpty) then
begin
if not ((KrajOtr(Pnt1,E1)) or (KrajDug(Pnt1,E2))) then
begin
A:=TOLine(E1).X1;
B:=TOLine(E1).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Xc:=TODuga(E2).XC.Re;
Yc:=TODuga(E2).YC.Re;
R:=TODuga(E2).R.Re;
AA:=TODuga(E2).X1;
BB:=TODuga(E2).Y1;
CC:=TODuga(E2).X2;
DD:=TODuga(E2).Y2;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+1,Otr1,[zn_Plus]) ;
C:=TOLine(E1).X2;
D:=TOLine(E1).Y2;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+2,Otr1,[zn_Plus]) ;

E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+1,Dug1,[zn_Plus]) ;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+2,Dug1,[zn_Plus]) ;

E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
BlockIJ:= (Pnt1 is TOPoint) and (Pnt2 is TOPoint);

goto l_od;
end
end;


if not (Pnt2 is TOEmpty) then
begin
if not ((KrajOtr(Pnt2,E1)) or (KrajDug(Pnt2,E2))) then
begin
A:=TOLine(E1).X1;
B:=TOLine(E1).Y1;
C:=TOPoint(Pnt2).X;
D:=TOPoint(Pnt2).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+1,Otr1,[zn_Plus]) ;
C:=TOLine(E1).X2;
D:=TOLine(E1).Y2;
A:=TOPoint(Pnt2).X;
B:=TOPoint(Pnt2).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(I+2,Otr1,[zn_Plus]) ;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

Xc:=TODuga(E2).XC.Re;
Yc:=TODuga(E2).YC.Re;
R:=TODuga(E2).R.Re;
AA:=TODuga(E2).X1;
BB:=TODuga(E2).Y1;
C:=TOPoint(Pnt2).X;
D:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+1,Dug1,[zn_Plus]) ;
CC:=TODuga(E2).X2;
DD:=TODuga(E2).Y2;
A:=TOPoint(Pnt2).X;
B:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+2,Dug1,[zn_Plus]) ;

E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
end
end;
l_od:
Pnt1.Destroy;
Pnt2.Destroy;
goto lab200;
end;

{Пересечение дуги и прямой}
if (E1 is TODuga) and (E2 is TOLine) then {!!!}
begin
E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[J];
BlockIJ:=FALSE;

EExecP6(E2,E1,Pnt1,Pnt2,Att5,Att5,1,1,NIL,NIL);

if not (Pnt1 is TOEmpty) then
begin
if not ((KrajDug(Pnt1,E1)) or (KrajOtr(Pnt1,E2))) then
begin
Xc:=TODuga(E1).XC.Re;
Yc:=TODuga(E1).YC.Re;
R:=TODuga(E1).R.Re;
AA:=TODuga(E1).X1;
BB:=TODuga(E1).Y1;
CC:=TODuga(E1).X2;
DD:=TODuga(E1).Y2;

A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,A.Re,B.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+1,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+2,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

A:=TOLine(E2).X1;
B:=TOLine(E2).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+1,Otr1,[zn_Plus]);
A:=TOLine(E2).X2;
B:=TOLine(E2).Y2;
Otr1:=TOLine.Create(C,D,1,A,B,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+2,Otr1,[zn_Plus]);
E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
BlockIJ:= (Pnt1 is TOPoint) and (Pnt2 is TOPoint);


goto l_do;
end
end;


if not (Pnt2 is TOEmpty) then
begin
if not ((KrajDug(Pnt2,E1)) or (KrajOtr(Pnt2,E2))) then
begin
Xc:=TODuga(E1).XC.Re;
Yc:=TODuga(E1).YC.Re;
R:=TODuga(E1).R.Re;
AA:=TODuga(E1).X1;
BB:=TODuga(E1).Y1;
CC:=TODuga(E1).X2;
DD:=TODuga(E1).Y2;

A:=TOPoint(Pnt2).X;
B:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,A.Re,B.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+1,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+2,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

A:=TOLine(E2).X1;
B:=TOLine(E2).Y1;
C:=TOPoint(Pnt2).X;
D:=TOPoint(Pnt2).Y;
Otr1:=TOLine.Create(A,B,1,C,D,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+1,Otr1,[zn_Plus]);
A:=TOLine(E2).X2;
B:=TOLine(E2).Y2;
Otr1:=TOLine.Create(C,D,1,A,B,1,brn_Limited,Sobstv,Att0,NIL,Ordinal);
TOKontur(OOO).Spis.Insert(J+2,Otr1,[zn_Plus]);
E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
end
end;
l_do:
Pnt1.Destroy;
Pnt2.Destroy;
goto lab200;
end;

{Пересечение двух дуг} {(TODuga(E1).Xc=-220.5) and (TODuga(E2).Xc=-139.5) and (Abs(TODuga(E1).X1+342)<1)}
if (E1 is TODuga) and (E2 is TODuga) then
begin

E1:=TOKontur(OOO).Spis;
E2:=TOKontur(OOO).Spis[J];
if TODuga(E1).Vid=5 then TODuga(E1).Vid:=1;
if TODuga(E2).Vid=5 then TODuga(E2).Vid:=1;
EExecP3(E1,E2,Pnt1,Pnt2,Att5,Att5,1,1,NIL,NIL);
BlockIJ:=FALSE;


if not (Pnt1 is TOEmpty) then
if Assigned(Pnt1) then
begin
if not ((KrajDug(Pnt1,E1)) or (KrajDug(Pnt1,E2))) then
begin
Xc:=TODuga(E1).XC.Re;
Yc:=TODuga(E1).YC.Re;
R:=TODuga(E1).R.Re;
AA:=TODuga(E1).X1;
BB:=TODuga(E1).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+1,Dug1,[zn_Plus]) ;


Dug1.Tag:=E1.Tag;
CC:=TODuga(E1).X2;
DD:=TODuga(E1).Y2;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+2,Dug1,[zn_Plus]) ;


Dug1.Tag:=E1.Tag;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

Xc:=TODuga(E2).XC.Re;
Yc:=TODuga(E2).YC.Re;
R:=TODuga(E2).R.Re;
AA:=TODuga(E2).X1;
BB:=TODuga(E2).Y1;
C:=TOPoint(Pnt1).X;
D:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+1,Dug1,[zn_Plus]) ;


Dug1.Tag:=E2.Tag;
CC:=TODuga(E2).X2;
DD:=TODuga(E2).Y2;
A:=TOPoint(Pnt1).X;
B:=TOPoint(Pnt1).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+2,Dug1,[zn_Plus]) ;


Dug1.Tag:=E2.Tag;

E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
BlockIJ:= (Pnt1 is TOPoint) and (Pnt2 is TOPoint);
goto l_dd;
end;
end;

if not (Pnt2 is TOEmpty) then
if Assigned(Pnt2) then
begin
if not ((KrajDug(Pnt2,E1)) or (KrajDug(Pnt2,E2))) then
begin
Xc:=TODuga(E1).XC.Re;
Yc:=TODuga(E1).YC.Re;
R:=TODuga(E1).R.Re;
AA:=TODuga(E1).X1;
BB:=TODuga(E1).Y1;
C:=TOPoint(Pnt2).X;
D:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+1,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
CC:=TODuga(E1).X2;
DD:=TODuga(E1).Y2;
A:=TOPoint(Pnt2).X;
B:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(I+2,Dug1,[zn_Plus]) ;
Dug1.Tag:=E1.Tag;
E:=TOKontur(OOO).Spis;E.Destroy;
TOKontur(OOO).Spis.Delete(I); Inc(J);

Xc:=TODuga(E2).XC.Re;
Yc:=TODuga(E2).YC.Re;
R:=TODuga(E2).R.Re;
AA:=TODuga(E2).X1;
BB:=TODuga(E2).Y1;
C:=TOPoint(Pnt2).X;
D:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),AA,BB,C.Re,D.Re,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+1,Dug1,[zn_Plus]) ;

Dug1.Tag:=E2.Tag;
CC:=TODuga(E2).X2;
DD:=TODuga(E2).Y2;
A:=TOPoint(Pnt2).X;
B:=TOPoint(Pnt2).Y;
Dug1:=TODuga.Create(MCompl(Xc,0),MCompl(Yc,0),MCompl(R,0),A.Re,B.Re,CC,DD,0,circ_arc,Att0,NIL);
TOKontur(OOO).Spis.Insert(J+2,Dug1,[zn_Plus]) ;
Dug1.Tag:=E2.Tag;

E:=TOKontur(OOO).Spis[J];E.Destroy;
TOKontur(OOO).Spis.Delete(J);
goto l_dd;
end;

end;
l_dd:
if Assigned(Pnt1) then Pnt1.Destroy;
if Assigned(Pnt2) then Pnt2.Destroy;
goto lab200;
end;
lab200:
if not BlockIJ then Inc(J);
end;
if not BlockIJ then Inc(I);
end;
{ goto fin; }

{Тест на средние точки с удалением}
Cst:=TOchisl.Create(MCompl(1.0,0),tc_Constant,NAtt,NIL,c_ord);
if true then
for I := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E1:=TOKontur(OOO).Spis;
{определение средней точки элемента}
if E1 is TOLine then CalcP9_O(E1,MCompl(0.5,0),Xt,Yt,Prizn);
if E1 is TODuga then CalcP9_D(E1,0.5,Xt,Yt,Prizn);

Pnt1:=TOPoint.Create(Xt,Yt,1,0,tp_fixed,Att5,nil);
{TOKontur(OOO).Spis.Add(TOPoint.Create(Xt,Yt,1,0,tp_fixed,Att5,nil));}

for J := 0 to TOKontur(X).Spis.Count - 1 do
begin
{нахождение расстояние от средней точки до элемента исходного контура}
E2:=TOKontur(X).Spis[J];
EExecPF(Pnt1,E2,Pnt2,Att0,1,1,NIL);

{TOKontur(OOO).Spis.Add(TOPoint.Create(TOPoint(Pnt2).X,TOPoint(Pnt2).Y,1,0,tp_fixed,Att5,nil));}

if Pnt2 is TOEmpty then
begin
Continue;
end;

EExecC2(Pnt1,Pnt2,Distance,Att5,1,1,NIL);
{если расстояние меньше, то исключить элемент I}
if (Abs(TOChisl(Distance).C.re)<Abs(TOChisl(Y).C.Re)-Eps)
then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
Break;
end;
Distance.Destroy;
Pnt2.Destroy;
end;
{goto fin;}
if E1.Tag=0 then Continue;

Found:=FALSE;
for J := 0 to TOKontur(X).Spis.Count - 1 do
begin
{нахождение расстояние от средней точки до вершины исходного контура}

E2:=TOKontur(X).Spis[J];
EExecP9(E2,Cst,Pnt2,Att0,1,1,NIL);

{TOKontur(OOO).Spis.Add(TOPoint.Create(TOPoint(Pnt2).X,TOPoint(Pnt2).Y,1,0,tp_fixed,Att5,nil));}

EExecC2(Pnt1,Pnt2,Distance,Att5,1,1,NIL);
{если расстояние меньше, то исключить элемент I}
if (Abs(TOChisl(Distance).C.re)<Abs(TOChisl(Y).C.Re)+Eps)
then
begin
{TOKontur(OOO).Spis.Delete(I);
E1.Destroy;}
Found:=TRUE;
end;
Distance.Destroy;
Pnt2.Destroy;
end;
if not Found then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
end;




Pnt1.Destroy;
end;
Cst.Destroy;
{ goto fin; }


{Тест на крайние точки с удалением}
if TRUE then
for I := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E1:=TOKontur(OOO).Spis;
{определение средней точки элемента}
if E1 is TOLine then CalcP9_O(E1,MCompl(0,0),Xt,Yt,Prizn);
if E1 is TODuga then CalcP9_D(E1,0,Xt,Yt,Prizn);

Pnt1:=TOPoint.Create(Xt,Yt,1,0,tp_fixed,Att5,nil);
{ TOKontur(OOO).Spis.Add(TOPoint.Create(Xt,Yt,1,0,tp_fixed,Att5,nil)); }

for J := 0 to TOKontur(X).Spis.Count - 1 do
begin
{нахождение расстояние от крайней точки до узла исходного контура}
E2:=TOKontur(X).Spis[J];
Cst:=TOchisl.Create(MCompl(J,0),tc_Constant,NAtt,NIL,c_ord);
EExecP9(X,Cst,Pnt2,Att5,1,1,NIL);
Cst.Destroy;
if Pnt2 is TOEmpty then Continue;

EExecC2(Pnt1,Pnt2,Distance,Att5,1,1,NIL);
{если расстояние меньше, то исключить элемент I}
if Abs(TOChisl(Distance).C.re)<Abs(TOChisl(Y).C.Re)-Eps then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
Break;
end;
Distance.Destroy;
Pnt2.Destroy;
end;
Pnt1.Destroy;

end;
{goto fin;}
// Выбираем вершину на исходном контуре, проецируем ее на элемент контура-результата и,
// если расстояние окажется меньше дистанции, то такой элемент удаляем

{Удаление элементов по критерию "от вершин"}
// Вершины исходного контура проецируем на элементы полученного
// Если получится, что расстояние меньше, то элемент удаляем

if TRUE then if TOKontur(X).Spis.Count>0 then
for I := 0 to TOKontur(X).Spis.Count {-1} do // -1 ликвидирована, иначе незамкнутый контур теряет возможность влиять на эквидистанту последней вершиной
begin
CalcP9_W(X,I,Xt,Yt,Prizn);
Pnt1:=TOPoint.Create(Xt,Yt,1,0,tp_fixed,Att5,nil);

for J := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E1:=TOKontur(OOO).Spis[J];
if TODuga(E1).OAtt.LV=2 then TODuga(E1).FAtt.LV:=0;

EExecPF(Pnt1,E1,Pnt2,Att0,1,1,NIL);
if Pnt2 is TOEmpty then
begin
Pnt2.Destroy;
Continue;
end;
EExecC2(Pnt1,Pnt2,Distance,Att5,1,1,NIL);
{если расстояние меньше, то исключить элемент I}
if Abs(TOChisl(Distance).C.re)<Abs(TOChisl(Y).C.Re)-Eps then
begin
TOKontur(OOO).Spis.Delete(J);
E1.Destroy;
end;
Distance.Destroy;
Pnt2.Destroy;
end;
Pnt1.Destroy;
end;
{goto fin;}
{Контроль дублированных элементов}
for I := TOKontur(OOO).Spis.Count - 1 downto 1 do
begin
E1:=TOKontur(OOO).Spis;
for J := I - 1 downto 0 do
begin
E2:=TOKontur(OOO).Spis[J];
if (E1 is TODuga) and (E2 is TODuga) then
begin
if Abs(TODuga(E1).Xc.Re-TODuga(E2).Xc.Re)<Eps then
if Abs(TODuga(E1).Yc.Re-TODuga(E2).Yc.Re)<Eps then
if Abs(TODuga(E1).R.Re+TODuga(E2).R.Re)<Eps then
if Abs(TODuga(E1).X1-TODuga(E2).X2)<Eps then
if Abs(TODuga(E1).Y1-TODuga(E2).Y2)<Eps then
if Abs(TODuga(E1).X2-TODuga(E2).X1)<Eps then
if Abs(TODuga(E1).Y2-TODuga(E2).Y1)<Eps then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
end;
if Abs(TODuga(E1).Xc.Re-TODuga(E2).Xc.re)<Eps then
if Abs(TODuga(E1).Yc.Re-TODuga(E2).Yc.Re)<Eps then
if Abs(TODuga(E1).R.Re-TODuga(E2).R.Re)<Eps then
if Abs(TODuga(E1).X1-TODuga(E2).X1)<Eps then
if Abs(TODuga(E1).Y1-TODuga(E2).Y1)<Eps then
if Abs(TODuga(E1).X2-TODuga(E2).X2)<Eps then
if Abs(TODuga(E1).Y2-TODuga(E2).Y2)<Eps then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
end;
end;
end;

end;

{контроль нулевых объектов}
for I := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E1:=TOKontur(OOO).Spis;
if E1 is TOLine then
begin
if TOLine(E1).IsNull then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
end;
end;
// надо удалять только нулевые дуги, но не окружности
if E1 is TODuga then
begin
if not ((TODuga(E1).Vid=1) or (TODuga(E1).Vid=5)) then if Dist(TODuga(E1).X1,TODuga(E1).Y1,TODuga(E1).X2,TODuga(E1).Y2)<Eps then
begin
TOKontur(OOO).Spis.Delete(I);
E1.Destroy;
end;
end;
end;

{контроль объектов неправильной вложенности}
if TRUE then
Begin
Cst:=TOchisl.Create(MCompl(0.5,0),tc_Constant,NAtt,NIL,c_ord);
for I := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E1:=TOKontur(OOO).Spis;
begin

EExecP9(E1,Cst,Pnt,NAtt,1,1,NIL);

if (not PointInsideContur(PNT,X)) and (TOChisl(Y).C.Re<0) then
begin
{ TOKontur(OOO).Spis.Delete(I);
E1.Destroy;}
end;
Pnt.Destroy;
end;
end;
Cst.Destroy;
End;

{Изъятие "висячих" элементов}
if TRUE then
repeat
Prizn:=FALSE;
for I := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
N1:=0; N2:=0;
E1:=TOKontur(OOO).Spis;
if E1 is TODuga then if (TODuga(E1).Vid=1) or (TODuga(E1).Vid=5) then Continue;


for J := TOKontur(OOO).Spis.Count - 1 downto 0 do
begin
E2:=TOKontur(OOO).Spis[J];
if I<>J then if KrajAny1(E1,E2) then Inc(N1);
if I<>J then if KrajAny2(E1,E2) then Inc(N2);
end;
if (N1<1) or (N2<1) then
begin
Prizn:=TRUE;
E1.Destroy;
TOKontur(OOO).Spis.Delete(I);
end;
end;
until not Prizn;

fin:

{сделать упорядочение контура}
// Временно отключаем ориентацию для прочей отладки

// Сделать тест на взаимопринадлежность исходного контура и полученного
{}TOKontur(OOO).Ordnung(TRUE);{}
TOKontur(OOO).Zamkn:=TRUE;
TOKontur(OOO).L:=TOKontur(OOO).Spis.Count;
if TOKontur(OOO).L=0 then TOKontur(OOO).Zamkn:=FALSE;

TOKontur(OOO).CalcGabarit;
{MySpecObj:=TODuga(TOKontur(OOO).Spis[0]);}

end
else if Att.Chk=1 then if Att.Chk=1 then OOO:=TOEmpty.Create([X,Y],OW,NIL);
Result:=TRUE;
SysVar.AllowComplex:=BBB;

// Признак vid=5 надо внимательно обдумать на предмет его бесконечности
end; // ExecW3

Это мой САПР УП для машин термической резки: https://files.fm/f/de2zbp235
Качайте на здоровье. Он рабочий.
ЭТО видео работы Sapr: https://www.youtube.com/watch?v=Y2c9Otlu_to



Редактировалось 1 раз(а). Последний 03.11.2022 08:20.
Ответить Цитировать
« Следующая тема   Предыдущая тема »
Извините, только зарегистрированные пользователи могут публиковать сообщения в этом форуме.

Кликните здесь, чтобы войти