Построить букву N в 3D (GraphABC) - Паскаль, Turbo Pascal, PascalABC.NET - Страница 2

Serge_Bliznykov · 24.12.2016, 01:09

Цитата:

Сообщение от Fairq

остальные линии получились,а здесь система у меня никак не решается

выложите получившийся код

Fairq · 24.12.2016, 08:45

Код:

uses GraphABC;
var h,w,l,d,b,c,v: integer;
    P:array of point;
begin
d:=150;        
b:=500;        
write('Введите высоту буквы N:  h='); read(h); writeln(h);
write('Введите ширину буквы N:  w='); read(w); writeln(w);
write('Введите длину буквы N:  l='); read(l); writeln(l);
SetWindowSize(800, 660); 

 //h:=300;w:=300;l:=300;

c:=round(sqrt(2)*l/6);    //x
v:=round(sqrt(2)*l/6);    //y

//видимые линии N

SetPenWidth(2);
SetLength(P,10);               //N 2D
P[0].X:=d;                     P[0].Y:=b;
P[1].X:=d ;                    P[1].Y:=b-h;
P[2].X:=d+round(w/3) ;         P[2].Y:=b-h;
P[3].X:=d+2*round(w/3) ;       P[3].Y:=b-round(h/2);
P[4].X:=d+2*round(w/3) ;       P[4].Y:=b-h;
P[5].X:=d+w ;                  P[5].Y:=b-h;
P[6].X:=d+w ;                  P[6].Y:=b;
P[7].X:=d+2*round(w/3) ;       P[7].Y:=b;
P[8].X:=d+round(w/3) ;         P[8].Y:=b-round(h/2);
P[9].X:= d+round(w/3);         P[9].Y:=b;
Polygon(P);


SetLength(P,4);                //N 3D
P[0].X:=d;                     P[0].Y:=b-h;
P[1].X:=d+c;                   P[1].Y:=b-h-v;
P[2].X:=d+round(w/3)+c;        P[2].Y:=b-h-v;
P[3].X:=d+round(w/3);          P[3].Y:=b-h;
Polygon(P);
  SetLength(P,4);
  P[0].X:=d+2*round(w/3);                     P[0].Y:=b-h;
  P[1].X:=d+2*round(w/3)+c;                   P[1].Y:=b-h-v;
  P[2].X:=d+w+c;                              P[2].Y:=b-h-v;
  P[3].X:=d+w;                                P[3].Y:=b-h;
  Polygon(P);
SetLength(P,4);
P[0].X:=d+w;              P[0].Y:=b;
P[1].X:=d+w+c;                P[1].Y:=b-v;
P[2].X:=d+w+c;        P[2].Y:=b-h-v;
P[3].X:=d+w;               P[3].Y:=b-h;
Polygon(P);  

//всегда невидимые линии
SetPenStyle(psDash);SetPenWidth(2);
line(d,b,d+c,b-v);
line(d+c,b-v,d+c,b-h-v);
line(d+c,b-v,d+round(w/3)+c,b-v);   
line(d+2*round(w/3),b,d+2*round(w/3)+c,b-v);
line(d+2*round(w/3)+c,b-v,d+w+c,b-v);
line(d+2*round(w/3)+c,b-v,d+2*round(w/3)+c,b-h-v);


//видимые-невидимые

if (3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)<=b-v  then begin     
Pen.Style:=psSolid;
line(d+round(w/3),b,d+round(w/3)+c,b-v);
end else begin
Pen.Style:=psSolid;
line(d+round(w/3),b,round((c*(9*d*h+6*h*w)+2*v*w*(3*d+w))/(9*c*h+6*v*w)),round((3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)));
 Pen.Style:=psDash;
line(round((c*(9*d*h+6*h*w)+2*v*w*(3*d+w))/(9*c*h+6*v*w)),round((3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)),d+round(w/3)+c,b-v);
end;


if (3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1)>=b-v then begin 
Pen.Style:=psDash; 
line(d+round(w/3)+c,b-v,d+round(w/3)+c,b-v-h); end else begin
Pen.Style:=psSolid;
line(d+round(w/3)+c,b-v,d+round(w/3)+c,round((3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1))); 
Pen.Style:=psDash;
line(d+round(w/3)+c,round((3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1)),d+round(w/3)+c,b-v-h);
end;


end.

evg_m · 26.12.2016, 10:08

Цитата:

Никак не могу найти точку пересечения прямых AB и CD
координаты точек:

Цитата:

Код:

A(d+  w/3 +c; b-h  -v)
B(d+2*w/3 +c; b-h/2-v)
C(d+2*w/3 +c; b-h    ) 
D(d+2*w/3 +c; b-h  -v)

ТРИ из ЭТИХ точек(B;C;D) имеют ОДИНАКОВУЮ x координату и значит лежат на одной вертикали, что в корне противоречит рисунку.
А решением в этом случае будет ОДНА из точек на этой же вертикали(BD) и принадлежащая отрезку (AC) таковой является сама точка C. НО все это нам НЕ НУЖНО, поскольку координаты этой самой точки заданы НЕВЕРНО.

