Calculation of prestressed screw according to ČSN 014010
Delphi & Pascal (česká wiki)
Category: Source in Pascal
Program: Skrutka.pas
File exe: Skrutka.exe
File ubuntu: Skrutka
need: Tabulky.pas
Program: Skrutka.pasFile exe: Skrutka.exe
File ubuntu: Skrutka
need: Tabulky.pas
It seems unbelievable that this program could survive the year 2000. It originated in 1990 when I studied at the secondary school. My best friend, Richard Helmeczy who is exploring Germany nowadays, and I programmed it to make the calculation of measurements of the bias screw easier. Although any CAD system concentrating on machine projecting can do it, the advantage of this program is in its ability to display every single step of the calculation, which is a great help. I found it so when I spent 3 days over the assignment just because I made a mistake at the end of the calculation and the only way how to retrieve it was by going through the task from its very beginning. When I visited my school a few years later in 1998, I found out that Ing. Zmija (to whom I'm sending all my regards) still uses it to check the students assignments. The program was told to contain only one single mistake. For me, the most interesting thing about the program is its romantic understanding of subtracting the values from the graphs.
{ 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.