{ 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 09 (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 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=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'); 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.