Umiestnenie súboru www.TrSek.com/pas/skrutka.pas{ SKRUTKA.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program na vypocet predpatej skrutky podla definovanych hodnot. }
{ Uzivatelske prostredie, vypocet s poskytovanim medzivysledkov. }
{ Vyzaduje TABULKY.PAS. Vypocet podla STK2 a Strojnickych tabuliek. }
{ }
{ Datum:04.08.1992 http://www.trsek.com }
program skrutka;
uses crt,dos,trsek,tabulky;
type text1=text;
const
c0=262;d1=294;e=330;f1=350;g=392;a=440;h=492;c1=530;
melodia:array[1..24] of integer=
(f1,e,d1,a,f1,e,d1,a,c0,e,d1,a,c0,e,d1,a,c0,e,d1,e,c0,e,d1,e);
tx:array[1..2,1..7] of integer =
((21,20,11,13,6,9,8),(56,56,37,49,48,44,56));
poz:array[1..2] of integer =(24,60);
vzpa:array[1..6] of integer =(6,8,10,14,16,19);
dtxt:array[1..2,1..3] of string =
(('kN','kN',''),('mm','mm',''));
txt:array[1..2,1..7] of string =
(('F=','Fp=','Dop. cislic=','Zatazenie:',
'Mat. spoj. casti:','Driek skrutky:','Posobisko sily:'),
('Da=','Lk=','pocet stykovych ploch=','Smer sily:','Utahovanie:','Stykova plocha:','CSN'));
text:array[1..2,4..7,1..4] of string =
((('staticke','dynamicke','',''),
('hlinik','siva liatina','ocel tr.11','ocel tr.12'),
('normalny ','zoslabeny','',''),
('A','B','C','D')),
(('v osi','kolmo na os','',''),
('rucne','momen. klucom','mot. skrutkovac',''),
('hladka','hruba','',''),
('021101','021143','021103','021174')));
dlz:array[1..2,1..7] of integer =
((6,6,1,9,12,9,1),(6,6,2,11,15,6,6));
var x,y,xp,yp,i,dld,zacp,vzp,Gd,Gm,dl:integer;
d,Fd,Md,Rp02,Sia,Ku,Kkd,da,Ap,d2,d3,As,fi,k2,dFo,Fomax,Fs:real;
Fk,Mu,Si,Mz,Tk,Sred,Kk,F,p,pd,dFs,Kc,Sa,Fo,Fp:real;
czad:array[1..2,1..8] of real;
tzad:array[1..2,1..8] of string;
dnu,vyp,von,nav,hel,krok:boolean;
s:string;
Lst : text1;
function znak(x,y:integer):char;
var regs:registers;
begin
gotoxy(x,y);
with regs do
begin
bh:=0;
ah:=8;
intr($10,regs);
znak:=chr(al);
end;
end;
procedure tlac;
var s:string;
d:char;
begin
assign(lst,'prn');
rewrite(lst);
s:='';
for y:=2 to 23 do begin
for x:=2 to 78 do begin d:=znak(x,y);
s:=s+d;
end;
{$I-}
writeln(lst,s);s:='';
{$I+}
end;
writeln(lst,' TrSek & RiSOft');
close(lst);
end;
procedure konci;
begin
farba(0,15);
clrscr;
farba(1,15);
write(' Predpata skrutka Copyright (c). software by TRSEK & riSOft Corporation. ');
end;
procedure help;
begin
farba(1,15);
gotoxy(2,10);write(' F -sila, zatazujuca skrutku Fp-sila predpatia medzi skrutka a materialom');
gotoxy(2,11);write(' Lk-vzdialenost od hlavy skrutky po zaskrutkovanu cast (zvycajne 0,2 F)');
gotoxy(2,12);write(' Da-priemer materialu pod hlavou skrutky (napr. puzdro Da=1,5d)');
gotoxy(2,13);write(' Dopl.cislica - doplnkova cislica 0ö9 (4D,5D,5S,6S,8E,8G,10G,10K,11K,12K)');
gotoxy(2,14);write(' Poc. styk. ploch -pocet ploch od hlavy po zaskrutkovanu cast (minimalne 1)');
gotoxy(2,15);write(' zatazenie -sposob zatazenia skrutky material -spojovacich casti');
gotoxy(2,16);write(' driek skrutky - vysokopevnostna (zoslabeny) alebo obycajna(normalny driek)');
gotoxy(2,17);write(' posobisko sily - prevadzkovej sily a) obycajna b) sila posobi priblizne ');
gotoxy(2,18);write(' v rovine hlavy skrutky c) sila posobi medzi hlavou a zaskrutkovanim');
gotoxy(2,19);write(' d) sila posobi az pod zaskrutkovanou castou');
gotoxy(2,20);write(' smer sily - sila posobi v osi alebo kolmo na os CSN -na urcenie dlzky');
gotoxy(2,21);write(' stykova plochy -drsnost stykovych ploch utahovanie -sposob utahovania');
farba(1,14);
gotoxy(2,10);write(' F');gotoxy(33,10);write('Fp');
gotoxy(2,11);write(' Lk');
gotoxy(2,12);write(' Da');
gotoxy(2,13);write(' Dopl.cislica');
gotoxy(2,14);write(' Poc. styk. ploch');
gotoxy(2,15);write(' zatazenie');gotoxy(51,15);write('material');
gotoxy(2,16);write(' driek skrutky');
gotoxy(2,17);write(' posobisko sily');
gotoxy(2,20);write(' smer sily');gotoxy(57,20);write('CSN');
gotoxy(2,21);write(' stykova plocha');gotoxy(49,21);write('utahovanie');
farba(1,15);
end;
function tlacidlo:char;
var s:char;
d:integer;
begin
tlacidlo:=' ';
dnu:=false;
vyp:=false;
hel:=false;
von:=false;
krok:=false;
s:=readkey;
if(s in ['0'..'9']) then begin tlacidlo:=s; dnu:=true; end;
if s=#0 then s:=readkey;
case ord(s) of
72 : y:=y-1;
75 : x:=x-1;
80 : y:=y+1;
77 : x:=x+1;
13 : dnu:=true;
59 : help;
60 : vyp:=true;
61 : begin vyp:=true;krok:=true;end;
62 : nav:=true;
65 : begin tlac;s:=readkey;end;
68 : begin;konci;halt(1);end;
end;
if x<1 then x:=2;
if x>2 then x:=1;
if y<1 then y:=7;
if y>7 then y:=1;
end;
function treada(x,y,d:integer;ch:char):real;
var c1:integer;
c:real;
begin
KurzorZap(True);
s:=tread(x,y,d,'',ch,ch);
KurzorZap(False);
repeat
val(s,c,c1);
if not(c1=0) then begin if length(s)>=c1 then delete(s,c1,1)
else s:='';
end;
until (c1=0) or (s='');
treada:=c;
end;
procedure vymen(x,y:integer);
begin
i:=round(czad[x,y]);i:=i+1;
if (i=5) or (text[x,y,i]='') then begin czad[x,y]:=1;tzad[x,y]:=text[x,y,1];end
else begin czad[x,y]:=i;tzad[x,y]:=text[x,y,i];end;
gotoxy(poz[x],y+1);write(tzad[x,y]);
end;
procedure twrite(x,y:integer;s:string;d:integer);
begin
if length(s)<d then for i:=length(s) to d do s:=s+' ';
if length(s)>d then delete(s,d,length(s)-d);
gotoxy(poz[x],y+1);write(s);
end;
procedure disp;
begin
gotoxy(6,23);write(' F1 -Help F2 -Vypocet F3 -Krok F4 -Navrat F7 -Tlac F10 -Koniec');
end;
procedure uvod;
var a:integer;
begin
textbackground(9);textcolor(15);
kurzorzap(false);
window(1,1,80,25);clrscr;
for a:=2 to 79 do begin gotoxy(a,1);write(chr(205)); end;
for a:=2 to 79 do begin gotoxy(a,24);write(chr(205)); end;
for a:=1 to 23 do begin
gotoxy(1,a);write(chr(179));
gotoxy(79,a);write(chr(179));
end;
gotoxy(1,1);write(chr(213));
gotoxy(79,1);write(chr(184));
gotoxy(1,24);write(chr(212));
gotoxy(79,24);write(chr(190));
gotoxy(1,22);write(chr(195));
for a:=2 to 78 do write(chr(196));
gotoxy(79,22);write(chr(180));
disp;
gotoxy(8,25);
write('Vypocet predpatej skrutky podla R.Kriz a spol. STK I Trsek & RiSOft');
end;
procedure obraz;
var ch:char;
begin
uvod;
farba(1,15);
for i:=1 to 20 do begin
gotoxy(2,1+i);write(' ');
end;
for x:=1 to 2 do for y:=1 to 3 do begin
gotoxy(tx[x,y],y+1);write(txt[x,y]);twrite(x,y,tzad[x,y],dlz[x,y]);
gotoxy(poz[x]+dlz[x,y]+1,y+1);write(dtxt[x,y]);
end;
for x:=1 to 2 do for y:=4 to 7 do begin
gotoxy(tx[x,y],y+1);write(txt[x,y],' ',tzad[x,y]);
end;
x:=1;y:=1;xp:=1;yp:=1;
farba(13,15);
twrite(x,y,tzad[x,y],dlz[x,y]);
repeat
ch:=tlacidlo;
if (dnu=true) and (y<4) then begin
czad[x,y]:=treada(poz[x],y+1,dlz[x,y],ch);
if (y=3) then str(czad[x,y]:2:0,tzad[x,y])
else str(czad[x,y]:6:2,tzad[x,y]);
end;
if (dnu=true) and (y>3) then vymen(x,y);
farba(9,15);
twrite(xp,yp,tzad[xp,yp],dlz[xp,yp]);
farba(13,15);
twrite(x,y,tzad[x,y],dlz[x,y]);
xp:=x;yp:=y;
until vyp ;
end;
procedure chyba;
begin
gotoxy(5,23);
write(' Nemam dalej zadane hodnoty,alebo nastala chyba vypoctu. ');
tlacidlo;
farba(1,15);
disp;
d:=30;nav:=true;
end;
function volbaprie(f,DC:integer):real;
var k,p:integer;
begin
if DC=0 then DC:=-1;
k:=round((DC+1)/2)+1;
if czad[2,4]=2 then p:=3
else if czad[1,4]=1 then p:=1
else p:=2;
for i:=1 to 11 do begin
if d<MetrickeZavity[i,1] then begin
volbaprie:=MetrickeZavity[i,1];
exit;
end;
end;
chyba;
volbaprie:=30;
end;
function dovsila(d:real;DC:integer):real;
begin
for i:=1 to 14 do if d<=tab14[i,1] then begin
dovsila:=tab14[i,pomoc[DC]+1];
exit
end;
end;
procedure zvucka;
var ret:string;
begin
ret:=' ¯ Software by TRSEK & RiSoft® ';
farba(1,15);
for i:=1 to 22 do
begin
sound(melodia[i]);delay(300);
gotoxy(67-i,25);write(copy(ret,1,12+i));
end;
nosound;
end;
function umoment(d:real;dc:integer):real;
begin
for i:=1 to 14 do if d<=tab14[i,1] then begin
umoment:=tab14[i,pomoc[dc]+7];
exit;
end;
end;
function tdef(c,c1,p:integer):integer;
begin
if c=1 then if c1=1 then tdef:=5+p*2
else tdef:=5+p*4
else if c1=1 then tdef:=5+p*4
else tdef:=5+p*8;
end;
function unpevnost(DC:integer;d:real):real;
begin
if d<10 then unpevnost:=tab15[pomoc[dc],3];
if (d>=10) and (d<=16) then unpevnost:=tab15[pomoc[dc],4];
if d>16 then unpevnost:=tab15[pomoc[dc],5];
end;
function pbezpe(d:real):real;
begin
for i:=1 to 8 do
if (tab9[1,i]<=d) and (d<=tab9[1,i+1]) then pbezpe:=tab9[2,i];
end;
function ud2(d:real):real;
begin
for i:=1 to 11 do begin
if metrickezavity[i,1]>=d then begin
ud2:=metrickezavity[i,2];
exit;
end;
end;
end;
function ud3(d:real):real;
begin
for i:=1 to 11 do begin
if metrickezavity[i,1]>=d then begin
ud3:=metrickezavity[i,3];
exit;
end;
end;
end;
function tlak(ut,mat:integer):real;
begin
if ut=2 then ut:=1;
if ut=3 then ut:=2;
tlak:=tab16[mat,ut];
end;
procedure pwrite(h:real;ret:string);
begin
zacp:=zacp+1;
gotoxy(32,zacp);write(h:5:2,' ',ret);
end;
function vyhovuje(x,y:real;ret:string;c:real):boolean;
begin
vzp:=vzp+1;
if c=2 then begin
gotoxy(54,vzpa[vzp]);
if x<y then begin write('<');
gotoxy(45,vzpa[vzp]+1);write(x:5:2,' ',ret);
gotoxy(54,vzpa[vzp]+1);write('< ',y:5:2,' ',ret);
gotoxy(66,vzpa[vzp]+1);write(' Vyhovuje ');
vyhovuje:=true;
end
else begin write('>');
gotoxy(45,vzpa[vzp]+1);write(x:5:2,' ',ret);
gotoxy(54,vzpa[vzp]+1);write('> ',y:5:2,' ',ret);
gotoxy(66,vzpa[vzp]+1);write(' Nevyhovuje ');
vyhovuje:=false;
end;
if krok then begin
repeat
tlacidlo;
until krok or nav;
end;
end;
end;
function nasob(c:real):real;
begin
case round(c) of
1:nasob:=0.5;
2:nasob:=0.7;
3:nasob:=0.5;
4:nasob:=0.3;
end;
end;
function diagram(lk:real;mat,us:integer;d,da:real):real;
var p,p2:integer;
begin
us:=us-1;
p:=round(int(lk/(2*d)));
if mat=4 then mat:=3;
if Da/d<=1.5 then p2:=1;
if ((Da/d)>1.5) and ((Da/d)<=3) then p2:=2;
if Da/d>3 then p2:=3;
if (us=1) and (mat=1) then mat:=3;
if (us=1) and (mat=3) then mat:=1;
diagram:=obr88[p2,p+1,mat+us*3];
end;
function dlzka(d,lk:real):integer;
begin
i:=round(lk+2*d+0.5);
if i<=22 then i:=round(2*int(i/2));
if (i>22) and (i<=80) then i:=round(5*int(i/5));
if (i>80) and (i<=200) then i:=round(10*int(i/10));
if i>200 then i:=round(20*int(i/20));
dlzka:=i;
end;
function podprie(d:real):real;
begin
for i:=1 to 11 do begin
if metrickezavity[i,1]>=d then begin
podprie:=metrickezavity[i,4];
exit;
end;
end;
end;
begin
clrscr;
uvod;
nav:=false;
for x:=1 to 2 do for y:=1 to 3 do begin
tzad[x,y]:='';
czad[x,y]:=0;
end;
for x:=1 to 2 do for y:=4 to 7 do begin
tzad[x,y]:=text[x,y,1];
czad[x,y]:=1;
end;
obraz;
d:=0;
repeat
repeat
repeat
repeat
repeat
repeat
repeat
d:=volbaprie(round(czad[1,1]),round(czad[1,3]));
Fd:=dovsila(d,round(czad[1,3]))*1000;
Md:=umoment(d,round(czad[1,3]));
dld:=tdef(round(czad[2,4]),round(czad[2,6]),round(czad[2,3]));
Rp02:=tab10[3,round(czad[1,3])+1];
Sia:=unpevnost(round(czad[1,3]),d);
Ku:=tab13[round(czad[2,5])];
Kkd:=pbezpe(d);
da:=podprie(d);
fi:=diagram(czad[2,2],round(czad[1,5]),round(czad[1,6]),d,czad[2,1])*nasob(czad[1,7]);
k2:=(1/obr90(round(czad[2,2]),round(d),round(czad[2,1]),round(czad[1,5])))*10000;
pd:=tlak(round(czad[2,5]),round(czad[1,5]));
Fp:=czad[1,2]*1000;
F:=czad[1,1]*1000;
farba(1,15);
Zaver;
if czad[1,4]=1 then begin gotoxy(2,18);write(' ');
for i:=1 to 3 do begin
gotoxy(2,18+i);
write(' ');
end;
end;
gotoxy(14,2);write(F/1000:5:2,' kN');
gotoxy(14,3);write(Fp/1000:5:2,' kN');
gotoxy(14,4);write(d:5:0,' mm');
gotoxy(14,5);write(Fd/1000:5:1,' kN');
gotoxy(33,2);write(dld);
gotoxy(33,5);write(Md:5:1,' Nm');
gotoxy(56,2);write(Rp02:4:0,' MPa');
gotoxy(57,4);write(Ku:2:1);
gotoxy(57,5);write(pd:2:1,'MPa');
gotoxy(33,3);write(fi:4:3);
gotoxy(68,14);write(Kkd:5:2);
d2:=ud2(d);
d3:=ud3(d);
As:=3.14/16*(d2+d3)*(d2+d3);
gotoxy(57,3);write(as:5:2,' mmý');
gotoxy(33,4);write(k2:6:2,' mm/N');
zacp:=5;vzp:=0;
dFo:=dld*fi*k2;
pwrite(dFo/1000,'kN');
Fomax:=ku*(Fp+(1-fi)*F+dFo);
pwrite(Fomax/1000,'kN');
until vyhovuje(Fomax/1000,Fd/1000,'kN',2) or nav;
Fs:=Fomax+(F*fi);
pwrite(Fs/1000,'kN');
Fk:=As*Rp02;
pwrite(Fk/1000,'kN');
until vyhovuje(Fs/1000,Fk/1000,'kN',2) or nav;
Mu:=0.18*Fomax*d;
pwrite(Mu/1000,'Nm');
until vyhovuje(Mu/1000,Md,'Nm',2) or nav;
Si:=Fomax/As;
pwrite(Si,' MPa');
Mz:=0.12*Fomax*d;
pwrite(Mz/1000,'Nm');
Tk:=Mz/(0.2*d3*d3*d3);
pwrite(Tk,'MPa');
Sred:=sqrt((si*si)+(3*tk*tk));
pwrite(Sred,'MPa');
Kk:=Rp02/Sred;
pwrite(Kk,'');
until vyhovuje(Kkd,Kk,'',2) or nav;
Ap:=(Pi*(da*da-1.21*d*d))/4;
pwrite(Ap,'mmý');
p:=Fs/Ap;
pwrite(p,'MPa');
until vyhovuje(p,pd,'MPa',2) or nav;
if czad[1,4]=2 then begin dFs:=fi*F;
pwrite(dFs/1000,'kN');
Sa:=dFs/(2*As);
pwrite(sa,'MPa');
if sa=0 then Kc:=10
else Kc:=Sia/Sa;
pwrite(Sia,'MPa');
pwrite(Kc,'');
end;
until (vyhovuje(1.4,Kc,'',czad[1,4])) or nav;
if czad[1,4]=1 then begin gotoxy(2,18);write(' ');
for i:=1 to 3 do begin
gotoxy(2,18+i);
write(' ');
end;
end;
gotoxy(3,23);
dl:=dlzka(d,czad[2,2]);
write(' Navrhujem : Skrutka M ',d:2:0,' * ',dl,' CSN ',
text[2,7,round(czad[2,7])],'.',czad[1,3]:1:0,' ');
tlacidlo;
if nav then begin disp;obraz;nav:=false;d:=0;end;
until von;
konci;
end.