Výpočet parametrov predpätej skrutky podľa ČSN 014010

{ 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;
 
procedure zaver;
begin
  gotoxy(2,2);write('         F=               *ld=                   Rp02=                      ');
  gotoxy(2,3);write('        Fp=                 í=                     As=                      ');
  gotoxy(2,4);write('         d=                k2=                     Ku=                      ');
  gotoxy(2,5);write('        Fd=                Md=                     pd=                      ');
  gotoxy(2,6);write('                 *Fo=*ldůíůk2=                Fomax   Fd                    ');
  gotoxy(2,7);write('      Fomax=ku[Fp+(1-í)F+*Fo]=                                              ');
  gotoxy(2,8);write('                 Fs=Fomax+íůF=                   Fs   Fk                    ');
  gotoxy(2,9);write('                   Fk=As.Rp02=                                              ');
 gotoxy(2,10);write('              Mu=0.18ůFomaxůd=                   Mu   Md                    ');
 gotoxy(2,11);write('                   ë=Fomax/As=                                              ');
 gotoxy(2,12);write('              Mz=0.12ůFomaxůd=                                              ');
 gotoxy(2,13);write('           âk=Mz/(0.2ů(d3)^3)=                                              ');
 gotoxy(2,14);write('               ëred=űëý+3ůâký=                  Kkd   Kk      Kkd=          ');
 gotoxy(2,15);write('                 Kk=Rp02/ëred=                                              ');
 gotoxy(2,16);write('                Ap=Źă(daý-Dý)=                    p   pd                    ');
 gotoxy(2,17);write('                      p=Fs/Ap=                                              ');
 gotoxy(2,18);write('     Dyn. namahane:   *Fs=íůF=                                              ');
 gotoxy(2,19);write('                 ńëa=*Fs/2ůAs=                  Kcd   Kc      Kcd=1.4ö4     ');
 gotoxy(2,20);write('                           ëA=                                              ');
 gotoxy(2,21);write('                     Kc=ëA/ëa=                                              ');
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.