Fairq · 26.12.2016, 13:08

Опечатался.
A(d+w/3 +c;b-h-v)
B(d+2w/3 +c;b-h/2-v)
C(d+2w/3;b-h)
D(d+2w/3 +c;b-h-v)

Serge_Bliznykov · 26.12.2016, 15:08

как Вам такой вариант:

Код:

uses GraphABC;



var h,w,l,d,b,c,v: integer;
    P:array of point;
    CrossPoint : point;


function CrossPointOfLineSegment(x1,y1,x2,y2,x3,y3, x4,y4 : integer) : point;
var a1, a2, a3, a4 : point;
   //x,y:real;
   T : point;
begin
  a1.X:=x1; a1.Y:=y1; a2.X:=x2; a2.Y:=y2; a3.X:=x3; a3.Y:=y3; a4.X:=x4; a4.Y:=y4;
//  Line(x1,y1,x2,y2);
//  Line(x3,y3,x4,y4);
//  x:=-((x1*y2-x2*y1)*(x4-x3)-(x3*x4-x4*y3)*(x2-x1))/((y1-y2)*(x4-x3)-(y3-y4)*(x2-x1));
//  y:=((y3-y4)*(-x)-(x3*y4-x4*y3))/(x4-x3);
//	T.X := trunc(round(x)); T.Y := trunc(round(y));
  T.X := trunc(round(-((a1.x*a2.y-a2.x*a1.y)*(a4.x-a3.x)-(a3.x*a4.y-a4.x*a3.y)*(a2.x-a1.x))/((a1.y-a2.y)*(a4.x-a3.x)-(a3.y-a4.y)*(a2.x-a1.x))));
	T.Y := trunc(round(-(a3.y-a4.y)*T.x-(a3.x*a4.y-a4.x*a3.y))/(a4.x-a3.x));    
	CrossPointOfLineSegment := T
end;
    
begin
d:=150;        
b:=500;
(*
write('Введите высоту буквы N:  h='); read(h); writeln(h);
write('Введите ширину буквы N:  w='); read(w); writeln(w);
write('Введите длину буквы N:  l='); read(l); writeln(l);
*)
h:=150;w:=150;l:=100;
SetWindowSize(800, 660); 

c:=round(sqrt(2)*l/6);    //x
v:=round(sqrt(2)*l/6);    //y

//видимые линии N

SetPenWidth(2);
SetLength(P,10);               //N 2D
P[0].X:=d;                     P[0].Y:=b;
P[1].X:=d ;                    P[1].Y:=b-h;
P[2].X:=d+round(w/3) ;         P[2].Y:=b-h;
P[3].X:=d+2*round(w/3) ;       P[3].Y:=b-round(h/2);
P[4].X:=d+2*round(w/3) ;       P[4].Y:=b-h;
P[5].X:=d+w ;                  P[5].Y:=b-h;
P[6].X:=d+w ;                  P[6].Y:=b;
P[7].X:=d+2*round(w/3) ;       P[7].Y:=b;
P[8].X:=d+round(w/3) ;         P[8].Y:=b-round(h/2);
P[9].X:= d+round(w/3);         P[9].Y:=b;
Polygon(P);

SetLength(P,4);                //N 3D
P[0].X:=d;                     P[0].Y:=b-h;
P[1].X:=d+c;                   P[1].Y:=b-h-v;
P[2].X:=d+round(w/3)+c;        P[2].Y:=b-h-v;
P[3].X:=d+round(w/3);          P[3].Y:=b-h;
Polygon(P);

      

SetLength(P,4);
  P[0].X:=d+2*round(w/3);                     P[0].Y:=b-h;
  P[1].X:=d+2*round(w/3)+c;                   P[1].Y:=b-h-v;
  P[2].X:=d+w+c;                              P[2].Y:=b-h-v;
  P[3].X:=d+w;                                P[3].Y:=b-h;
  Polygon(P);
//PrintPolygon;
  
SetLength(P,4);
P[0].X:=d+w;              P[0].Y:=b;
P[1].X:=d+w+c;                P[1].Y:=b-v;
P[2].X:=d+w+c;        P[2].Y:=b-h-v;
P[3].X:=d+w;               P[3].Y:=b-h;
Polygon(P);  

//всегда невидимые линии
SetPenStyle(psDash);SetPenWidth(2);
line(d,b,d+c,b-v);
line(d+c,b-v,d+c,b-h-v);
line(d+c,b-v,d+round(w/3)+c,b-v);   
line(d+2*round(w/3),b,d+2*round(w/3)+c,b-v);
line(d+2*round(w/3)+c,b-v,d+w+c,b-v);
line(d+2*round(w/3)+c,b-v,d+round(w/3)+c, b-round(h/2)-v);
//line(d+2*round(w/3)+c,b-v,d+2*round(w/3)+c,b-h-v);
line(d+2*round(w/3)+c, b-round(h/2)-v, d+2*round(w/3)+c,b-h-v);

