home *** CD-ROM | disk | FTP | other *** search
Wrap
Procedure Keyways; { ⌐1997, Diehl Graphsoft, Inc. Developed by Tom Urie This program draws a shaft or hub with a standard keyway. The procedure determines the proper keyway per ANSI B17.1 (for inch sizes) or BS 4235:Part 1:1972 (for mm sizes). It also allows the user to change the size of the keyway, if desired. The keyway drawn is the theoretical size without any clearance. } LABEL 90,99; VAR d,h,hr,w,x0,y0,Alpha,Theta,q1,q2,q3 : REAL; d_act,h_act,w_act : REAL; x,y,R : ARRAY[1..10] OF REAL; k,KeyType,KwyType,RFlag1,RFlag2 : INTEGER; Abort,Inch,OK,NextClick,CenterMark : BOOLEAN; sf,UPI : REAL; Fmt : INTEGER; UM,UM2 : STRING; UName,DA : LONGINT; Procedure KeyDialog; { This procedure creates the dialog boxes. } VAR Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER; Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER); VAR scrx1,scry1,scrx2,scry2:INTEGER; BEGIN GetScreen(scrx1,scry1,scrx2,scry2); x1:=((scrx1+scrx2) div 2)-(Width div 2); x2:=x1+Width; END; Procedure LocateButtons(DialogType,scnh,scnw : INTEGER); { This procedure locates the 'OK' and 'Cancel' buttons. } VAR v1,v2,v3,v4 : INTEGER; Mac : BOOLEAN; Procedure Swap(VAR m1,m2,m3,m4 : INTEGER); VAR Temp : INTEGER; BEGIN Temp:=m1; m1:=m3; m3:=Temp; Temp:=m2; m2:=m4; m4:=Temp; END; {of Swap} BEGIN Mac:=FALSE; GetVersion(v1,v2,v3,v4); IF v4 = 1 THEN Mac:=TRUE; IF DialogType = 1 THEN BEGIN px1:=(scnw DIV 2) - 80; px2:=(scnw DIV 2) - 10; px3:=(scnw DIV 2) + 10; px4:=(scnw DIV 2) + 80; IF Mac THEN SWAP(px1,px2,px3,px4); py1:=scnh-40; py2:=scnh-20; py3:=py1; py4:=py2; END ELSE IF DialogType = 2 THEN BEGIN px1:=scnw - 180; px2:=scnw - 110; px3:=scnw - 90; px4:=scnw - 20; IF Mac THEN SWAP(px1,px2,px3,px4); py1:=scnh-40; py2:=scnh-20; py3:=py1; py4:=py2; END ELSE BEGIN px1:=scnw - 90; px2:=scnw - 20; px3:=px1; px4:=px2; py1:=scnh -70; py2:=scnh - 50; py3:=scnh - 40; py4:=scnh - 20; IF Mac THEN SWAP(py1,py2,py3,py4); END; END; {of Locate Buttons} Procedure MakeDialog; { This procedure defines the main dialog box. } CONST y1=100; scnw = 275; scnh = 320; DialogType = 3; VAR h,h0,m : INTEGER; BEGIN h0:=0; AlignScr(scnw,x1,x2); y2:=y1+scnh; LocateButtons(DialogType,scnh,scnw); BeginDialog(1,1,x1,y1,x2,y2); AddButton('OK',1,1,px1,py1,px2,py2); AddButton('Cancel',2,1,px3,py3,px4,py4); h:=h0; AddField('Units:',22,1,20,9+h,60,25+h); AddButton('Inch',23,3,65,10+h,115,25+h); AddButton('mm',24,3,120,10+h,165,25+h); h:=h0-10; AddField('Shaft Diameter (in.):',5,1,20,44+h,170,60+h); AddField('',6,2,175,45+h,245,60+h); h:=h0-10; AddField('Type of Key:',14,1,20,69+h,200,85+h); AddButton('Square',15,3,20,90+h,90,105+h); AddButton('Rectangular',16,3,20,110+h,120,125+h); AddField('Type of Keyway:',17,1,145,69+h,260,85+h); AddButton('Hub',18,3,145,90+h,190,105+h); AddButton('Shaft',19,3,145,110+h,200,125+h); AddField('',25,1,20,135+h,280,150+h); AddField('',26,2,60,160+h,130,175+h); AddField('x',27,1,140,159+h,150,175+h); AddField('',28,2,160,160+h,230,175+h); m:=215; h:=h0-40; AddField('Location:',7,1,20,m+h-1,130,m+15+h); AddField('X:',8,1,20,m+25+h-1,50,m+40+h); AddField('',9,2,55,m+25+h,155,m+40+h); AddField('Y:',10,1,20,m+50+h-1,50,m+65+h); AddField('',11,2,55,m+50+h,155,m+65+h); AddButton('Next Click',12,3,20,m+75+h,120,m+90+h); AddButton('Show Center Mark',13,2,20,m+105+h,170,m+120+h); EndDialog; END; BEGIN MakeDialog; END; Procedure KeySizeInch(ShaftDia : REAL; VAR kw,khr : REAL); { This procedure receives the shaft diameter in inches and determines the recommended key size. } LABEL 99; CONST NSizes=22; Min=0.3125; VAR NomDia,w,hr : ARRAY[1..NSizes] OF REAL; i : INTEGER; BEGIN NomDia[1]:=7/16; w[1]:=3/32; hr[1]:=3/32; NomDia[2]:=9/16; w[2]:=1/8; hr[2]:=3/32; NomDia[3]:=7/8; w[3]:=3/16; hr[3]:=1/8; NomDia[4]:=1.25; w[4]:=1/4; hr[4]:=3/16; NomDia[5]:=1.375;w[5]:=5/16; hr[5]:=1/4; NomDia[6]:=1.75; w[6]:=3/8; hr[6]:=1/4; NomDia[7]:=2.25; w[7]:=1/2; hr[7]:=3/8; NomDia[8]:=2.75; w[8]:=5/8; hr[8]:=7/16; NomDia[9]:=3.25; w[9]:=3/4; hr[9]:=1/2; NomDia[10]:=3.75;w[10]:=7/8; hr[10]:=5/8; NomDia[11]:=4.5; w[11]:=1; hr[11]:=3/4; NomDia[12]:=5.5; w[12]:=1.25; hr[12]:=7/8; NomDia[13]:=6.5; w[13]:=1.5; hr[13]:=1; NomDia[14]:=7.5; w[14]:=1.75; hr[14]:=1.5; NomDia[15]:=9; w[15]:=2; hr[15]:=1.5; NomDia[16]:=11; w[16]:=2.5; hr[16]:=1.75; NomDia[17]:=13; w[17]:=3; hr[17]:=2; NomDia[18]:=15; w[18]:=3.5; hr[18]:=2.5; NomDia[19]:=18; w[19]:=4; hr[19]:=3; NomDia[20]:=22; w[20]:=5; hr[20]:=3.5; NomDia[21]:=26; w[21]:=6; hr[21]:=4; NomDia[22]:=30; w[22]:=7; hr[22]:=5; IF ShaftDia <= Min THEN BEGIN kw:=0; khr:=0; GOTO 99; END; FOR i:=1 TO NSizes-1 DO BEGIN IF ShaftDia <= NomDia[i] THEN BEGIN kw:=w[i]; khr:=hr[i]; GOTO 99; END; END; kw:=w[NSizes]; khr:=hr[NSizes]; 99:END; Procedure KeySizeMM(ShaftDia : REAL; VAR kw,khr : REAL); { This procedure receives the shaft diameter in millimeters and determines the recommended key size. } LABEL 99; CONST NSizes=26; Min=6; VAR NomDia,w,hr : ARRAY[1..26] OF REAL; i : INTEGER; BEGIN NomDia[1]:=8; w[1]:=2; hr[1]:=2; NomDia[2]:=10; w[2]:=3; hr[2]:=3; NomDia[3]:=12; w[3]:=4; hr[3]:=4; NomDia[4]:=17; w[4]:=5; hr[4]:=5; NomDia[5]:=22; w[5]:=6; hr[5]:=6; NomDia[6]:=30; w[6]:=8; hr[6]:=7; NomDia[7]:=38; w[7]:=10; hr[7]:=8; NomDia[8]:=44; w[8]:=12; hr[8]:=8; NomDia[9]:=50; w[9]:=14; hr[9]:=9; NomDia[10]:=58; w[10]:=16; hr[10]:=10; NomDia[11]:=65; w[11]:=18; hr[11]:=11; NomDia[12]:=75; w[12]:=20; hr[12]:=12; NomDia[13]:=85; w[13]:=22; hr[13]:=14; NomDia[14]:=95; w[14]:=25; hr[14]:=14; NomDia[15]:=110; w[15]:=28; hr[15]:=16; NomDia[16]:=130; w[16]:=32; hr[16]:=18; NomDia[17]:=150; w[17]:=36; hr[17]:=20; NomDia[18]:=170; w[18]:=40; hr[18]:=22; NomDia[19]:=200; w[19]:=45; hr[19]:=25; NomDia[20]:=230; w[20]:=50; hr[20]:=28; NomDia[21]:=260; w[21]:=56; hr[21]:=32; NomDia[22]:=290; w[22]:=63; hr[22]:=32; NomDia[23]:=330; w[23]:=70; hr[23]:=36; NomDia[24]:=380; w[24]:=80; hr[24]:=40; NomDia[25]:=440; w[25]:=90; hr[25]:=45; NomDia[26]:=500; w[26]:=100; hr[26]:=50; IF ShaftDia <= Min THEN BEGIN kw:=0; khr:=0; GOTO 99; END; FOR i:=1 TO NSizes-1 DO BEGIN IF ShaftDia <= NomDia[i] THEN BEGIN kw:=w[i]; khr:=hr[i]; GOTO 99; END; END; kw:=w[NSizes]; khr:=hr[NSizes]; 99:END; Procedure GetInfo; { This procedure displays the main dialog box and retrieves the information. } LABEL 5,10,20,30,99; VAR Item,NTimes : INTEGER; RFlag : ARRAY[1..3] OF INTEGER; Done : BOOLEAN; Procedure SetRButton(i,Item : INTEGER); BEGIN IF RFlag[i] <> Item THEN BEGIN SetItem(RFlag[i],FALSE); SetItem(Item,TRUE); RFlag[i]:=Item; END; END; BEGIN Done:=FALSE; Abort:=FALSE; NTimes:=Ntimes+1; IF NTimes>1 THEN GOTO 5; Inch:=TRUE; sf:=1.00; NextClick:=TRUE; CenterMark:=FALSE; KeyType:=1; KwyType:=1; RFlag[1]:=15; RFlag[2]:=18; RFlag[3]:=23; 5:GetDialog(1); SetTitle('Keyways'); SetItem(12,NextClick); SetItem(13,CenterMark); SetItem(RFlag[1],TRUE); SetItem(RFlag[2],TRUE); SetItem(RFlag[3],TRUE); SetField(6,Num2StrF(d_act)); SetField(26,Num2StrF(w_act)); SetField(28,Num2StrF(h_act)); IF Inch THEN BEGIN SetField(5,'Shaft Diameter (in.):'); SetField(25,'Nominal Key Size [width x height] (in.):'); END ELSE BEGIN SetField(5,'Shaft Diameter (mm):'); SetField(25,'Nominal Key Size [width x height] (mm):'); END; IF NextClick THEN BEGIN SetField(9,''); SetField(11,''); END ELSE BEGIN SetField(9,Num2StrF(x0)); SetField(11,Num2StrF(y0)); END; SelField(6); 10:REPEAT DialogEvent(Item); IF Item=1 THEN Done:=TRUE; IF Item=2 THEN BEGIN Done:=TRUE; Abort:=TRUE; END; IF Item=6 THEN BEGIN OK:=ValidNumStr(GetField(6),d); IF Inch THEN KeySizeInch(d,w,hr) ELSE KeySizeMM(d,w,hr); IF KeyType=2 THEN h:=hr ELSE h:=w; SetField(26,Num2StrF(w)); SetField(28,Num2StrF(h)); END; IF Item=9 THEN BEGIN IF NextClick THEN BEGIN NextClick:=FALSE; SetItem(12,FALSE); SetField(9,Num2StrF(x0)); SetField(11,Num2StrF(y0)); SelField(9); END; END; IF Item=11 THEN BEGIN IF NextClick THEN BEGIN NextClick:=FALSE; SetItem(12,FALSE); SetField(9,Num2StrF(x0)); SetField(11,Num2StrF(y0)); SelField(9); END; END; IF Item=12 THEN BEGIN IF NOT NextClick THEN BEGIN NextClick:=TRUE; SetItem(12,TRUE); SetField(9,''); SetField(11,''); SelField(6); END ELSE BEGIN NextClick:=FALSE; SetItem(12,FALSE); SetField(9,Num2StrF(x0)); SetField(11,Num2StrF(y0)); SelField(9); END; END; IF Item=13 THEN BEGIN CenterMark:=NOT CenterMark; SetItem(13,CenterMark); END; IF (Item>14) AND (Item<17) THEN BEGIN SetRButton(1,Item); KeyType:=Item-14; OK:=ValidNumStr(GetField(6),d); IF Inch THEN KeySizeInch(d,w,hr) ELSE KeySizeMM(d,w,hr); IF KeyType=2 THEN h:=hr ELSE h:=w; SetField(28,Num2StrF(h)); END; IF (Item>17) AND (Item<20) THEN BEGIN SetRButton(2,Item); KwyType:=Item-17; END; IF (Item=23) AND (NOT Inch) THEN BEGIN SetRButton(3,Item); Inch:=TRUE; SetField(5,'Shaft Diameter (in.):'); SetField(25,'Nominal key size [width x height] (in.):'); OK:=ValidNumStr(GetField(6),d); IF Inch THEN KeySizeInch(d,w,hr) ELSE KeySizeMM(d,w,hr); IF KeyType=2 THEN h:=hr ELSE h:=w; SetField(26,Num2StrF(w)); SetField(28,Num2StrF(h)); END; IF (Item=24) AND (Inch) THEN BEGIN SetRButton(3,Item); Inch:=FALSE; SetField(5,'Shaft Diameter (mm):'); SetField(25,'Nominal key size [width x height] (mm):'); OK:=ValidNumStr(GetField(6),d); IF Inch THEN KeySizeInch(d,w,hr) ELSE KeySizeMM(d,w,hr); IF KeyType=2 THEN h:=hr ELSE h:=w; SetField(26,Num2StrF(w)); SetField(28,Num2StrF(h)); END; UNTIL Done; IF Abort THEN GOTO 99; OK:=ValidNumStr(GetField(6),d); IF d<=0 THEN BEGIN SysBeep; Done:=FALSE; SelField(6); GOTO 10; END; OK:=ValidNumStr(GetField(9),x0); OK:=ValidNumStr(GetField(11),y0); OK:=ValidNumStr(GetField(26),w); OK:=ValidNumStr(GetField(28),h); ClrDialog; 99:END; Procedure CMark(Dia,x,y,sf : REAL); { This procedure draws a centermark. } CONST k1c=0.25; k2c=0.125; k3c=0.0625; VAR k1,k2,k3,L1,L2 : REAL; BEGIN k1:=k1c*sf; k2:=k2c*sf; k3:=k3c*sf; PushAttrs; PenPat(2); PenSize(5); L1:=k1; IF L1 > Dia/2 THEN L1:=0.5*Dia; L2:=Dia/2 + k2 - k3 - L1/2; Absolute; MoveTo(x,y); Relative; Move(-(Dia/2+k2),0); Line(L2,0); Move(k3,0); Line(L1,0); Move(k3,0); Line(L2,0); Absolute; MoveTo(x,y); Relative; Move(0,-(Dia/2+k2)); Line(0,L2); Move(0,k3); Line(0,L1); Move(0,k3); Line(0,L2+h/2); PopAttrs; END; { Main program. } BEGIN DSelectAll; KeyDialog; SetCursor(ArrowC); { Get information from the dialog boxes. } GetInfo; IF Abort THEN GOTO 99; { Get drawing units and adjust parameters. } GetUnits(UName,DA,Fmt,UPI,UM,UM2); IF Inch THEN sf:=UPI ELSE sf:=UPI/25.4; d_act:=d; w_act:=w; h_act:=h; d:=d*sf; w:=w*sf; h:=h*sf; { If next click was chosen, get center. } IF NextClick THEN GetPt(x0,y0); { Calculate variables needed to draw keyway; if keyway size=0 draw a circle; } IF w=0 THEN BEGIN Absolute; MoveTo(x0,y0); Relative; Arc(-d/2,d/2,d/2,-d/2,0,360); GOTO 90; END; Alpha:=ArcSin(w/d); Theta:=(Pi/2-Alpha)/2; q1:=d*Cos(Alpha)/2; q2:=d*Tan(Theta)/2; IF KwyType=1 THEN q3:=q1+h/2 ELSE q3:=q1-h/2; x[1]:=-w/2; y[1]:=q3; R[1]:=0; x[2]:=-w/2; y[2]:=q1; R[2]:=0; x[3]:=-d/2; y[3]:=q2; R[3]:=d/2; x[4]:=-d/2; y[4]:=0; R[4]:=0; x[5]:=-d/2; y[5]:=-d/2; R[5]:=d/2; FOR k:=6 TO 10 DO BEGIN x[k]:=-x[11-k]; y[k]:=y[11-k]; R[k]:=R[11-k]; END; { Draw keyway and shaft or hub. } Absolute; MoveTo(x0-d/2,y0); ClosePoly; BeginPoly; FOR k:=1 TO 10 DO BEGIN IF R[k]=0 THEN LineTo(x0+x[k], y0+y[k]) ELSE ArcTo(x0+x[k], y0+y[k], R[k]); END; EndPoly; 90:IF CenterMark THEN BEGIN CMark(d,x0,y0,sf); Group; END; 99:END; RUN(Keyways);