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

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: Programy v Pascale
skrutka.pngProgram: Skrutka.pas
Súbor exe: Skrutka.exe
Súbor ubuntu: Skrutka
Potrebné: Tabulky.pas

Tak to už ani nieje pravda že tento program prežil rok 2000. Vznikol ešte na strednej škole. V 1990 som ho naprogramoval so svojím najlepším kamarátom dnes už Ing. Richardom Helmeczym. Program vypočíta rozmery predpätej skrutky. Dnes už to dokáže každý CADovský systém zameraný na strojné projektovanie, ale toto Vám vypíše každý krok výpočtu a to je teda pomoc. Sám viem že zadanie mi trvalo 3 dni len kvôli tomu, že na konci výpočtu som zistil chybu a musel som začať znova. Najzaujímavejšie je romantické chápanie odčítavanie hodnôt z grafov.
{ 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.