// линия примыкания перекладины к правой "опоре"
Line( d+2*round(w/3), b-round(h/2), d+2*round(w/3)+c, b-round(h/2)-v );
// линия примыкания перекладины к левой "опоре"
Line( d+round(w/3), b-round(h/2), d+round(w/3)+c, b-round(h/2)-v );


//видимые-невидимые

// задняя часть перекладины - это линия от (d+round(w/3)+c, b-h-v) до (d+2*round(w/3)+c, b-round(h/2)-v)
// Line(d+round(w/3)+c, b-h-v, d+2*round(w/3)+c, b-round(h/2)-v);
// найдём пересечение с линией (d+2*round(w/3), b-h) до (d+2*round(w/3)+c, b-h-v)
CrossPoint := CrossPointOfLineSegment(d+round(w/3)+c, b-h-v, d+2*round(w/3)+c, b-round(h/2)-v, 
                           d+2*round(w/3), b-h, d+2*round(w/3)+c, b-h-v);
if CrossPoint.X<(d+2*round(w/3)) then
  // если пересечения нет, то ищем пересечение с 
  //P[3].X:=d+2*round(w/3) ;       P[3].Y:=b-round(h/2);
  //P[4].X:=d+2*round(w/3) ;       P[4].Y:=b-h;
  CrossPoint := CrossPointOfLineSegment( d+2*round(w/3), b-round(h/2), d+2*round(w/3), b-h,
       d+round(w/3)+c, b-h-v, d+2*round(w/3)+c, b-round(h/2)-v);
// выводим видимую часть перекладины       
SetPenStyle(psSolid);
Line(d+round(w/3)+c, b-h-v, CrossPoint.X, CrossPoint.Y);       
// теперь невидимая часть перекладины
SetPenStyle(psDash);
Line(CrossPoint.X, CrossPoint.Y, d+2*round(w/3)+c, b-round(h/2)-v);       
SetPenStyle(psSolid);


if (3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)<=b-v  then begin     
Pen.Style:=psSolid;
line(d+round(w/3),b,d+round(w/3)+c,b-v);
end else begin
Pen.Style:=psSolid;
line(d+round(w/3),b,round((c*(9*d*h+6*h*w)+2*v*w*(3*d+w))/(9*c*h+6*v*w)),round((3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)));
 Pen.Style:=psDash;
line(round((c*(9*d*h+6*h*w)+2*v*w*(3*d+w))/(9*c*h+6*v*w)),round((3*b*c*h+2*b*v*w-h*v*w)/(3*c*h+2*v*w)),d+round(w/3)+c,b-v);
end;


if (3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1)>=b-v then begin 
Pen.Style:=psDash; 
//line(d+round(w/3)+c,b-v,d+round(w/3)+c,b-v-h); 
line(d+round(w/3)+c,b-v, d+round(w/3)+c, b-round(h/2)-v);
end 
else begin
Pen.Style:=psSolid;
line(d+round(w/3)+c,b-v,d+round(w/3)+c,round((3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1))); 
Pen.Style:=psDash;
//line(d+round(w/3)+c,round((3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1)),d+round(w/3)+c,b-v-h);
line(d+round(w/3)+c,round((3*h*d+h*w+3*h*c)/(2*w)+b+h*(-3*d/(2*w)-1)),d+round(w/3)+c, b-round(h/2)-v);
end;


end.

Fairq · 26.12.2016, 17:15

Великолепно! Спасибо большое.

Serge_Bliznykov · 26.12.2016, 17:42

Пожалуйста!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Перенести последнюю букву в начало слова; удалить из слова первую букву	Narsky	Помощь студентам	68	03.07.2016 18:54
В произвольном тексте найти и отпечатать слова, содержащие букву i, но не содержащие букву m	Zeitgesterz	Общие вопросы C/C++	3	09.12.2014 20:52
GraphABC	LittleG	Паскаль, Turbo Pascal, PascalABC.NET	19	26.09.2014 12:00
Pascal ABC. В текстовом русскоязычном файле убрать все слова, начинающиеся на букву «а» и одновременно содержащие букву «о»	MarsLoveMoon	Паскаль, Turbo Pascal, PascalABC.NET	8	25.04.2014 17:03
Разработать две подпрограммы: букву в заглавную и букву в строчную (в т.ч. для русского языка)	makzagdon	Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM	1	25.04.2011 08:53

26.12.2016, 13:08	#14
Fairq Регистрация: 19.12.2016 Сообщений: 8	Опечатался. A(d+w/3 +c;b-h-v) B(d+2w/3 +c;b-h/2-v) C(d+2w/3;b-h) D(d+2w/3 +c;b-h-v)

26.12.2016, 17:15	#16
Fairq Регистрация: 19.12.2016 Сообщений: 8	Великолепно! Спасибо большое.

26.12.2016, 17:42	#17
Serge_Bliznykov Старожил Регистрация: 09.01.2008 Сообщений: 26,229	Пожалуйста!