home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / BEARINGS.MPC < prev    next >
Text File  |  1997-04-24  |  59KB  |  3,138 lines
  1. Procedure Bearings;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure draws various types of bearings.
  7. }
  8. LABEL 99;
  9.  
  10. VAR
  11.     Type : INTEGER;
  12.     Abort : BOOLEAN;
  13.  
  14. Procedure MainDialog;
  15. {
  16. This procedure defines the main dialog box.
  17. }
  18. VAR
  19.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  20.  
  21. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  22. VAR
  23.     scrx1,scry1,scrx2,scry2:INTEGER;
  24.  
  25. BEGIN
  26.     GetScreen(scrx1,scry1,scrx2,scry2);
  27.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  28.     x2:=x1+Width; 
  29. END;
  30.  
  31. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  32. {
  33. This procedure locates the 'OK' and 'Cancel' buttons.
  34. }
  35. VAR
  36.     v1,v2,v3,v4 : INTEGER;
  37.     Mac : BOOLEAN;
  38.  
  39. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  40. VAR
  41.     Temp : INTEGER;
  42. BEGIN
  43.     Temp:=m1;
  44.     m1:=m3;
  45.     m3:=Temp;
  46.     Temp:=m2;
  47.     m2:=m4;
  48.     m4:=Temp;
  49. END;        {of Swap}
  50.  
  51. BEGIN
  52.     Mac:=FALSE;
  53.     GetVersion(v1,v2,v3,v4);
  54.     IF v4 = 1 THEN Mac:=TRUE;
  55.  
  56.     IF DialogType = 1 THEN
  57.     BEGIN
  58.         px1:=(scnw DIV 2) - 80;
  59.         px2:=(scnw DIV 2) - 10;
  60.         px3:=(scnw DIV 2) + 10;
  61.         px4:=(scnw DIV 2) + 80;
  62.         IF Mac THEN SWAP(px1,px2,px3,px4);
  63.  
  64.         py1:=scnh-40;
  65.         py2:=scnh-20;
  66.         py3:=py1;
  67.         py4:=py2;
  68.     END ELSE IF DialogType = 2 THEN
  69.     BEGIN
  70.         px1:=scnw - 180;
  71.         px2:=scnw - 110;
  72.         px3:=scnw - 90;
  73.         px4:=scnw - 20;
  74.         IF Mac THEN SWAP(px1,px2,px3,px4);
  75.  
  76.         py1:=scnh-40;
  77.         py2:=scnh-20;
  78.         py3:=py1;
  79.         py4:=py2;
  80.     END ELSE
  81.     BEGIN
  82.         px1:=scnw - 90;
  83.         px2:=scnw - 20;
  84.         px3:=px1;
  85.         px4:=px2;
  86.  
  87.         py1:=scnh -70;
  88.         py2:=scnh - 50;
  89.         py3:=scnh - 40;
  90.         py4:=scnh - 20;
  91.         IF Mac THEN SWAP(py1,py2,py3,py4);
  92.     END;
  93. END;        {of Locate Buttons}
  94.  
  95. Procedure MakeDialog6;
  96.  
  97. CONST
  98.     y1=100;
  99.     scnw = 250;
  100.     scnh = 200;
  101.     DialogType = 1;
  102.  
  103. VAR
  104.     h : INTEGER;
  105.  
  106. BEGIN
  107.     AlignScr(scnw,x1,x2);
  108.     y2:=y1+scnh;
  109.     LocateButtons(DialogType,scnh,scnw);
  110.  
  111.     BeginDialog(6,1,x1,y1,x2,y2);
  112.         AddButton('OK',1,1,px1,py1,px2,py2);
  113.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  114.  
  115.         h:=-30;
  116.         AddField('Type of Bearing:',4,1,20,39+h,195,55+h);
  117.         AddButton('Ball Bearing',5,3,20,65+h,220,80+h);    
  118.         AddButton('Cylindrical Roller Bearing',6,3,20,85+h,220,100+h);
  119.         AddButton('Tapered Roller Bearing',7,3,20,105+h,220,120+h);
  120.         AddButton('Thrust Bearing',8,3,20,125+h,220,140+h);
  121.         {AddButton('Needle Bearing',9,3,20,145+h,220,160+h);}
  122.     EndDialog;
  123. END;
  124.  
  125. BEGIN
  126.     MakeDialog6;
  127. END;
  128.  
  129. Procedure GetInfo1;
  130. {
  131. This procedure displays the main dialog box and retrieves the information.
  132. }
  133. VAR
  134.     Item:INTEGER;
  135.     RFlag : ARRAY[1..2] OF INTEGER;
  136.     Done:BOOLEAN;
  137.  
  138. Procedure SetRButton(i,Item : INTEGER);
  139. BEGIN
  140.     IF RFlag[i] <> Item THEN BEGIN
  141.         SetItem(RFlag[i],FALSE);
  142.         SetItem(Item,TRUE);
  143.         RFlag[i]:=Item;
  144.     END;
  145. END;
  146.  
  147. BEGIN
  148.     Done:=FALSE;
  149.     Abort:=FALSE;
  150.     Type:=1;
  151.     RFlag[1]:=5;
  152.     GetDialog(6);
  153.     SetTitle('Bearings');
  154.     SetItem(RFlag[1],TRUE);
  155.  
  156.     REPEAT
  157.         DialogEvent(Item);
  158.         IF Item=1 THEN
  159.             Done:=TRUE;
  160.  
  161.         IF Item=2 THEN
  162.         BEGIN
  163.             Done:=TRUE;
  164.             Abort:=TRUE;
  165.         END;
  166.  
  167.         IF (Item >= 4) AND  (Item <= 8) THEN BEGIN
  168.             SetRButton(1,Item);
  169.             Type:=Item-4;
  170.         END;
  171.     UNTIL DONE;
  172.     ClrDialog;
  173. END;
  174.  
  175. Procedure BallBearing;
  176. {
  177. ⌐1997, Diehl Graphsoft, Inc.
  178. Developed by Tom Urie
  179.  
  180. This procedure draws the front or side view of ball bearings.
  181. }
  182.  
  183. LABEL 20,30,40,99;
  184.  
  185. CONST
  186.     BFW=0.75;  {Factor used to determine ball diameter. Based on the width of the bearing.}
  187.     BFT=2/3;  {Factor used to determine ball diameter. Based on the thickness -  (OD - ID)/2.}
  188.     RF=0.1;  {Factor used to determine filet radius.}
  189.     TF=0.25;  {Factor used to determine thickness of inner and outer rings.}
  190.     SF=0.75;  {Factor used to calculate number of balls.}
  191.     CLF=0.3333;  {Factor used to calculate length of centerline.}
  192.     ACF=0.75;  {Factor used to determine configuration of outer race}
  193.  
  194. VAR
  195.     ID,OD,W,t,a,b,BD,rc : REAL;
  196.     x0,y0,x1,y1,dy,dy1,dy2,dy3,dy4,dy5,SW,CL,Lgth : REAL;
  197.     r1,r2,r3,br,Theta1,Theta2,Phi,DeltaPhi,s : REAL;
  198.  
  199.     Type,View,NBalls,n : INTEGER;
  200.  
  201.     Abort,ShowSection,Inch : BOOLEAN;
  202.  
  203.     UPI : REAL;
  204.     Fmt : INTEGER;
  205.     UM,UM2 : STRING;
  206.     UName,DA : LONGINT;
  207.  
  208. Procedure BearingDialog;
  209. {
  210. This procedure creates the dialog box.
  211. }
  212. VAR
  213.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  214.  
  215. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  216. VAR
  217.     scrx1,scry1,scrx2,scry2:INTEGER;
  218. BEGIN
  219.     GetScreen(scrx1,scry1,scrx2,scry2);
  220.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  221.     x2:=x1+Width; 
  222. END;
  223.  
  224. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  225. {
  226. This procedure locates the 'OK' and 'Cancel' buttons.
  227. }
  228. VAR
  229.     v1,v2,v3,v4 : INTEGER;
  230.     Mac : BOOLEAN;
  231.  
  232. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  233. VAR
  234.     Temp : INTEGER;
  235. BEGIN
  236.     Temp:=m1;
  237.     m1:=m3;
  238.     m3:=Temp;
  239.     Temp:=m2;
  240.     m2:=m4;
  241.     m4:=Temp;
  242. END;        {of Swap}
  243.  
  244. BEGIN
  245.     Mac:=FALSE;
  246.     GetVersion(v1,v2,v3,v4);
  247.     IF v4 = 1 THEN Mac:=TRUE;
  248.  
  249.     IF DialogType = 1 THEN
  250.     BEGIN
  251.         px1:=(scnw DIV 2) - 80;
  252.         px2:=(scnw DIV 2) - 10;
  253.         px3:=(scnw DIV 2) + 10;
  254.         px4:=(scnw DIV 2) + 80;
  255.         IF Mac THEN SWAP(px1,px2,px3,px4);
  256.  
  257.         py1:=scnh-40;
  258.         py2:=scnh-20;
  259.         py3:=py1;
  260.         py4:=py2;
  261.     END ELSE IF DialogType = 2 THEN
  262.     BEGIN
  263.         px1:=scnw - 180;
  264.         px2:=scnw - 110;
  265.         px3:=scnw - 90;
  266.         px4:=scnw - 20;
  267.         IF Mac THEN SWAP(px1,px2,px3,px4);
  268.  
  269.         py1:=scnh-40;
  270.         py2:=scnh-20;
  271.         py3:=py1;
  272.         py4:=py2;
  273.     END ELSE
  274.     BEGIN
  275.         px1:=scnw - 90;
  276.         px2:=scnw - 20;
  277.         px3:=px1;
  278.         px4:=px2;
  279.  
  280.         py1:=scnh -70;
  281.         py2:=scnh - 50;
  282.         py3:=scnh - 40;
  283.         py4:=scnh - 20;
  284.         IF Mac THEN SWAP(py1,py2,py3,py4);
  285.     END;
  286. END;        {of Locate Buttons}
  287.  
  288. Procedure MakeDialog;
  289. {
  290. This procedure defines the dialog box.
  291. }
  292. CONST
  293.     y1=100;
  294.     scnh=270;
  295.     scnw=360;
  296.     DialogType = 2;
  297.  
  298. VAR
  299.     h : INTEGER;
  300.  
  301. BEGIN
  302.     AlignScr(scnw,x1,x2);
  303.     y2:=y1+scnh;
  304.     LocateButtons(DialogType,scnh,scnw);
  305.  
  306.     BeginDialog(1,1,x1,y1,x2,y2);
  307.         AddButton('OK',1,1,px1,py1,px2,py2);
  308.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  309.  
  310.         h:=35;
  311.         AddField('Inside Diameter:',4,1,20,164-h,145,180-h);
  312.         AddField('',5,2,150,165-h,225,180-h);
  313.         AddField('in',25,1,233,164-h,265,180-h);
  314.  
  315.         AddField('Outside Diameter:',6,1,20,189-h,145,205-h);
  316.         AddField('',7,2,150,190-h,225,205-h);
  317.         AddField('in',26,1,233,189-h,265,205-h);
  318.  
  319.         AddField('Width:',8,1,20,214-h,145,230-h);
  320.         AddField('',9,2,150,215-h,225,230-h);
  321.         AddField('in',27,1,233,214-h,265,230-h);
  322.  
  323.         AddField('View:',10,1,270,134-h,315,150-h);
  324.         AddButton('Section',11,3,270,155-h,350,170-h);
  325.         AddButton('Front',12,3,270,175-h,325,190-h);
  326.  
  327.         AddField('Type:',13,1,20,44-h,120,60-h);
  328.         AddButton('Single Row Radial',14,3,20,65-h,160,80-h);
  329.         AddButton('SRR, Self-Contained',15,3,20,85-h,175,100-h);
  330.         AddButton('Single Row Angular',16,3,20,105-h,175,120-h);
  331.         AddButton('Double Row Radial',17,3,190,65-h,335,80-h);
  332.         AddButton('DRR, Self-Contained',18,3,190,85-h,340,100-h);
  333.         AddButton('Double Row Angular',19,3,190,105-h,340,120-h);
  334.         AddButton('Show Section Lines',20,2,20,245-h,170,260-h);
  335.  
  336.         AddField('Series:',22,1,20,134-h,65,150-h);
  337.         AddButton('Inch',23,3,70,135-h,120,150-h);
  338.         AddButton('Metric (mm)',24,3,125,135-h,225,150-h);
  339.     EndDialog;
  340. END;
  341.  
  342. BEGIN
  343.     MakeDialog;
  344. END;
  345.  
  346. Procedure GetInfo;
  347. {
  348. This procedure displays the dialog box and retrieves the information.
  349. }
  350. LABEL 10,20;
  351.  
  352. VAR
  353.     Item:integer;
  354.     RFlag : ARRAY[1..3] OF INTEGER;
  355.     Done:boolean;
  356.  
  357. Procedure SetRButton(i,Item : INTEGER);
  358. BEGIN
  359.     IF RFlag[i] <> Item THEN
  360.     BEGIN
  361.         SetItem(RFlag[i],FALSE);
  362.         SetItem(Item,TRUE);
  363.         RFlag[i]:=Item;
  364.     END;
  365. END;
  366.  
  367. BEGIN
  368.     Done:=FALSE;
  369.     Abort:=FALSE;
  370.     View:=1;
  371.     Type:=1;
  372.     ShowSection:=TRUE;
  373.     Inch:=TRUE;
  374.  
  375.     ID:=1.0000;
  376.     OD:=2.0000;
  377.     W:=0.5000;
  378.  
  379.     RFlag[1]:=14;
  380.     RFlag[2]:=11;
  381.     RFlag[3]:=23;
  382.  
  383.     GetDialog(1);
  384.     SetTitle('Ball Bearings');
  385.     SetItem(RFlag[1],TRUE);
  386.     SetItem(RFlag[2],TRUE);
  387.     SetItem(RFlag[3],TRUE);
  388.     SetItem(20,ShowSection);
  389.  
  390.     SetField(5,Num2Str(4,ID));
  391.     SetField(7,Num2Str(4,OD));
  392.     SetField(9,Num2Str(4,W));
  393.  
  394.     10:SelField(5);
  395.     REPEAT
  396.         DialogEvent(Item);
  397.         IF Item=1 THEN
  398.             Done:=TRUE;
  399.  
  400.         IF Item=2 THEN
  401.         BEGIN
  402.             Done:=TRUE;
  403.             Abort:=TRUE;
  404.         END;
  405.  
  406.         IF (Item = 11) OR (Item = 12) THEN
  407.         BEGIN
  408.             SetRButton(2,Item);
  409.             View:=Item-10;
  410.         END;
  411.  
  412.         IF (Item > 13) AND (Item < 20) THEN
  413.         BEGIN
  414.             SetRButton(1,Item);
  415.             Type:=Item-13;
  416.         END;
  417.  
  418.         IF Item=20 THEN
  419.         BEGIN
  420.             ShowSection:=NOT ShowSection;
  421.             SetItem(Item,ShowSection);
  422.         END;
  423.  
  424.         IF Item = 23 THEN
  425.         BEGIN
  426.             IF RFlag[3] <> Item THEN
  427.             BEGIN
  428.                 SetRButton(3,Item);
  429.                 SetField(25,'in');
  430.                 SetField(26,'in');
  431.                 SetField(27,'in');
  432.                 SelField(5);
  433.                 Inch:=TRUE;
  434.             END;
  435.         END;
  436.  
  437.         IF Item = 24 THEN
  438.         BEGIN
  439.             IF RFlag[3] <> Item THEN BEGIN
  440.                 SetRButton(3,Item);
  441.                 SetField(25,'mm');
  442.                 SetField(26,'mm');
  443.                 SetField(27,'mm');
  444.                 SelField(5);
  445.                 Inch:=FALSE;
  446.             END;
  447.         END;
  448.     UNTIL DONE;
  449.  
  450.     IF Abort THEN GOTO 20;
  451.     ID:=Str2Num(GetField(5));
  452.     OD:=Str2Num(GetField(7));
  453.     W:=Str2Num(GetField(9));
  454.     IF ID < OD THEN GOTO 20;
  455.  
  456.     SysBeep;
  457.     AlrtDialog('ID must be less than OD!');
  458.     Done:=FALSE;
  459.     GOTO 10;
  460.  
  461.     20:ClrDialog;
  462. END;
  463.  
  464. Procedure DrawCL1(CL:REAL);
  465. {
  466. This procedure draws a horizontal and vertical centerline through the ball.
  467. }
  468. BEGIN
  469.     Move(CL/2,0);
  470.     Line(-CL,0);
  471.     Move(CL/2,CL/2);
  472.     Line(0,-CL);
  473.     Move(0,CL/2);
  474. END;
  475.  
  476. Procedure DrawCL2(CL:REAL);
  477. {
  478. This procedure draws a horizontal and angled centerline through the balls on angular contact bearings.
  479. }
  480. BEGIN
  481.     Move(CL/2,0);
  482.     Line(-CL,0);
  483.     Move(0,-CL);
  484.     Line(CL,2*CL);
  485.     Move(-CL/2,-CL);
  486. END;
  487.  
  488. Procedure DrawCL3(CL:REAL);
  489. {
  490. This procedure draws a horizontal and angled centerlines through the balls on angular contact bearings.
  491. }
  492. BEGIN
  493.     Move(CL/2,0);
  494.     Line(-CL,0);
  495.     Move(0,CL);
  496.     Line(CL,-2*CL);
  497.     Move(-CL/2,CL);
  498. END;
  499.  
  500. {
  501. Main program.
  502. }
  503.  
  504. BEGIN
  505.     PushAttrs;
  506.  
  507. {
  508. Display dialog box and get information.
  509. }
  510.  
  511.     BearingDialog;
  512.     DSelectAll;
  513.     SetCursor(ArrowC);
  514.  
  515.     GetInfo;
  516.     IF Abort THEN GOTO 99;
  517.  
  518.     DSelectAll;
  519.  
  520. {
  521. Get units per inch and adjust parameters.
  522. }
  523.  
  524.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  525.     IF Inch THEN
  526.     BEGIN
  527.         ID:=ID*UPI;
  528.         OD:=OD*UPI;
  529.         W:=W*UPI;
  530.     END ELSE
  531.     BEGIN
  532.         ID:=ID*UPI/25.4;
  533.         OD:=OD*UPI/25.4;
  534.         W:=W*UPI/25.4;
  535.     END;
  536.  
  537. {
  538. Get location of bearing.
  539. }
  540.  
  541.     GetPt(x0,y0);
  542.  
  543. {
  544. Define variables.
  545. }
  546.  
  547. {
  548. Determine ball diameter (BD).
  549. }
  550.  
  551.     t:=(OD-ID)/2;
  552.     BD:=BFW*W;
  553.     IF (TYPE=4) OR (TYPE=5) OR (TYPE=6) THEN
  554.         BD:=BD/2;
  555.     IF BFT*t < BD THEN
  556.         BD:=BFT*t;
  557.  
  558. {
  559. Determine length of centerline (CL).
  560. }
  561.  
  562.     CL:=CLF*BD;
  563.  
  564. {
  565. Determine filet radius (rc).
  566. }
  567.  
  568.     rc:=RF*t;
  569.     IF RF*W < rc THEN
  570.         rc:=RF*W;
  571.  
  572. {
  573. Determine thickness of inner and outer rings (a).
  574. }
  575.  
  576.     a:=TF*bd;
  577.  
  578. {
  579. Determine various other variables used to draw bearing.
  580. }
  581.  
  582.     b:=t/2-a;
  583.     r1:=OD/2-b;
  584.     r2:=ID/2+b;
  585.     r3:=(OD+ID)/4;
  586.     br:=BD/2;
  587.     dy1:=t/2-br;
  588.     dy2:=b-dy1;
  589.     dy3:=ACF*dy1;
  590.     dy4:=(1-ACF)*dy1;
  591.     dy5:=b-dy3;
  592.     IF Type=5 THEN
  593.         dy:=dy2
  594.     ELSE IF Type=6 THEN
  595.         dy:=dy5
  596.     ELSE
  597.         dy:=0;
  598.     FillPat(1);
  599.     IF View=2 THEN GOTO 40;
  600.  
  601. {
  602. Draw side view.
  603. }
  604.  
  605.     FillPat(1);
  606.     Absolute;    
  607.     MoveTo(x0,y0-(OD/2-rc));
  608.     Relative;
  609.     RECT(0,0,W,(OD-2*rc));
  610.  
  611. {
  612. Draw inner race.
  613. }
  614.  
  615.     Absolute;
  616.     MoveTo(x0,y0+r2);
  617.     Relative;
  618.     ClosePoly;
  619.     IF ShowSection THEN
  620.         FillPat(12);
  621.  
  622.     BeginPoly;
  623.       ArcTo(0,-b,rc);
  624.         ArcTo(W,0,rc);
  625.       LineTo(0,b);
  626.         IF Type=6 THEN
  627.         BEGIN
  628.             LineTo(-W/4,0);
  629.             LineTo(0,-dy2);
  630.             LineTo(-W/2,0);
  631.             LineTo(0,dy2);
  632.             LineTo(-W/4,0);
  633.         END ELSE
  634.           LineTo(-W,0);
  635.     EndPoly;
  636.     MoveTo(0,-2*r2);
  637.  
  638.     BeginPoly;
  639.         ArcTo(0,b,rc);
  640.         ArcTo(W,0,rc);
  641.         LineTo(0,-b);
  642.         IF Type=6 THEN
  643.         BEGIN
  644.             LineTo(-W/4,0);
  645.             LineTo(0,dy2);
  646.             LineTo(-W/2,0);
  647.             LineTo(0,-dy2);
  648.             LineTo(-W/4,0);
  649.         END
  650.         ELSE
  651.         LineTo(-W,0);
  652.     EndPoly;
  653.     FillPat(1);
  654.  
  655. {
  656. Draw Outer Race.
  657. }
  658.  
  659.     Absolute;
  660.     MoveTo(x0,y0+r1);
  661.     Relative;
  662.     IF ShowSection THEN
  663.         FillPat(24);
  664.     BeginPoly;
  665.       ArcTo(0,b,rc);
  666.       ArcTo(W,0,rc);
  667.         IF Type=2 THEN
  668.         BEGIN
  669.             LineTo(0,-dy1);            
  670.             LineTo(-w/2,0);
  671.             LineTo(0,-dy2);
  672.             LineTo(-w/2,0);
  673.         END ELSE IF Type=3 THEN
  674.         BEGIN
  675.             LineTo(0,-dy3);        
  676.             LineTo(-w/2,-dy4);
  677.             LineTo(0,-dy2);
  678.             LineTo(-w/2,0);
  679.         END ELSE IF Type=5 THEN
  680.         BEGIN
  681.             LineTo(0,-dy1);            
  682.             LineTo(-w/4,0);
  683.             LineTo(0,-dy2);
  684.             LineTo(-w/2,0);
  685.             LineTo(0,dy2);
  686.             LineTo(-w/4,0);
  687.         END ELSE IF Type=6 THEN
  688.         BEGIN
  689.             LineTo(0,-dy3);
  690.             LineTo(-w/4,-dy4);
  691.             LineTo(0,-dy2);
  692.             LineTo(-w/2,0);
  693.             LineTo(0,dy2);
  694.             LineTo(-w/4,dy4);
  695.         END ELSE
  696.         BEGIN
  697.           LineTo(0,-b);
  698.           LineTo(-W,0);
  699.         END;
  700.     EndPoly;
  701.     MoveTo(0,-(2*r1+dy));
  702.  
  703.     BeginPoly;
  704.       ArcTo(0,-b,rc);
  705.       ArcTo(W,0,rc);
  706.         IF Type=2 THEN
  707.         BEGIN
  708.             LineTo(0,(t/2-br));            
  709.             LineTo(-w/2,0);
  710.             LineTo(0,dy1);
  711.             LineTo(-w/2,0);
  712.         END ELSE IF Type=3 THEN
  713.         BEGIN
  714.             LineTo(0,dy3);            
  715.             LineTo(-w/2,dy4);
  716.             LineTo(0,dy2);
  717.             LineTo(-w/2,0);
  718.         END ELSE IF Type=5 THEN
  719.         BEGIN
  720.             LineTo(0,dy1);            
  721.             LineTo(-w/4,0);
  722.             LineTo(0,dy2);
  723.             LineTo(-w/2,0);
  724.             LineTo(0,-dy2);
  725.             LineTo(-w/4,0);
  726.         END ELSE IF Type=6 THEN
  727.         BEGIN
  728.             LineTo(0,dy3);            
  729.             LineTo(-w/4,dy4);
  730.             LineTo(0,dy2);
  731.             LineTo(-w/2,0);
  732.             LineTo(0,-dy2);
  733.             LineTo(-w/4,-dy4);
  734.         END ELSE
  735.         BEGIN
  736.           LineTo(0,b);
  737.           LineTo(-W,0);
  738.         END;
  739.     EndPoly;
  740.  
  741. {
  742. Draw Balls.
  743. }
  744.  
  745.     FillPat(1);
  746.  
  747. {
  748. Single Row.
  749. }
  750.  
  751.     IF (Type=1) OR (Type=2) OR (Type=3) THEN
  752.     BEGIN
  753.         Absolute;
  754.         MoveTo(x0+W/2,y0-r3);
  755.         Relative;
  756.         Oval(-br,br,br,-br);
  757.         IF Type=3 THEN
  758.             DrawCL2(CL)
  759.         ELSE
  760.             DrawCL1(CL);
  761.         Move(0,2*r3);
  762.         Oval(-br,br,br,-br);
  763.         IF Type=3 THEN
  764.             DrawCL3(CL)
  765.         ELSE
  766.             DrawCL1(CL);
  767.     END
  768.  
  769. {
  770. Double Row.
  771. }
  772.  
  773.     ELSE BEGIN
  774.         Absolute;
  775.         MoveTo(x0+w/4,y0+r3);
  776.         Relative;
  777.         Oval(-br,br,br,-br);
  778.         IF Type=6 THEN
  779.             DrawCL2(CL)
  780.         ELSE
  781.             DrawCL1(CL);
  782.         Move(W/2,0);
  783.         Oval(-br,br,br,-br);
  784.         IF Type=6 THEN
  785.             DrawCL3(CL)
  786.         ELSE
  787.             DrawCL1(CL);
  788.         Move(0,-2*r3);
  789.         Oval(-bd/2,bd/2,bd/2,-bd/2);
  790.         IF Type=6 THEN
  791.             DrawCL3(CL)
  792.         ELSE
  793.             DrawCL1(CL);
  794.         Move(-W/2,0);
  795.         Oval(-br,br,br,-br);
  796.         IF Type=6 THEN
  797.             DrawCL2(CL)
  798.         ELSE
  799.             DrawCL1(CL);
  800.     END;
  801.     GOTO 99;
  802.  
  803. {
  804. Draw front view.
  805. }
  806.  
  807.     40:s:=SF*BD;
  808.     Phi:=2*s/r3;
  809.     NBalls:=2*PI/Phi;
  810.     DeltaPhi:=360/NBalls;
  811.     IF (Type = 5) OR (Type = 6) THEN
  812.         r1:=r1+dy2;
  813.     Phi:=-DeltaPhi;
  814.     Theta1:=Rad2Deg(ArcCos((br^2+r3^2-r2^2)/(2*br*r3)));
  815.     Theta2:=Rad2Deg(ArcCos((br^2+r3^2-r1^2)/(2*br*r3)));
  816.     FillPat(1);
  817.  
  818.     Absolute;
  819.     MoveTo(x0,y0);
  820.     Relative;
  821.     Arc(-OD/2,OD/2,OD/2,-OD/2,0,360);
  822.     IF Type = 6 THEN
  823.             Arc(-(OD/2-dy3),(OD/2-dy3),(OD/2-dy3),-(OD/2-dy3),0,360);
  824.     Arc(-r1,r1,r1,-r1,0,360);
  825.     Arc(-r2,r2,r2,-r2,0,360);
  826.     Arc(-ID/2,ID/2,ID/2,-ID/2,0,360);
  827.  
  828.     FOR n:=1 TO NBalls DO
  829.     BEGIN
  830.         Phi:=Phi+DelTaPhi;
  831.         x1:=r3*Sin(Deg2Rad(Phi));
  832.         y1:=r3*Cos(Deg2Rad(Phi));
  833.         Absolute;
  834.         MoveTo(x0+x1,y0+y1);
  835.         Relative;
  836.         Arc(-br,br,br,-br,(270-Theta2-Phi),(Theta2-Theta1));
  837.         Arc(-br,br,br,-br,-(90-Theta1+Phi),(Theta2-Theta1));
  838.     END;
  839.     99:Group;
  840.     PopAttrs;
  841. END;
  842.  
  843. Procedure RollerBearing;
  844. {
  845. ⌐1996, Diehl Graphsoft, Inc.
  846. Developed by Tom Urie
  847.  
  848. This procedure draws cylindrical roller bearings.
  849. }
  850.  
  851. LABEL 10,11,12,15,16,20,25,30,40,98,99;
  852.  
  853. CONST
  854.     maxPoints = 15;
  855. {
  856. The following constants are used to determine the width of roller(s).
  857. }
  858.     kwr1 = 0.666667;    {Types 1,2,3,4,9}
  859.     kwr2 = 0.375;        {Types 5,6,7}
  860.     kwr3 = 0.33333;    {Types 8,10}
  861. {
  862. The following constants are used to determine the roller diameter.
  863. }
  864.     kdr1 = 0.6;        {Types 1,2,3,5,6,7}
  865.     kdr2 = 0.65;    {Types 4,8}
  866.     kdr3 = 0.5;        {Types 9,10}
  867. {
  868. The following constant is used to determine the minimum roller diameter.
  869. }
  870.     kMinDr = 0.1;
  871. {
  872. The following constants are used to determine the fillet radius.
  873. }
  874.     krft = 0.0625;
  875.     krfw = 0.125;
  876. {
  877. The following constant is used to determine shoulder height.
  878. }
  879.     ks = 0.75;
  880. {
  881. The following constants are used to determine the spacing between rollers.
  882. }
  883.     ksp = 1.25;
  884.     ks3 = 0.25;
  885.  
  886. VAR
  887.     ID,OD,W,w1,t,a1,a2,a3,a4,a5,a6,a7,a8 : REAL;
  888.     b,c,d,d1,d2,dr,dr2,rc,wr : REAL;
  889.     x0,y0,x1,y1,x2,s,s2,s3,s4,s5,tw,f : REAL;
  890.     rf,tf,r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11 : REAL;
  891.     Alpha,Theta,Phi,dPhi : REAL;
  892.     x,y,r : ARRAY[1..maxPoints] OF REAL;
  893.  
  894.     i,j,k,m,Type,View,n,nRollers,nPoints : INTEGER;
  895.     Abort,ShowSection,Inch : BOOLEAN;
  896.     ODS,IDS,WS,DisplayUnits : STRING;
  897.     RollerH : HANDLE;
  898.  
  899.     UPI : REAL;
  900.     Fmt : INTEGER;
  901.     UM,UM2 : STRING;
  902.     UName,DA : LONGINT;
  903.  
  904. Procedure BearingDialog;
  905. {
  906. This procedure defines the dialog box.
  907. }
  908. VAR
  909.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  910.  
  911. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  912. VAR
  913.     scrx1,scry1,scrx2,scry2:INTEGER;
  914.  
  915. BEGIN
  916.     GetScreen(scrx1,scry1,scrx2,scry2);
  917.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  918.     x2:=x1+Width; 
  919. END;
  920.  
  921. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  922. {
  923. This procedure locates the 'OK' and 'Cancel' buttons.
  924. }
  925. VAR
  926.     v1,v2,v3,v4 : INTEGER;
  927.     Mac : BOOLEAN;
  928.  
  929. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  930. VAR
  931.     Temp : INTEGER;
  932. BEGIN
  933.     Temp:=m1;
  934.     m1:=m3;
  935.     m3:=Temp;
  936.     Temp:=m2;
  937.     m2:=m4;
  938.     m4:=Temp;
  939. END;        {of Swap}
  940.  
  941. BEGIN
  942.     Mac:=FALSE;
  943.     GetVersion(v1,v2,v3,v4);
  944.     IF v4 = 1 THEN Mac:=TRUE;
  945.  
  946.     IF DialogType = 1 THEN
  947.     BEGIN
  948.         px1:=(scnw DIV 2) - 80;
  949.         px2:=(scnw DIV 2) - 10;
  950.         px3:=(scnw DIV 2) + 10;
  951.         px4:=(scnw DIV 2) + 80;
  952.         IF Mac THEN SWAP(px1,px2,px3,px4);
  953.  
  954.         py1:=scnh-40;
  955.         py2:=scnh-20;
  956.         py3:=py1;
  957.         py4:=py2;
  958.     END ELSE IF DialogType = 2 THEN
  959.     BEGIN
  960.         px1:=scnw - 180;
  961.         px2:=scnw - 110;
  962.         px3:=scnw - 90;
  963.         px4:=scnw - 20;
  964.         IF Mac THEN SWAP(px1,px2,px3,px4);
  965.  
  966.         py1:=scnh-40;
  967.         py2:=scnh-20;
  968.         py3:=py1;
  969.         py4:=py2;
  970.     END ELSE
  971.     BEGIN
  972.         px1:=scnw - 90;
  973.         px2:=scnw - 20;
  974.         px3:=px1;
  975.         px4:=px2;
  976.  
  977.         py1:=scnh -70;
  978.         py2:=scnh - 50;
  979.         py3:=scnh - 40;
  980.         py4:=scnh - 20;
  981.         IF Mac THEN SWAP(py1,py2,py3,py4);
  982.     END;
  983.  
  984. END;        {of Locate Buttons}
  985.  
  986. Procedure MakeDialog;
  987. CONST
  988.     y1=100;
  989.     scnh=320;
  990.     scnw=405;
  991.     DialogType = 2;
  992.  
  993. VAR
  994.     h,h1 : INTEGER;
  995.  
  996. BEGIN
  997.     AlignScr(scnw,x1,x2);
  998.     y2:=y1+scnh;
  999.     LocateButtons(DialogType,scnh,scnw);
  1000.  
  1001.     BeginDialog(1,1,x1,y1,x2,y2);
  1002.         AddButton('OK',1,1,px1,py1,px2,py2);
  1003.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  1004.  
  1005.         h:=35;
  1006.         AddField('Ring Configuration (Ribs-inner ring/Ribs-outer ring):',55,1,20,44-h,380,60-h);
  1007.         AddField('Single Row:',29,1,20,64-h,175,80-h);
  1008.         AddField('Double Row:',30,1,210,64-h,375,80-h);
  1009.         AddButton('Double/Double',14,3,20,85-h,175,100-h);
  1010.         AddButton('Double/None',15,3,20,105-h,175,120-h);
  1011.         AddButton('None/Double',16,3,20,125-h,175,140-h);
  1012.         AddButton('Self-Aligning Outer Ring',17,3,20,145-h,195,160-h);
  1013.         AddButton('Self-Aligning Inner Ring',22,3,20,165-h,195,180-h);
  1014.  
  1015.         AddButton('Double/Double',18,3,210,85-h,375,100-h);
  1016.         AddButton('Double/None',19,3,210,105-h,375,120-h);
  1017.         AddButton('None/Double',20,3,210,125-h,375,140-h);
  1018.         AddButton('Self-Aligning Outer Ring',21,3,210,145-h,395,160-h);
  1019.         AddButton('Self-Aligning Inner Ring',23,3,210,165-h,395,180-h);
  1020.  
  1021.         h1:=60-h;
  1022.         AddField('Series:',35,1,20,134+h1,65,150+h1);
  1023.         AddButton('Inch',36,3,70,135+h1,120,150+h1);
  1024.         AddButton('Metric (mm)',37,3,125,135+h1,225,150+h1);
  1025.  
  1026.         AddField('Inside Diameter:',4,1,20,164+h1,145,180+h1);
  1027.         AddField('',5,2,150,165+h1,225,180+h1);
  1028.         AddField('in',25,1,233,164+h1,275,180+h1);
  1029.  
  1030.         AddField('Outside Diameter:',6,1,20,189+h1,145,205+h1);
  1031.         AddField('',7,2,150,190+h1,225,205+h1);
  1032.         AddField('in',26,1,233,189+h1,275,205+h1);
  1033.  
  1034.         AddField('Width:',8,1,20,214+h1,145,230+h1);
  1035.         AddField('',9,2,150,215+h1,225,230+h1);
  1036.         AddField('in',27,1,233,214+h1,275,230+h1);
  1037.  
  1038.         AddField('View:',10,1,280,134+h1,325,150+h1);
  1039.         AddButton('Section',11,3,280,155+h1,360,170+h1);
  1040.         AddButton('Front',12,3,280,175+h1,360,195+h1);
  1041.         AddButton('Rear',13,3,280,195+h1,360,215+h1);
  1042.  
  1043.         AddButton('Show Section Lines',28,2,20,245+h1,170,260+h1);
  1044.  
  1045.     EndDialog;
  1046. END;
  1047.  
  1048. BEGIN
  1049.     MakeDialog;
  1050. END;
  1051.  
  1052. Procedure GetInfo;
  1053. {
  1054. This procedure displays the dialox box and retrieves the information.
  1055. }
  1056. LABEL 5,10,20;
  1057.  
  1058. VAR
  1059.     f : REAL;
  1060.     n,Item : INTEGER;
  1061.     RFlag : ARRAY[1..3] OF INTEGER;
  1062.     Done,OK : BOOLEAN;
  1063.  
  1064. Procedure SetRButton(i,Item : INTEGER);
  1065. BEGIN
  1066.     IF RFlag[i] <> Item THEN BEGIN
  1067.         SetItem(RFlag[i],FALSE);
  1068.         SetItem(Item,TRUE);
  1069.         RFlag[i]:=Item;
  1070.     END;
  1071. END;
  1072.  
  1073. BEGIN
  1074.     Done:=FALSE;
  1075.     Abort:=FALSE;
  1076.     View:=1;
  1077.     Type:=1;
  1078.     ShowSection:=TRUE;
  1079.     Inch:=TRUE;
  1080.  
  1081.     OD:=2.0000;
  1082.     ID:=1.0000;
  1083.     W:=0.5000;
  1084.  
  1085.     RFlag[1]:=Type+13;
  1086.     RFlag[2]:=View+10;
  1087.     RFlag[3]:=36;
  1088.     
  1089.     GetDialog(1);
  1090.     SetTitle('Cylindrical Roller Bearings');
  1091.     SetItem(RFlag[1],TRUE);
  1092.     SetItem(RFlag[2],TRUE);
  1093.     SetItem(RFlag[3],TRUE);
  1094.     SetItem(28,ShowSection);
  1095.     SetField(5,Num2Str(4,ID));
  1096.     SetField(7,Num2Str(4,OD));
  1097.     SetField(9,Num2Str(4,W));
  1098.  
  1099.     10:SelField(5);
  1100.     REPEAT
  1101.         DialogEvent(Item);
  1102.         IF Item=1 THEN
  1103.             Done:=TRUE;
  1104.  
  1105.         IF Item=2 THEN
  1106.         BEGIN
  1107.             Done:=TRUE;
  1108.             Abort:=TRUE;
  1109.         END;
  1110.  
  1111.         IF (Item>=11) AND (Item<=13) THEN
  1112.         BEGIN
  1113.             SetRButton(2,Item);
  1114.             View:=Item-10;
  1115.         END;
  1116.  
  1117.         IF (Item>=14) AND (Item<=23) THEN
  1118.         BEGIN
  1119.             SetRButton(1,Item);
  1120.             Type:=Item-13;
  1121.         END;
  1122.  
  1123.         IF Item=28 THEN
  1124.         BEGIN
  1125.             SetItem(Item,NOT ShowSection);
  1126.             ShowSection:=NOT ShowSection;
  1127.         END;
  1128.  
  1129.         IF Item=36 THEN
  1130.         BEGIN
  1131.             IF RFlag[3]<>Item THEN
  1132.             BEGIN
  1133.                 SetRButton(3,Item);
  1134.                 Inch:=TRUE;
  1135.                 SetField(25,'in');
  1136.                 SetField(26,'in');
  1137.                 SetField(27,'in');
  1138.             END;
  1139.         END;
  1140.  
  1141.         IF Item=37 THEN
  1142.             BEGIN
  1143.             IF RFlag[3]<>Item THEN
  1144.                 BEGIN
  1145.                     SetRButton(3,Item);
  1146.                     Inch:=FALSE;
  1147.                     SetField(25,'mm');
  1148.                     SetField(26,'mm');
  1149.                     SetField(27,'mm');
  1150.             END;
  1151.         END;
  1152.     UNTIL DONE;
  1153.  
  1154.     IF Abort THEN GOTO 20;
  1155.     OK:=ValidNumStr(GetField(5),ID);
  1156.     OK:=ValidNumStr(GetField(7),OD);
  1157.     OK:=ValidNumStr(GetField(9),W);
  1158.  
  1159.     IF ID < OD THEN GOTO 20;
  1160.     SysBeep;
  1161.     AlrtDialog('ID must be less than OD!');
  1162.     Done:=FALSE;
  1163.     GOTO 10;
  1164.  
  1165.     20:ClrDialog;
  1166. END;
  1167.  
  1168. Procedure DrawWasher(x0,y0,OD,ID:REAL);
  1169. VAR
  1170.     r1,r2 : REAL;
  1171.     x,y,r : ARRAY[1..13] OF REAL;
  1172.     n : INTEGER;
  1173.  
  1174. BEGIN
  1175.     r1:=OD/2;
  1176.     r2:=ID/2;
  1177.     x[1]:=0;        y[1]:=r1;    r[1]:=0;
  1178.     x[2]:=r1;    y[2]:=r1;    r[2]:=r1;
  1179.     x[3]:=r1;    y[3]:=-r1;    r[3]:=r1;
  1180.     x[4]:=-r1;    y[4]:=-r1;    r[4]:=r1;
  1181.     x[5]:=-r1;    y[5]:=r1;    r[5]:=r1;
  1182.     x[6]:=0;        y[6]:=r1;    r[6]:=0;
  1183.     x[7]:=0;        y[7]:=r2;    r[7]:=-1;
  1184.     x[8]:=-r2;    y[8]:=r2;    r[8]:=r2;
  1185.     x[9]:=-r2;    y[9]:=-r2;    r[9]:=r2;
  1186.     x[10]:=r2;    y[10]:=-r2;    r[10]:=r2;
  1187.     x[11]:=r2;    y[11]:=r2;    r[11]:=r2;
  1188.     x[12]:=0;    y[12]:=r2;    r[12]:=0;
  1189.     x[13]:=0;    y[13]:=r1;    r[13]:=-1;
  1190.  
  1191.     Absolute;
  1192.     MoveTo(x0,y0);
  1193.     OpenPoly;
  1194.     BeginPoly;
  1195.         FOR n:=1 TO 13 DO
  1196.         BEGIN
  1197.             x[n]:=x[n]+x0;
  1198.             y[n]:=y[n]+y0;
  1199.             IF r[n]<0 THEN
  1200.                 MoveTo(x[n],y[n])
  1201.             ELSE IF r[n]=0 THEN
  1202.                 LineTo(x[n],y[n])
  1203.             ELSE
  1204.                 ArcTo(x[n],y[n],r[n]);
  1205.         END;
  1206.     EndPoly;
  1207. END;
  1208.  
  1209. Procedure DrawPoint(x,y,r:REAL);
  1210. BEGIN
  1211.     IF r<0 THEN
  1212.         CurveThrough(x,y)
  1213.     ELSE IF r=0 THEN
  1214.         LineTo(x,y)
  1215.     ELSE
  1216.         ArcTo(x,y,r);
  1217. END;
  1218.  
  1219. Procedure DrawRoller(d1,d2,w:REAL);
  1220. BEGIN
  1221.     FillPat(1);
  1222.     Relative;
  1223.     BeginGroup;
  1224.     IF d1=d2 THEN
  1225.         Rect(-w/2,d1/2,w/2,-d1/2)
  1226.     ELSE BEGIN
  1227.         MoveTo(-w/2,d2/2);
  1228.         ClosePoly;
  1229.         BeginPoly;
  1230.             LineTo(0,0);
  1231.             CurveThrough(w/2,(d1-d2)/2);
  1232.             LineTo(w/2,-(d1-d2)/2);
  1233.             LineTo(0,-d2);
  1234.             CurveThrough(-w/2,-(d1-d2)/2);
  1235.             LineTo(-w/2,(d1-d2)/2);
  1236.         EndPoly;
  1237.     Move(w/2,d2/2);
  1238.     END;
  1239.     IF ShowSection THEN
  1240.     BEGIN
  1241.         Move(-w/2,d2/2);
  1242.         LineTo(w,-d2);
  1243.         Move(0,d2);
  1244.         LineTo(-w,-d2);
  1245.     END;
  1246.     EndGroup;
  1247. END;
  1248.  
  1249. {
  1250. Main program.
  1251. }
  1252.  
  1253. BEGIN
  1254.     PushAttrs;
  1255.  
  1256. {
  1257. Display dialog box and get information.
  1258. }
  1259.  
  1260.     BearingDialog;
  1261.     DSelectAll;
  1262.     SetCursor(ArrowC);
  1263.  
  1264.     GetInfo;
  1265.     IF Abort THEN GOTO 99;
  1266.  
  1267. {
  1268. Get units per inch and adjust sizes accordingly.
  1269. }
  1270.  
  1271.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  1272.     IF Inch THEN
  1273.     BEGIN
  1274.         ID:=ID*UPI;
  1275.         OD:=OD*UPI;
  1276.         W:=W*UPI;
  1277.     END ELSE
  1278.     BEGIN
  1279.         ID:=ID*UPI/25.4;
  1280.         OD:=OD*UPI/25.4;
  1281.         W:=W*UPI/25.4;
  1282.     END;
  1283.  
  1284. {
  1285. Calculate variables needed to draw bearing.
  1286. }
  1287.     t:=(OD-ID)/2;
  1288.  
  1289.     IF (Type=4)OR(Type=8) THEN
  1290.         dr:=kdr2*t
  1291.     ELSE IF (Type=9)OR(Type=10) THEN
  1292.         dr:=kdr3*t
  1293.     ELSE    dr:=kdr1*t;
  1294.  
  1295.     IF (Type<=4)OR(Type=9) THEN
  1296.     BEGIN
  1297.         wr:=kwr1*W;
  1298.         b:=(W-wr)/2;
  1299.     END
  1300.     ELSE IF (Type=8)OR(Type=10) THEN
  1301.     BEGIN
  1302.         wr:=kwr3*W;
  1303.         b:=(W-2*wr)/3;
  1304.     END ELSE
  1305.     BEGIN
  1306.         wr:=kwr2*W;
  1307.         b:=(W-2*wr)/3;
  1308.     END;
  1309.     c:=(t-dr)/2;
  1310.     rf:=krft*t;
  1311.     IF krfw*W < rf THEN rf:=krfw*W;
  1312.     r2:=(ID+t)/2;
  1313.  
  1314.     IF (Type<=3)OR((Type>=5)AND(Type<=7)) THEN
  1315.     BEGIN
  1316.         s:=ks*dr;
  1317.         a1:=(t-s)/2;
  1318.  
  1319.         IF (Type=3)OR(Type=7) THEN
  1320.             r1:=ID/2+c
  1321.         ELSE r1:=ID/2+a1;
  1322.  
  1323.         IF (Type=2)OR(Type=6) THEN
  1324.             r3:=OD/2-c
  1325.         ELSE r3:=OD/2-a1;
  1326.  
  1327.         s2:=0;
  1328.         dr2:=dr;
  1329.         s3:=(b+wr)/2;
  1330.     END
  1331.  
  1332.     ELSE IF Type=4 THEN
  1333.     BEGIN
  1334.         10:r4:=r2+dr/2;
  1335.  
  1336.         IF W > 2*r4 THEN
  1337.         REPEAT
  1338.             dr:=0.95*dr;
  1339.             IF dr<= kMinDr*t THEN GOTO 98;
  1340.             r4:=r2+dr/2;
  1341.         UNTIL 2*r4 > W;
  1342.  
  1343.         c:=(t-dr)/2;
  1344.         Theta:=ArcSin(W/(2*r4));
  1345.         r6:=r4*Cos(Theta);
  1346.         s2:=r4-Sqrt(r4^2 - (wr/2)^2);
  1347.         dr2:=dr-2*s2;
  1348.         IF dr2 <= 0 THEN GOTO 98;
  1349.         s:=ks*dr2;
  1350.         a1:=(t-s)/2;
  1351.         a2:=OD/2-r6;
  1352.         a4:=(t-dr2)/2;
  1353.         a5:=a1-a4;
  1354.         r1:=ID/2+a1;
  1355.  
  1356.         IF (r1>r6) OR (r4>OD/2) THEN
  1357.         BEGIN
  1358.             dr:=dr*0.95;
  1359.             GOTO 10;
  1360.         END;
  1361.     END
  1362.  
  1363.     ELSE IF Type=8 THEN
  1364.     BEGIN
  1365.         11:s3:=ks3*W;
  1366.         r5:=Sqrt(r2^2+s3^2);
  1367.         r4:=r5+dr/2;
  1368.  
  1369.         IF W > 2*r4 THEN
  1370.         REPEAT
  1371.             dr:=0.95*dr;
  1372.             IF dr<= kMinDr*t THEN GOTO 98;
  1373.             s3:=ks3*W;
  1374.             r5:=Sqrt(r2^2+s3^2);
  1375.             r4:=r5+dr/2;
  1376.         UNTIL 2*r4 > W;
  1377.  
  1378.         c:=(t-dr)/2;
  1379.         Alpha:=ArcSin(s3/r5);
  1380.         Theta:=ArcSin(W/(2*r4));
  1381.         r6:=r4*Cos(Theta);
  1382.         s2:=r4-Sqrt(r4^2 - (wr/2)^2);
  1383.         dr2:=dr-2*s2;
  1384.         IF dr2 <= 0 THEN GOTO 98;
  1385.         s:=ks*dr2;
  1386.         a1:=(t-s)/2;
  1387.         a2:=OD/2-r6;
  1388.         a4:=(t-dr2)/2;
  1389.         a5:=a1-a4;
  1390.         a6:=t/2 - wr*Sin(Alpha)/2 - dr2*Cos(Alpha)/2 + a5;
  1391.         a3:=a6+Wr*Sin(Alpha);
  1392.         s4:=s3 + wr*Cos(Alpha)/2 - dr2*Sin(Alpha)/2;
  1393.         s5:=s3 - wr*Cos(Alpha)/2;
  1394.         c:=OD/2-r4;
  1395.         r1:=ID/2+a6;
  1396.         r7:=r2-wr*Sin(Alpha)/2;
  1397.         r8:=ID/2+a3;
  1398.  
  1399.         IF (r1>r6)OR(r4>OD/2) THEN
  1400.         BEGIN
  1401.             dr:=dr*0.95;
  1402.             GOTO 11;
  1403.         END;
  1404.     END
  1405.  
  1406.     ELSE IF (Type = 9) OR (Type = 10) THEN
  1407.     BEGIN
  1408.         IF Type=9 THEN W:=2*W;
  1409.         12:s3:=ks3*W;
  1410.         r5:=Sqrt(r2^2+s3^2);
  1411.         r4:=Sqrt((r5-dr/2)^2 + (wr/2)^2);
  1412.  
  1413.         IF W > 2*r4 THEN
  1414.         REPEAT
  1415.             dr:=0.95*dr;
  1416.             IF dr<= kMinDr*t THEN GOTO 98;
  1417.             s3:=ks3*W;
  1418.             r5:=Sqrt(r2^2+s3^2);
  1419.             r4:=Sqrt((r5-dr/2)^2 + (wr/2)^2);
  1420.         UNTIL 2*r4 > W;
  1421.  
  1422.         IF W > 2*r4 THEN
  1423.         BEGIN
  1424.             Sysbeep;
  1425.             AlrtDialog('That configuration is not possible!');
  1426.             GOTO 99;
  1427.         END;
  1428.  
  1429.         s2:=r4-Sqrt(r4^2 - (wr/2)^2);
  1430.         dr2:=dr-2*s2;
  1431.         IF dr2 <= 0 THEN GOTO 98;
  1432.         Alpha:=ArcSin(s3/r5);
  1433.         Theta:=ArcSin(W/(2*r4));
  1434.         r1:=r4*Cos(Theta);
  1435.         a1:=r1-ID/2;
  1436.         a2:=r4-ID/2;
  1437.         IF Type=10 THEN
  1438.             a3:=r4/Cos(Theta)-ID/2
  1439.         ELSE
  1440.             a3:=r4-ID/2;
  1441.         s4:=r4*Sin(Alpha);
  1442.         a4:=Sqrt(r4^2 - s4^2)-ID/2;
  1443.         s5:=s3-(wr*Cos(Alpha)/2 + dr*Sin(Alpha)/2);
  1444.         a5:=Sqrt(r4^2 - (W/2-s5)^2)-ID/2;
  1445.         r6:=OD/2-a2;
  1446.         r7:=r2-wr*Sin(Alpha)/2;
  1447.         a7:=OD/2-Sqrt((r4+dr)^2 - (W/4)^2);
  1448.         a8:=Sqrt(r4^2 - (W/4)^2) - ID/2;
  1449.         IF Type=9 THEN
  1450.         BEGIN
  1451.             r9:=r7+wr*Sin(Alpha);
  1452.             r10:=ID/2+a3;
  1453.             r11:=OD/2-a5;
  1454.         END;
  1455.  
  1456. IF (r1>r6)OR(r4<ID/2)OR(r1<ID/2) THEN
  1457.         BEGIN
  1458.             dr:=dr*0.95;
  1459.             GOTO 12;
  1460.         END;
  1461.     END;
  1462.  
  1463. {
  1464. Get insertion point.
  1465. }
  1466.     GetPt(x0,y0);
  1467.     IF (View=2) OR (View=3) THEN GOTO 30;
  1468. {
  1469. Draw Side View
  1470. }
  1471. {
  1472. Draw outer ring.
  1473. }
  1474.     IF (Type=1) OR (Type=3) THEN
  1475.     BEGIN
  1476.         nPoints:=8;
  1477.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1478.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1479.         x[3]:=W;        y[3]:=a1;        r[3]:=0;
  1480.         x[4]:=W-b;    y[4]:=a1;        r[4]:=0;
  1481.         x[5]:=W-b;    y[5]:=c;        r[5]:=0;
  1482.         x[6]:=b;        y[6]:=c;        r[6]:=0;
  1483.         x[7]:=b;        y[7]:=a1;        r[7]:=0;
  1484.         x[8]:=0;        y[8]:=a1;        r[8]:=0;
  1485.     END
  1486.  
  1487.     ELSE IF (Type=2) OR (Type=6) THEN
  1488.     BEGIN
  1489.     nPoints:=4;
  1490.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1491.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1492.         x[3]:=W;        y[3]:=c;        r[3]:=0;
  1493.         x[4]:=0;        y[4]:=c;        r[5]:=0;
  1494.     END
  1495.  
  1496.     ELSE IF Type=4 THEN
  1497.     BEGIN
  1498.     nPoints:=5;
  1499.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1500.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1501.         x[3]:=W;        y[3]:=a2;        r[3]:=0;
  1502.         x[4]:=W/2;    y[4]:=c;        r[4]:=-1;
  1503.         x[5]:=0;        y[5]:=a2;        r[5]:=0;
  1504.     END
  1505.  
  1506.     ELSE IF (Type=5) OR (Type=7) THEN
  1507.     BEGIN
  1508.         nPoints:=12;
  1509.         x[1]:=0;            y[1]:=0;
  1510.         x[2]:=W;            y[2]:=0;
  1511.         x[3]:=W;            y[3]:=a1;
  1512.         x[4]:=W-b;        y[4]:=a1;
  1513.         x[5]:=W-b;        y[5]:=c;
  1514.         x[6]:=2*b+wr;    y[6]:=c;
  1515.         x[7]:=2*b+wr;    y[7]:=a1;
  1516.         x[8]:=b+wr;        y[8]:=a1;
  1517.         x[9]:=b+wr;        y[9]:=c;
  1518.         x[10]:=b;            y[10]:=c;
  1519.         x[11]:=b;            y[11]:=a1;
  1520.         x[12]:=0;            y[12]:=a1;
  1521.  
  1522.         r[1]:=rf;
  1523.         r[2]:=rf;
  1524.         FOR k:=3 TO 12 DO
  1525.             r[k]:=0;
  1526.     END
  1527.  
  1528.     ELSE IF Type=8 THEN
  1529.     BEGIN
  1530.     nPoints:=5;
  1531.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1532.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1533.         x[3]:=W;        y[3]:=a2;        r[3]:=0;
  1534.         x[4]:=W/2;    y[4]:=c;        r[4]:=-1;
  1535.         x[5]:=0;        y[5]:=a2;        r[5]:=0;
  1536.     END
  1537.  
  1538.     ELSE IF Type=9 THEN
  1539.     BEGIN
  1540.     nPoints:=5;
  1541.         x[1]:=0;            y[1]:=0;    r[1]:=rf;
  1542.         x[2]:=W/2-s5;    y[2]:=0;    r[2]:=rf;
  1543.         x[3]:=W/2-s5;    y[3]:=a5;    r[3]:=0;
  1544.         x[4]:=W/4;        y[4]:=a4;    r[4]:=-1;
  1545.         x[5]:=0;            y[5]:=a2;    r[5]:=0;
  1546.     END
  1547.  
  1548.     ELSE IF Type=10 THEN
  1549.     BEGIN
  1550.     nPoints:=8;
  1551.         x[1]:=0;            y[1]:=0;    r[1]:=rf;
  1552.         x[2]:=W;            y[2]:=0;    r[2]:=rf;
  1553.         x[3]:=W;            y[3]:=a2;    r[3]:=0;
  1554.         x[4]:=W-s4;        y[4]:=a4;    r[4]:=-1;
  1555.         x[5]:=W/2+s5;    y[5]:=a5;    r[5]:=0;
  1556.         x[6]:=W/2-s5;    y[6]:=a5;    r[6]:=0;
  1557.         x[7]:=s4;            y[7]:=a4;    r[7]:=-1;
  1558.         x[8]:=0;            y[8]:=a2;    r[8]:=0;
  1559.     END;
  1560.  
  1561.     Absolute;
  1562.     FillPat(1);
  1563.     MoveTo(x0,y0+OD/2);
  1564.     Relative;
  1565.     ClosePoly;
  1566.     IF Type=9 THEN w1:=W/2-s5
  1567.     ELSE w1:=W;
  1568.     BeginPoly;
  1569.         ArcTo(0,0,rf);
  1570.         ArcTo(w1,0,rf);
  1571.         ArcTo(0,-OD,rf);
  1572.         ArcTo(-w1,0,rf);
  1573.     EndPoly;
  1574.  
  1575.     IF ShowSection THEN FillPat(24)
  1576.     ELSE FillPat(1);
  1577.     Absolute;
  1578.     ClosePoly;
  1579.     j:=1;
  1580.     FOR m:=1 TO 2 DO
  1581.     BEGIN
  1582.         BeginPoly;
  1583.             FOR k:=1 TO nPoints DO
  1584.             BEGIN
  1585.                 x1:=x0+x[k];
  1586.                 y1:=y0-j*(OD/2-y[k]);
  1587.                 DrawPoint(x1,y1,r[k]);
  1588.             END;
  1589.         EndPoly;
  1590.         j:=-1;
  1591.     END;
  1592.  
  1593. {
  1594. Draw inner ring.
  1595. }
  1596.     IF Type=9 THEN
  1597.     BEGIN
  1598.         nPoints:=6;
  1599.         x[1]:=0;        y[1]:=ID/2+a1;    r[1]:=0;
  1600.         x[2]:=W/4;    y[2]:=ID/2+a8;    r[2]:=0;
  1601.         x[3]:=W/2;    y[3]:=ID/2+a3;    r[3]:=0;
  1602.         x[4]:=x[3];    y[4]:=-y[3];         r[4]:=0;
  1603.         x[5]:=x[2];    y[5]:=-y[2];         r[5]:=0;
  1604.         x[6]:=x[1];    y[6]:=-y[1];         r[6]:=0;
  1605.         FillPat(1);
  1606.         Absolute;
  1607.         ClosePoly;
  1608.         FillPat(1);
  1609.         BeginPoly;
  1610.             FOR k:=1 TO nPoints DO
  1611.             BEGIN
  1612.                 x1:=x0+x[k];
  1613.                 y1:=y0+y[k];
  1614.                 DrawPoint(x1,y1,r[k]);
  1615.             END;
  1616.         EndPoly;
  1617.     END;
  1618.  
  1619. IF (Type=1) OR (Type=2) THEN
  1620.     BEGIN
  1621.         nPoints:=8;
  1622.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1623.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1624.         x[3]:=W;        y[3]:=a1;        r[3]:=0;
  1625.         x[4]:=W-b;    y[4]:=a1;        r[4]:=0;
  1626.         x[5]:=W-b;    y[5]:=c;        r[5]:=0;
  1627.         x[6]:=b;        y[6]:=c;        r[6]:=0;
  1628.         x[7]:=b;        y[7]:=a1;        r[7]:=0;
  1629.         x[8]:=0;        y[8]:=a1;        r[8]:=0;
  1630.     END
  1631.  
  1632.     ELSE IF (Type=3) OR (Type=7) THEN
  1633.     BEGIN
  1634.     nPoints:=4;
  1635.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1636.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1637.         x[3]:=W;        y[3]:=c;        r[3]:=0;
  1638.         x[4]:=0;        y[4]:=c;        r[5]:=0;
  1639.     END
  1640.  
  1641.     ELSE IF Type=4 THEN
  1642.     BEGIN
  1643.     nPoints:=9;
  1644.         x[1]:=0;        y[1]:=0;        r[1]:=rf;
  1645.         x[2]:=W;        y[2]:=0;        r[2]:=rf;
  1646.         x[3]:=W;        y[3]:=a1;        r[3]:=0;
  1647.         x[4]:=W-b;    y[4]:=a1;        r[4]:=0;
  1648.         x[5]:=W-b;    y[5]:=a4;        r[5]:=0;
  1649.         x[6]:=W/2;    y[6]:=c;        r[6]:=-1;
  1650.         x[7]:=b;        y[7]:=a4;        r[7]:=0;
  1651.         x[8]:=b;        y[8]:=a1;        r[8]:=0;
  1652.         x[9]:=0;        y[9]:=a1;        r[9]:=0;
  1653.     END
  1654.  
  1655.     ELSE IF (Type=5) OR (Type=6) THEN
  1656.     BEGIN
  1657.         nPoints:=12;
  1658.         x[1]:=0;            y[1]:=0;
  1659.         x[2]:=W;            y[2]:=0;
  1660.         x[3]:=W;            y[3]:=a1;
  1661.         x[4]:=W-b;        y[4]:=a1;
  1662.         x[5]:=W-b;        y[5]:=c;
  1663.         x[6]:=2*b+wr;    y[6]:=c;
  1664.         x[7]:=2*b+wr;    y[7]:=a1;
  1665.         x[8]:=b+wr;        y[8]:=a1;
  1666.         x[9]:=b+wr;        y[9]:=c;
  1667.         x[10]:=b;            y[10]:=c;
  1668.         x[11]:=b;            y[11]:=a1;
  1669.         x[12]:=0;            y[12]:=a1;
  1670.  
  1671.         r[1]:=rf;
  1672.         r[2]:=rf;
  1673.         FOR k:=3 TO 12 DO
  1674.             r[k]:=0;
  1675.     END
  1676.  
  1677.     ELSE IF Type=8 THEN
  1678.     BEGIN
  1679.     nPoints:=8;
  1680.         x[1]:=0;            y[1]:=0;    r[1]:=rf;
  1681.         x[2]:=W;            y[2]:=0;    r[2]:=rf;
  1682.         x[3]:=W;            y[3]:=a6;    r[3]:=0;
  1683.         x[4]:=W/2+s4;    y[4]:=a6;    r[4]:=0;
  1684.         x[5]:=W/2+s5;    y[5]:=a3;    r[5]:=0;
  1685.         x[6]:=W/2-s5;    y[6]:=a3;    r[6]:=0;
  1686.         x[7]:=W/2-s4;    y[7]:=a6;    r[7]:=0;
  1687.         x[8]:=0;            y[8]:=a6;    r[8]:=0;
  1688.     END
  1689.  
  1690.     ELSE IF Type=9 THEN
  1691.     BEGIN
  1692.     nPoints:=5;
  1693.         x[1]:=0;        y[1]:=0;     r[1]:=rf;
  1694.         x[2]:=W/2;    y[2]:=0;     r[2]:=rf;
  1695.         x[3]:=W/2;    y[3]:=a3;     r[3]:=0;
  1696.         x[4]:=W/4;    y[4]:=a8;     r[4]:=-1;
  1697.         x[5]:=0;        y[5]:=a1;     r[5]:=0;
  1698.     END
  1699.  
  1700.     ELSE IF Type=10 THEN
  1701.     BEGIN
  1702.     nPoints:=5;
  1703.         x[1]:=0;        y[1]:=0;     r[1]:=rf;
  1704.         x[2]:=W;        y[2]:=0;     r[2]:=rf;
  1705.         x[3]:=W;        y[3]:=a1;     r[3]:=0;
  1706.         x[4]:=W/2;    y[4]:=a3;     r[4]:=r4;
  1707.         x[5]:=0;        y[5]:=a1;     r[5]:=0;
  1708.     END;
  1709.  
  1710.     IF ShowSection THEN FillPat(12)
  1711.     ELSE FillPat(1);
  1712.     Absolute;
  1713.     ClosePoly;
  1714.     j:=1;
  1715.     FOR m:=1 TO 2 DO
  1716.     BEGIN
  1717.         BeginPoly;
  1718.         FOR k:=1 TO nPoints DO
  1719.         BEGIN
  1720.             x1:=x0+x[k];
  1721.             y1:=y0-j*(ID/2+y[k]);
  1722.             DrawPoint(x1,y1,r[k]);
  1723.         END;
  1724.         EndPoly;
  1725.         j:=-1;
  1726.     END;
  1727.  
  1728. {
  1729. Draw rollers.
  1730. }
  1731.     j:=1;
  1732.     For m:=1 TO 2 DO
  1733.     BEGIN
  1734.         x1:=x0+W/2;
  1735.         y1:=y0+j*r2;
  1736.         IF (Type>4)AND(Type<>9) THEN
  1737.         BEGIN
  1738.             i:=1;
  1739.             FOR n:=1 TO 2 DO
  1740.             BEGIN
  1741.                 x2:=x1+i*s3;
  1742.                 Absolute;
  1743.                 MoveTo(x2,y1);
  1744.                 IF (Type=9) OR (Type=10) THEN
  1745.                     DrawRoller(dr2,dr,wr)
  1746.                 ELSE
  1747.                     DrawRoller(dr,dr2,wr);
  1748.                 IF (Type=8) OR (Type=10) THEN
  1749.                 BEGIN
  1750.                     Absolute;
  1751.                     RollerH:=LSActLayer;
  1752.                     HRotate(RollerH,x2, y1,Rad2Deg(-i*j*Alpha));
  1753.                 END;
  1754.                 i:=-1;
  1755.             END;
  1756.         END ELSE
  1757.         BEGIN
  1758.             Absolute;
  1759.             MoveTo(x1, y1);
  1760.             IF Type<>9 THEN
  1761.                 DrawRoller(dr,dr2,wr)
  1762.             ELSE BEGIN
  1763.                 x1:=x0+W/4;
  1764.                 Absolute;
  1765.                 MoveTo(x1, y1);
  1766.                 DrawRoller(dr2,dr,wr);
  1767.                 Absolute;
  1768.                 RollerH:=LSActLayer;
  1769.                 HRotate(RollerH,x1, y1,Rad2Deg(j*Alpha));
  1770.             END;
  1771.         END;
  1772.         j:=-1;
  1773.     END;
  1774.     GOTO 40;
  1775.  
  1776. {
  1777. Draw front view.
  1778. }
  1779.     30:FillPat(1);
  1780.     Phi:=ksp*dr/r2;
  1781.     NRollers:=2*PI/Phi-1;
  1782.     dPhi:=360/NRollers;
  1783.  
  1784.     DrawWasher(x0,y0,OD,ID);
  1785.  
  1786.     IF Type>=8 THEN
  1787.     BEGIN
  1788.         IF Type=8 THEN
  1789.             d1:=2*r8
  1790.         ELSE IF (Type=9)AND(View=2) THEN
  1791.             d1:=2*r6
  1792.         ELSE IF (Type=9)AND(View=3) THEN
  1793.             d1:=2*r10
  1794.         ELSE
  1795.             d1:=2*r4;
  1796.         DrawWasher(x0,y0,d1,ID);
  1797.     END;
  1798.  
  1799.     IF Type=10 THEN
  1800.         DrawWasher(x0,y0,2*r4,ID);
  1801.  
  1802.     IF (Type=9)AND(View=2) THEN
  1803.         r0:=r9
  1804.     ELSE IF (Type>=8) THEN
  1805.         r0:=r7
  1806.     ELSE r0:=r2;
  1807.  
  1808.     Phi:=-dPhi;
  1809.     FOR k:=1 TO NRollers DO
  1810.     BEGIN
  1811.         Phi:=Phi+dPhi;
  1812.         x1:=r0*Sin(Deg2Rad(Phi));
  1813.         y1:=r0*Cos(Deg2Rad(Phi));
  1814.         Absolute;
  1815.         MoveTo(x0+x1,y0+y1);
  1816.         Relative;
  1817.         Arc(-dr/2,dr/2,dr/2,-dr/2,0,360);
  1818.     END;
  1819.     IF (Type=9)AND(View=2) THEN
  1820.         d2:=2*r11
  1821.     ELSE    IF (Type=4)OR(Type>=8) THEN
  1822.         d2:=2*r6
  1823.     ELSE
  1824.         d2:=2*r3;
  1825.     DrawWasher(x0,y0,OD,d2);
  1826.  
  1827.     IF (Type=9)AND(View=2) THEN
  1828.         d1:=2*r10
  1829.     ELSE
  1830.         d1:=2*r1; 
  1831.     DrawWasher(x0,y0,d1,ID);
  1832.  
  1833.     40:Group;
  1834.     PopAttrs;
  1835.     GOTO 99;
  1836.  
  1837.     98:Sysbeep;
  1838.     AlrtDialog('That configuration is not possible!');
  1839.     GOTO 5;
  1840.  
  1841. 99:END;
  1842.  
  1843. Procedure TaperedRlrBrg;
  1844. {
  1845. ⌐1997, Diehl Graphsoft, Inc.
  1846. Developed by Tom Urie
  1847.  
  1848. This procedure draws the front or side view of tapered roller bearings.
  1849. }
  1850. LABEL 10,20,30,40,50,99;
  1851.  
  1852. CONST
  1853.     V1minC = 0.10;
  1854.     V2minC = 0.05;
  1855.     U1minC = 0.08;
  1856.     U2minC = 0.12;
  1857.     ThetaC = 15.0;
  1858.     rk1=0.25;
  1859.     rk2=0.25;
  1860.     rk3=0.25;
  1861.     rk4=2.5;
  1862.     kt1=0.30;
  1863.     kt2=0.50;
  1864.     kt3=1.50;
  1865.  
  1866. VAR
  1867.     ID,OD,W1,W2,x0,y0 : REAL;
  1868.     A1,A2,Alpha,Beta,Phi,dPhi,Theta,Theta1,Theta2 : REAL;
  1869.     xr1,yr1,xr2,yr2,xr3,yr3,xr4,yr4 : REAL;
  1870.     x1,y1,xrc,yrc,r1,r2,r3,r4,s,s1,t,cl : REAL;
  1871.     r0,rr1,rr2,rr3,rb1,rb2,rb3,rb4 : REAL;
  1872.     x,y,r,xt,yt,rt : ARRAY[1..14] OF REAL;
  1873.     m,U1min,U2min,V1min,V2min,os,sp,c : REAL;
  1874.     p1,p2,p3,p4,p5,p6,p7,p8,p9 : REAL;
  1875.     p10,p11,p12 : REAL;
  1876.     q1,q2,q3,q4,q5,q6,q7,q8,q9 : REAL;
  1877.     q10,q11,q12,q13,q14,q15,q16,q17,q18 : REAL;
  1878.  
  1879.     i,j,k,Type,View,nRollers : INTEGER;
  1880.  
  1881.     Abort,ShowSection,Inch : BOOLEAN;
  1882.     UPI : REAL;
  1883.     Fmt : INTEGER;
  1884.     UM,UM2 : STRING;
  1885.     UName,DA : LONGINT;
  1886.  
  1887. Procedure BearingDialog;
  1888. {
  1889. This procedure creates the dialog box.
  1890. }
  1891. VAR
  1892.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  1893.  
  1894. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  1895. VAR
  1896.     scrx1,scry1,scrx2,scry2:INTEGER;
  1897.  
  1898. BEGIN
  1899.     GetScreen(scrx1,scry1,scrx2,scry2);
  1900.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  1901.     x2:=x1+Width; 
  1902. END;
  1903.  
  1904. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  1905. {
  1906. This procedure locates the 'OK' and 'Cancel' buttons.
  1907. }
  1908. VAR
  1909.     v1,v2,v3,v4 : INTEGER;
  1910.     Mac : BOOLEAN;
  1911.  
  1912. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  1913. VAR
  1914.     Temp : INTEGER;
  1915. BEGIN
  1916.     Temp:=m1;
  1917.     m1:=m3;
  1918.     m3:=Temp;
  1919.     Temp:=m2;
  1920.     m2:=m4;
  1921.     m4:=Temp;
  1922. END;        {of Swap}
  1923.  
  1924. BEGIN
  1925.     Mac:=FALSE;
  1926.     GetVersion(v1,v2,v3,v4);
  1927.     IF v4 = 1 THEN Mac:=TRUE;
  1928.  
  1929.     IF DialogType = 1 THEN
  1930.     BEGIN
  1931.         px1:=(scnw DIV 2) - 80;
  1932.         px2:=(scnw DIV 2) - 10;
  1933.         px3:=(scnw DIV 2) + 10;
  1934.         px4:=(scnw DIV 2) + 80;
  1935.         IF Mac THEN SWAP(px1,px2,px3,px4);
  1936.  
  1937.         py1:=scnh-40;
  1938.         py2:=scnh-20;
  1939.         py3:=py1;
  1940.         py4:=py2;
  1941.     END ELSE IF DialogType = 2 THEN
  1942.     BEGIN
  1943.         px1:=scnw - 180;
  1944.         px2:=scnw - 110;
  1945.         px3:=scnw - 90;
  1946.         px4:=scnw - 20;
  1947.         IF Mac THEN SWAP(px1,px2,px3,px4);
  1948.  
  1949.         py1:=scnh-40;
  1950.         py2:=scnh-20;
  1951.         py3:=py1;
  1952.         py4:=py2;
  1953.     END ELSE
  1954.     BEGIN
  1955.         px1:=scnw - 90;
  1956.         px2:=scnw - 20;
  1957.         px3:=px1;
  1958.         px4:=px2;
  1959.  
  1960.         py1:=scnh -70;
  1961.         py2:=scnh - 50;
  1962.         py3:=scnh - 40;
  1963.         py4:=scnh - 20;
  1964.         IF Mac THEN SWAP(py1,py2,py3,py4);
  1965.     END;
  1966. END;        {of Locate Buttons}
  1967.  
  1968. Procedure MakeDialog;
  1969. {
  1970. This procedure defines the dialog.
  1971. }
  1972. CONST
  1973.     y1=100;
  1974.     scnw=360;
  1975.     scnh=340;
  1976.     DialogType = 2;
  1977.  
  1978. VAR
  1979.     h,h1 : INTEGER;
  1980.  
  1981. BEGIN
  1982.     AlignScr(scnw,x1,x2);
  1983.     y2:=y1+scnh;
  1984.     LocateButtons(DialogType,scnh,scnw);
  1985.  
  1986.     BeginDialog(1,1,x1,y1,x2,y2);
  1987.         AddButton('OK',1,1,px1,py1,px2,py2);
  1988.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  1989.  
  1990.         h:=35;
  1991.         AddField('Type:',17,1,20,44-h,120,60-h);
  1992.         AddButton('Single Row',14,3,20,65-h,120,80-h);
  1993.         AddButton('Two row, double cup single cone',15,3,20,85-h,250,100-h);
  1994.         AddButton('Two row, double cone single cup',16,3,20,105-h,250,120-h);
  1995.  
  1996.         AddField('View:',10,1,270,44-h,315,60-h);
  1997.         AddButton('Section',11,3,270,65-h,350,80-h);
  1998.         AddButton('Front',12,3,270,85-h,350,100-h);
  1999.         AddButton('Rear',13,3,270,105-h,350,120-h);
  2000.  
  2001.         h1:=5-h;
  2002.         AddField('Series:',22,1,20,h1+134,65,h1+150);
  2003.         AddButton('Inch',23,3,75,h1+135,125,h1+150);
  2004.         AddButton('Metric (mm)',24,3,135,h1+135,235,h1+150);
  2005.  
  2006.         AddField('Inside Diameter:',4,1,20,h1+164,175,h1+180);
  2007.         AddField('',5,2,180,h1+165,245,h1+180);
  2008.         AddField('in',35,1,255,h1+164,285,h1+180);
  2009.  
  2010.         AddField('Outside Diameter:',6,1,20,h1+189,175,h1+205);
  2011.         AddField('',7,2,180,h1+190,245,h1+205);
  2012.         AddField('in',36,1,255,h1+189,285,h1+205);
  2013.  
  2014.         AddField('Width of inner race:',8,1,20,h1+214,175,h1+230);
  2015.         AddField('',9,2,180,h1+215,245,h1+230);
  2016.         AddField('in',37,1,255,h1+214,285,h1+230);
  2017.  
  2018.         AddField('Width of outer race:',29,1,20,h1+239,175,h1+255);
  2019.         AddField('',30,2,180,h1+240,245,h1+255);
  2020.         AddField('in',38,1,255,h1+239,285,h1+255);
  2021.  
  2022.         AddField('Space between rows:',31,1,20,h1+264,175,h1+280);
  2023.         AddField('',32,2,180,h1+265,245,h1+280);
  2024.         AddField('in',39,1,255,h1+264,285,h1+280);
  2025.  
  2026.         h1:=h1+25;
  2027.         AddButton('Show Section Lines',20,2,20,h1+270,170,h1+285);
  2028.  
  2029.     EndDialog;
  2030. END;
  2031.  
  2032. BEGIN
  2033.     MakeDialog;
  2034. END;
  2035.  
  2036. Procedure GetInfo;
  2037. {
  2038. This procedure displays the dialog box and retrieves the information.
  2039. }
  2040. LABEL 10,15,20,25,30;
  2041.  
  2042. VAR
  2043.     Done,OK : BOOLEAN;
  2044.     Item,k : INTEGER;
  2045.     RFlag : ARRAY[1..3] OF INTEGER;
  2046.  
  2047. Procedure SetRButton(i,Item : INTEGER);
  2048. BEGIN
  2049.     IF NOT ItemSel(Item) THEN
  2050.     BEGIN
  2051.         SetItem(RFlag[i],FALSE);
  2052.         SetItem(Item,TRUE);
  2053.         RFlag[i]:=Item;
  2054.     END;
  2055. END;
  2056.  
  2057. BEGIN
  2058.     Done:=FALSE;
  2059.     Abort:=FALSE;
  2060.     View:=1;
  2061.     Type:=1;
  2062.     ShowSection:=TRUE;
  2063.     Inch:=TRUE;
  2064.  
  2065.     RFlag[1]:=Type+13;
  2066.     RFlag[2]:=11;
  2067.     RFlag[3]:=23;
  2068.  
  2069.     GetDialog(1);
  2070.     SetTitle('Tapered Roller Bearings');
  2071.     SetItem(RFlag[1],TRUE);
  2072.     SetItem(RFlag[2],TRUE);
  2073.     SetItem(RFlag[3],TRUE);
  2074.     SetItem(20,ShowSection);
  2075.  
  2076.     SetField(5,Num2Str(4,ID));
  2077.     SetField(7,Num2Str(4,OD));
  2078.     SetField(9,Num2Str(4,W1));
  2079.     SetField(30,Num2Str(4,W2));
  2080.     SetField(32,'<n/a>');
  2081.  
  2082.     10:SelField(5);
  2083.     GOTO 20;
  2084.     15:SelField(9);
  2085.     20:REPEAT
  2086.         DialogEvent(Item);
  2087.         IF Item=1 THEN
  2088.         Done:=TRUE;
  2089.  
  2090.         IF Item=2 THEN
  2091.         BEGIN
  2092.             Done:=TRUE;
  2093.             Abort:=TRUE;
  2094.         END;
  2095.  
  2096.         IF (Item>=11) AND (Item<=13) THEN
  2097.         BEGIN
  2098.             SetRButton(2,Item);
  2099.             View:=Item-10;
  2100.         END;
  2101.  
  2102.         IF (Item>=14) AND (Item<=16) THEN
  2103.         BEGIN
  2104.             SetRButton(1,Item);
  2105.             Type:=Item-13;
  2106.             IF Item=15 THEN
  2107.                 SetField(32,Num2StrF(sp))
  2108.             ELSE
  2109.                 SetField(32,'<n/a>');
  2110.         END;
  2111.  
  2112.         IF Item=20 THEN
  2113.         BEGIN
  2114.             ShowSection:=NOT ShowSection;
  2115.             SetItem(Item,ShowSection);
  2116.         END;
  2117.  
  2118.         IF (Item=23) AND (NOT ItemSel(23)) THEN
  2119.         BEGIN
  2120.             SetRButton(3,Item);
  2121.             FOR k:=35 TO 39 DO
  2122.                 SetField(k,'in');
  2123.             Inch:=TRUE;
  2124.         END;
  2125.  
  2126.         IF (Item=24) AND (NOT ItemSel(24))THEN
  2127.         BEGIN
  2128.             SetRButton(3,Item);
  2129.             FOR k:=35 TO 39 DO
  2130.                 SetField(k,'mm');
  2131.         Inch:=FALSE;
  2132.     END;
  2133.  
  2134.     UNTIL DONE;
  2135.  
  2136.     IF Abort THEN GOTO 30;
  2137.     OK:=ValidNumStr(GetField(5),ID);
  2138.     OK:=ValidNumStr(GetField(7),OD);
  2139.     OK:=ValidNumStr(GetField(9),W1);
  2140.     OK:=ValidNumStr(GetField(30),W2);
  2141.     OK:=ValidNumStr(GetField(32),sp);
  2142.  
  2143.     IF ID < OD THEN GOTO 25;
  2144.     SysBeep;
  2145.     AlrtDialog('ID must be less than OD!');
  2146.     Done:=FALSE;
  2147.     GOTO 10;
  2148.  
  2149.     25:IF W2 <= W1 THEN GOTO 30;
  2150.     SysBeep;
  2151.     AlrtDialog('Width of outer race must be less than or equal to inner race!');
  2152.     Done:=FALSE;
  2153.     GOTO 15;
  2154.  
  2155.     30:ClrDialog;
  2156. END;
  2157.  
  2158. Procedure DrawWasher(x0,y0,OD,ID:REAL);
  2159.  
  2160. VAR
  2161.     r1,r2 : REAL;
  2162.     x,y,r : ARRAY[1..13] OF REAL;
  2163.     n : INTEGER;
  2164.  
  2165. BEGIN
  2166.     r1:=OD/2;
  2167.     r2:=ID/2;
  2168.     x[1]:=0;        y[1]:=r1;        r[1]:=0;
  2169.     x[2]:=r1;        y[2]:=r1;        r[2]:=r1;
  2170.     x[3]:=r1;        y[3]:=-r1;    r[3]:=r1;
  2171.     x[4]:=-r1;    y[4]:=-r1;    r[4]:=r1;
  2172.     x[5]:=-r1;    y[5]:=r1;        r[5]:=r1;
  2173.     x[6]:=0;        y[6]:=r1;        r[6]:=0;
  2174.     x[7]:=0;        y[7]:=r2;        r[7]:=-1;
  2175.     x[8]:=-r2;    y[8]:=r2;        r[8]:=r2;
  2176.     x[9]:=-r2;    y[9]:=-r2;    r[9]:=r2;
  2177.     x[10]:=r2;    y[10]:=-r2;    r[10]:=r2;
  2178.     x[11]:=r2;    y[11]:=r2;    r[11]:=r2;
  2179.     x[12]:=0;        y[12]:=r2;    r[12]:=0;
  2180.     x[13]:=0;        y[13]:=r1;    r[13]:=-1;
  2181.  
  2182.     Absolute;
  2183.     MoveTo(x0,y0);
  2184.     OpenPoly;
  2185.     BeginPoly;
  2186.         FOR n:=1 TO 13 DO
  2187.         BEGIN
  2188.             x[n]:=x[n]+x0;
  2189.             y[n]:=y[n]+y0;
  2190.             IF r[n]<0 THEN
  2191.                 MoveTo(x[n],y[n])
  2192.             ELSE IF r[n]=0 THEN
  2193.                 LineTo(x[n],y[n])
  2194.             ELSE
  2195.                 ArcTo(x[n],y[n],r[n]);
  2196.         END;
  2197.     EndPoly;
  2198. END;
  2199.  
  2200. Procedure DrawPoly(NPoints:INTEGER);
  2201. VAR
  2202.     k : INTEGER;
  2203.  
  2204. BEGIN
  2205.     Absolute;
  2206.     MoveTo(xt[1],yt[1]);
  2207.     BeginPoly;
  2208.         FOR k:=1 TO Npoints DO
  2209.         BEGIN
  2210.             IF r[k]<0 THEN
  2211.                 MoveTo(xt[k],yt[k])
  2212.             ELSE IF r[k]=0 THEN
  2213.                 LineTo(xt[k],yt[k])
  2214.             ELSE
  2215.                 ArcTo(xt[k],yt[k],r[k]);
  2216.         END;
  2217.     EndPoly;
  2218. END;
  2219.  
  2220. {
  2221. Main program.
  2222. }
  2223. BEGIN
  2224.     PushAttrs;
  2225. {
  2226. Display dialog box and get information.
  2227. }
  2228.     OD:=2.375;
  2229.     ID:=1.125;
  2230.     W1:=1.0000;
  2231.     W2:=0.87500;
  2232.     sp:=0.1250;
  2233.  
  2234.     BearingDialog;
  2235.     SetCursor(ArrowC);
  2236.     GetInfo;
  2237.     IF Abort THEN GOTO 99;
  2238.     DSelectAll;
  2239.     GetPt(x0,y0);
  2240. {
  2241. Get units per inch and adjust parameters.
  2242. }
  2243.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  2244.     IF Inch THEN
  2245.     BEGIN
  2246.         ID:=ID*UPI;
  2247.         OD:=OD*UPI;
  2248.         W1:=W1*UPI;
  2249.         W2:=W2*UPI;
  2250.     END ELSE
  2251.     BEGIN
  2252.         ID:=ID*UPI/25.4;
  2253.         OD:=OD*UPI/25.4;
  2254.         W1:=W1*UPI/25.4;
  2255.         W2:=W2*UPI/25.4;
  2256.     END;
  2257. {
  2258. Determine roller size and calculate bearing dimensions.
  2259. }
  2260.     IF Type=2 THEN
  2261.     BEGIN
  2262.         c:=0;
  2263.         sp:=sp/2;
  2264.         W1:=W1/2-sp;
  2265.         W2:=W2/2-sp;
  2266.     END ELSE IF Type=3 THEN
  2267.     BEGIN
  2268.         sp:=0;
  2269.         W1:=W1/2;
  2270.         W2:=W2/2;
  2271.         c:=W1;
  2272.     END ELSE
  2273.     BEGIN
  2274.         sp:=0;
  2275.         c:=0;
  2276.     END;
  2277.  
  2278.     Theta:=Deg2Rad(ThetaC);
  2279.     xrc:=-(W1+W2)/4;
  2280.     yrc:=+(OD+ID)/4;
  2281.     m:=(OD+ID)/(4*Tan(Theta)) - (W1+W2)/4;
  2282.     U1min:=U1minC*(OD-ID)/2;
  2283.     U2min:=U2minC*(OD-ID)/2;
  2284.     V1min:=V1minC*W1;
  2285.     V2min:=V2minC*W2;
  2286.     Theta1:=ArcTan((ID/2+U1min)/m);
  2287.     Theta2:=ArcTan((OD/2-U2min)/(m+W2-V2min));
  2288.     Alpha:=Theta-Theta1;
  2289.     IF (Theta2-Theta)<Alpha THEN
  2290.         Alpha:=Theta2-Theta;
  2291.     Theta1:=Theta-Alpha;
  2292.     Theta2:=Theta+Alpha;
  2293.     xr1:=V2min;
  2294.     yr1:=(m+V2min)*Tan(Theta2);
  2295.     p1:=xr1;
  2296.     p2:=W2-2*p1;
  2297.     q1:=p1*Tan(Theta2);
  2298.     q7:=yr1-m*Tan(Theta);
  2299.     q5:=q7-p1*Tan(Theta);
  2300.     rr1:=q5*Cos(Theta);
  2301.     p4:=rr1*Sin(Theta);
  2302.     q4:=rr1*Cos(Theta);
  2303.     xr4:=xr1+2*p4;
  2304.     yr4:=yr1-2*q4;
  2305.     s1:=p2/Cos(Theta2);
  2306.     p3:=s1*Cos(Theta1);
  2307.     q3:=s1*Sin(Theta1);
  2308.     xr3:=p3+xr4;
  2309.     IF (W1-xr3) < V1min THEN BEGIN
  2310.         xr3:=W1-V1min;
  2311.         p3:=xr3-xr4;
  2312.         s1:=p3/Cos(Theta1);
  2313.         q3:=s1*Sin(Theta1);
  2314.         p2:=s1*Cos(Theta2);
  2315.     END;
  2316.     yr3:=yr4+q3;
  2317.     q2:=p2*Tan(Theta2);
  2318.     xr2:=p2+xr1;
  2319.     yr2:=yr1+q2;
  2320.     rr2:=(yr2-yr3)/(2*Cos(Theta));
  2321.     q8:=OD/2-m*Tan(Theta)-q7+q1;
  2322.     q9:=q8-W2*Tan(Theta2);
  2323.     t:=kt1*rr1;
  2324.     cl:=kt2*V1min;
  2325.     os:=kt3*t;
  2326.     p8:=t*Sin(Theta2);
  2327.     q6:=rk3*rr2;    
  2328.     p6:=q6*Tan(Theta);
  2329.     p11:=W1-xr3+p6;
  2330.     p7:=t+W1-p11/2-t*Sin(Theta2);
  2331.     p9:=p7+p8-t;
  2332.     q10:=t*Tan(Theta2);
  2333.     q11:=p7*Tan(Theta2);
  2334.     q13:=yr1-m*Tan(Theta)-q1;
  2335.     q12:=q13-q10;
  2336.     q14:=t*Cos(Theta2);
  2337.     q15:=p9*Tan(Theta2);
  2338.     q18:=rk3*rr1;
  2339.     p12:=q18*Tan(Theta);
  2340.     p10:=xr4-p12;
  2341.     q16:=yr4-ID/2+q18;
  2342.     q17:=yr3-ID/2+q6;
  2343.     r1:=rk1*q8;
  2344.     r2:=rk2*q17;
  2345.     r3:=2*t;
  2346.     r4:=t;
  2347. {
  2348. Draw bearing.
  2349. }
  2350.     IF (View=2) OR (View=3) THEN GOTO 40;
  2351. {
  2352. Section view.
  2353. }
  2354.     i:=1;
  2355.     j:=1;
  2356. {
  2357. Draw outer race.
  2358. }
  2359.     10:
  2360.     x[1]:=0;            y[1]:=OD/2-q8;
  2361.     x[2]:=-W2;        y[2]:=OD/2-q9;
  2362.     x[3]:=x[2];        y[3]:=OD/2;
  2363.     x[4]:=0;            y[4]:=y[3];
  2364.     FOR k:=1 TO 4 DO
  2365.     BEGIN
  2366.         xt[k]:=x0+i*(x[k]-sp+c);
  2367.         yt[k]:=y0+j*y[k];
  2368.         r[k]:=0;
  2369.     END;
  2370.     r[4]:=r1;
  2371.  
  2372.     IF j=1 THEN
  2373.     BEGIN
  2374.         FillPat(1);
  2375.         Rect(xt[2],yt[2],xt[1],2*y0-yt[2]);
  2376.     END;
  2377.     IF (Type=2)AND(i=1)AND(j=1) THEN
  2378.     BEGIN
  2379.         FillPat(1);
  2380.         Rect(xt[4],yt[4]-r1, xt[4]+2*sp,2*y0-(yt[4]-r1));
  2381.     END;
  2382.     Absolute;
  2383.     IF ShowSection THEN FillPat(24)
  2384.     ELSE FillPat(1);
  2385.     ClosePoly;
  2386.     DrawPoly(4);
  2387. {
  2388. Draw retainer.
  2389. }
  2390.     x[1]:=0;            y[1]:=m*Tan(Theta);
  2391.     x[2]:=x[1]+t;     y[2]:=y[1];
  2392.     x[3]:=x[2];        y[3]:=y[1]+q12;
  2393.     x[4]:=x[3]-p7;    y[4]:=y[3]+q11;
  2394.     x[5]:=x[4]-p8;    y[5]:=y[4]-q14;
  2395.     x[6]:=x[1];        y[6]:=y[5]-q15;
  2396.     FOR k:=1 TO 6 DO
  2397.     BEGIN
  2398.         xt[k]:=x0+i*(x[k]-sp+c);
  2399.         yt[k]:=y0+j*(y[k]-os);
  2400.         r[k]:=0;
  2401.     END;
  2402.     r[3]:=r3;
  2403.     r[6]:=r4;
  2404.  
  2405.     IF j=1 THEN
  2406.     BEGIN
  2407.         FillPat(1);
  2408.         Poly(xt[5],yt[5], xt[2],yt[6], xt[2],2*y0-yt[6], xt[5],2*y0-yt[5]);
  2409.         Rect(xt[1],yt[1], xt[2],2*y0-yt[2]);
  2410.     END;
  2411.     IF ShowSection THEN FillPat(2)
  2412.     ELSE FillPat(1);
  2413.     ClosePoly;
  2414.     DrawPoly(6);
  2415. {
  2416. Draw inner race.
  2417. }
  2418.     x[1]:=0;                    y[1]:=ID/2+q16;
  2419.     x[2]:=-p10;                y[2]:=y[1];
  2420.     x[3]:=x[2]-p12;        y[3]:=y[2]-q18;
  2421.     x[4]:=-(W1-p11+p6);    y[4]:=ID/2+q17-q6;
  2422.     x[5]:=x[4]+p6;            y[5]:=ID/2+q17;
  2423.     x[6]:=-W1;                y[6]:=y[5];
  2424.     x[7]:=-W1;                y[7]:=ID/2;
  2425.     x[8]:=0;                    y[8]:=ID/2;
  2426.  
  2427.     IF Type <> 3 THEN BEGIN
  2428.         FOR k:=1 TO 8 DO
  2429.         BEGIN
  2430.             xt[k]:=x0+i*(x[k]-sp+c);
  2431.             yt[k]:=y0+j*y[k];
  2432.             r[k]:=0;
  2433.         END;
  2434.         r[7]:=r2;
  2435.  
  2436.         IF j=1 THEN
  2437.         BEGIN
  2438.             FillPat(1);
  2439.             Rect(xt[1],yt[1],xt[6],2*y0-yt[1]);
  2440.         END;
  2441.         IF ShowSection THEN FillPat(12)
  2442.           ELSE FillPat(1);
  2443.         DrawPoly(8);
  2444.     END ELSE IF (i=-1) THEN
  2445.     BEGIN
  2446.         FOR k:=1 TO 5 DO
  2447.         BEGIN
  2448.             xt[k]:=x0+i*(x[k]-sp+c);
  2449.             yt[k]:=y0+j*y[k];
  2450.             r[k]:=0;
  2451.         END;
  2452.         FOR k:=6 TO 10 DO
  2453.         BEGIN
  2454.             xt[k]:=x0-i*(x[11-k]-sp+c);
  2455.             yt[k]:=y0+j*y[11-k];
  2456.             r[k]:=r[11-k];
  2457.         END;
  2458.         xt[11]:=x0-i*(x[8]-sp+c);
  2459.         yt[11]:=y0+j*y[8];
  2460.         r[11]:=0;
  2461.         xt[12]:=x0+i*(x[8]-sp+c);
  2462.         yt[12]:=y0+j*y[8];
  2463.         r[12]:=0;
  2464.  
  2465.         IF j=1 THEN
  2466.         BEGIN
  2467.             FillPat(1);
  2468.             Rect(xt[1],yt[1], xt[11],2*y0-yt[1]);
  2469.         END;
  2470.         IF ShowSection THEN FillPat(12)
  2471.           ELSE FillPat(1);
  2472.         ClosePoly;
  2473.         DrawPoly(12);
  2474.     END;
  2475.  
  2476. {
  2477. Draw rollers.
  2478. }
  2479.     x[1]:=-xr1;    y[1]:=yr1;    r[1]:=0;
  2480.     x[2]:=-xr2;    y[2]:=yr2;    r[2]:=0;
  2481.     x[3]:=-xr3;    y[3]:=yr3;    r[3]:=0;
  2482.     x[4]:=-xr4;    y[4]:=yr4;    r[4]:=0;
  2483.     Absolute;
  2484.     FOR k:=1 TO 4 DO
  2485.     BEGIN
  2486.         xt[k]:=x0+i*(x[k]-sp+c);
  2487.         yt[k]:=y0+j*y[k];
  2488.     END;
  2489.     FillPat(1);
  2490.     ClosePoly;
  2491.     Absolute;
  2492.     DrawPoly(4);
  2493.     IF j=-1 THEN GOTO 20;
  2494.     j:=-1;
  2495.     GOTO 10;
  2496.     20:IF (i=-1) OR (Type=1) THEN GOTO 30;
  2497.     i:=-1;
  2498.     j:=1;
  2499.     GOTO 10;
  2500. {
  2501. Draw rear view.
  2502. }
  2503.     40:FillPat(1);
  2504.     IF ((View=2)AND(Type<>2)) OR (Type=3) THEN GOTO 50;
  2505.     rr3:=rr2*Cos(Theta);
  2506.     r0:=yr3+rr3;
  2507.     rb3:=OD/2-q9;
  2508.     Phi:=rk4*rr3/r0;
  2509.     NRollers:=2*PI/Phi;
  2510.     dPhi:=360/NRollers;
  2511.  
  2512.     FillPat(1);
  2513.     DrawWasher(x0,y0,OD,ID);
  2514.     FillPat(0);
  2515.     Absolute;
  2516.     MoveTo(x0,y0);
  2517.     Relative;
  2518.     Arc(-rb3,rb3,rb3,-rb3,0,360);
  2519.  
  2520.     Phi:=-dPhi;
  2521.     FOR k:=1 TO NRollers DO
  2522.     BEGIN
  2523.         Phi:=Phi+dPhi;
  2524.         x1:=r0*Sin(Deg2Rad(Phi));
  2525.         y1:=r0*Cos(Deg2Rad(Phi));
  2526.         Absolute;
  2527.         MoveTo(x0+x1,y0+y1);
  2528.         Relative;
  2529.         Arc(-rr3,rr3,rr3,-rr3,0,360);
  2530.     END;
  2531.  
  2532.     rb1:=m*Tan(Theta)-os+q11+q12;
  2533.     rb2:=rb1-t*Cos(Theta2);
  2534.     FillPat(1);
  2535.     DrawWasher(x0,y0,2*rb1,2*rb2);
  2536.     rb1:=ID/2+q17;
  2537.     rb2:=ID/2;
  2538.     DrawWasher(x0,y0,2*rb1,2*rb2);
  2539.     GOTO 30;
  2540. {
  2541. Draw front view.
  2542. }
  2543.     50:FillPat(1);
  2544.     DrawWasher(x0,y0,OD,ID);
  2545.     Absolute;
  2546.     rb1:=OD/2-q8;
  2547.     rb2:=ID/2+q16;
  2548.     MoveTo(x0,y0);
  2549.     Relative;
  2550.     FillPat(0);
  2551.     Arc(-rb1,rb1,rb1,-rb1,0,360);
  2552.     Arc(-rb2,rb2,rb2,-rb2,0,360);
  2553.     30:Group;
  2554.     PopAttrs;
  2555. 99:END;        {of TaperedRlrBrg}
  2556.  
  2557. Procedure ThrustBrg;
  2558. {
  2559. ⌐1996, Diehl Graphsoft, Inc.
  2560. Developed by Tom Urie
  2561.  
  2562. This procedure draws the front or side view of tapered roller bearings.
  2563. }
  2564. LABEL 99;
  2565.  
  2566. CONST
  2567.     nPoints = 6;
  2568.     k1 = 0.25;    {Radius of ball or roller}
  2569.     k2 = 0.75;    {Small radius of tapered roller}
  2570.     k3 = 0.125;    {Fillet radius}
  2571.     k4 = 1.25;    {Space between washers}
  2572.     k5 = 0.94;    {Width of spacer}
  2573.     k6 = 0.63;    {Thickness of spacer}
  2574.     k7 = 0.75;    {Length of roller}
  2575.     k8 = 0.5;        {Shape of spherical roller}
  2576.  
  2577. VAR
  2578.     ID,OD,T,T1,T2,tw,x0,y0,x1,y1 : REAL;
  2579.     rf,rr1,rr2,rr3,s,w,wr,hr : REAL;
  2580.     dRoller,ll,lr,idRet,odRet : REAL;
  2581.     x,y,r : ARRAY[1..nPoints] OF REAL;
  2582.  
  2583.     i,j,k,m,Style,Type,View,nWashers : INTEGER;
  2584.     Abort,ShowSect,Inch : BOOLEAN;
  2585.  
  2586.     UPI : REAL;
  2587.     Fmt : INTEGER;
  2588.     UM,UM2 : STRING;
  2589.     UName,DA : LONGINT;
  2590.  
  2591. Procedure BearingDialog;
  2592. {
  2593. This procedure creates the dialog box.
  2594. }
  2595. VAR
  2596.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  2597.  
  2598. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  2599. VAR
  2600.     scrx1,scry1,scrx2,scry2:INTEGER;
  2601.  
  2602. BEGIN
  2603.     GetScreen(scrx1,scry1,scrx2,scry2);
  2604.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  2605.     x2:=x1+Width; 
  2606. END;
  2607.  
  2608. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  2609. {
  2610. This procedure locates the 'OK' and 'Cancel' buttons.
  2611. }
  2612. VAR
  2613.     v1,v2,v3,v4 : INTEGER;
  2614.     Mac : BOOLEAN;
  2615.  
  2616. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  2617. VAR
  2618.     Temp : INTEGER;
  2619. BEGIN
  2620.     Temp:=m1;
  2621.     m1:=m3;
  2622.     m3:=Temp;
  2623.     Temp:=m2;
  2624.     m2:=m4;
  2625.     m4:=Temp;
  2626. END;        {of Swap}
  2627.  
  2628. BEGIN
  2629.     Mac:=FALSE;
  2630.     GetVersion(v1,v2,v3,v4);
  2631.     IF v4 = 1 THEN Mac:=TRUE;
  2632.  
  2633.     IF DialogType = 1 THEN
  2634.     BEGIN
  2635.         px1:=(scnw DIV 2) - 80;
  2636.         px2:=(scnw DIV 2) - 10;
  2637.         px3:=(scnw DIV 2) + 10;
  2638.         px4:=(scnw DIV 2) + 80;
  2639.         IF Mac THEN SWAP(px1,px2,px3,px4);
  2640.  
  2641.         py1:=scnh-40;
  2642.         py2:=scnh-20;
  2643.         py3:=py1;
  2644.         py4:=py2;
  2645.     END ELSE IF DialogType = 2 THEN
  2646.     BEGIN
  2647.         px1:=scnw - 180;
  2648.         px2:=scnw - 110;
  2649.         px3:=scnw - 90;
  2650.         px4:=scnw - 20;
  2651.         IF Mac THEN SWAP(px1,px2,px3,px4);
  2652.  
  2653.         py1:=scnh-40;
  2654.         py2:=scnh-20;
  2655.         py3:=py1;
  2656.         py4:=py2;
  2657.     END ELSE
  2658.     BEGIN
  2659.         px1:=scnw - 90;
  2660.         px2:=scnw - 20;
  2661.         px3:=px1;
  2662.         px4:=px2;
  2663.  
  2664.         py1:=scnh -70;
  2665.         py2:=scnh - 50;
  2666.         py3:=scnh - 40;
  2667.         py4:=scnh - 20;
  2668.         IF Mac THEN SWAP(py1,py2,py3,py4);
  2669.     END;
  2670. END;        {of Locate Buttons}
  2671.  
  2672. Procedure MakeDialog;
  2673. CONST
  2674.     y1=100;
  2675.     scnw=310;
  2676.     scnh=370;
  2677.     DialogType = 2;
  2678.  
  2679. VAR
  2680.     h,h1 : INTEGER;
  2681.  
  2682. BEGIN
  2683.     AlignScr(scnw,x1,x2);
  2684.     y2:=y1+scnh;
  2685.     LocateButtons(DialogType,scnh,scnw);
  2686.  
  2687.     BeginDialog(1,1,x1,y1,x2,y2);
  2688.         AddButton('OK',1,1,px1,py1,px2,py2);
  2689.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  2690.  
  2691.         h:=35;
  2692.         AddField('Type:',21,1,20,44-h,100,60-h);
  2693.         AddButton('Single Ball',22,3,20,65-h,130,80-h);
  2694.         AddButton('Double Ball',23,3,20,85-h,130,100-h);
  2695.         AddButton('Roller',24,3,20,105-h,100,120-h);
  2696.         AddButton('Tapered Roller',25,3,20,125-h,140,140-h);
  2697.         AddButton('Spherical Roller',26,3,20,145-h,140,160-h);
  2698.  
  2699.  
  2700. AddField('Style of Raceways:',30,1,160,44-h,290,60-h);
  2701.         AddButton('Grooved',31,3,160,65-h,240,80-h);
  2702.         AddButton('Flat',32,3,160,85-h,240,100-h);
  2703.  
  2704.     h1:=40-h;
  2705.         AddField('Series:',8,1,20,h1+134,65,h1+150);
  2706.         AddButton('Inch',9,3,75,h1+135,125,h1+150);
  2707.         AddButton('Metric (mm)',10,3,135,h1+135,235,h1+150);
  2708.  
  2709.  
  2710.         AddField('Inside Diameter:',11,1,20,h1+164,145,h1+180);
  2711.         AddField('',12,2,160,h1+165,225,h1+180);
  2712.  
  2713.         AddField('Outside Diameter:',13,1,20,h1+189,145,h1+205);
  2714.         AddField('',14,2,160,h1+190,225,h1+205);
  2715.  
  2716.         AddField('Thickness:',15,1,20,h1+214,145,h1+230);
  2717.         AddField('',16,2,160,h1+215,225,h1+230);
  2718.  
  2719. AddField('in',17,1,235,h1+164,265,h1+180);
  2720.         AddField('in',18,1,235,h1+189,265,h1+205);
  2721.         AddField('in',19,1,235,h1+214,265,h1+230);
  2722.  
  2723.         h1:=60-h;
  2724.         AddField('View:',5,1,20,229+h1,60,245+h1);
  2725.         AddButton('Section',6,3,70,230+h1,135,245+h1);
  2726.         AddButton('Top',7,3,145,230+h1,200,245+h1);
  2727.  
  2728.         h1:=70-h;
  2729.         AddButton('Show Section Lines',20,2,20,h1+250,170,h1+265);
  2730.  
  2731.     EndDialog;
  2732. END;
  2733.  
  2734. BEGIN
  2735.     MakeDialog;
  2736. END;
  2737.  
  2738. Procedure GetInfo;
  2739. {
  2740. This procedure displays the dialog box and retrieves the information.
  2741. }
  2742. LABEL 10,25,30;
  2743.  
  2744. VAR
  2745.     Done,OK : BOOLEAN;
  2746.     Item,k : INTEGER;
  2747.     RFlag : ARRAY[1..4] OF INTEGER;
  2748.  
  2749. Procedure SetRButton(i,Item : INTEGER);
  2750. BEGIN
  2751.     IF NOT ItemSel(Item) THEN
  2752.     BEGIN
  2753.         SetItem(RFlag[i],FALSE);
  2754.         SetItem(Item,TRUE);
  2755.         RFlag[i]:=Item;
  2756.     END;
  2757. END;
  2758.  
  2759. BEGIN
  2760.     Done:=FALSE;
  2761.     Abort:=FALSE;
  2762.     View:=1;
  2763.     Type:=1;
  2764.     Style:=1;
  2765.     ShowSect:=TRUE;
  2766.     Inch:=TRUE;
  2767.  
  2768.     RFlag[1]:=Type+21;
  2769.     RFlag[2]:=View+5;
  2770.     RFlag[3]:=9;
  2771.     RFlag[4]:=Style+30;
  2772.  
  2773.     GetDialog(1);
  2774.     SetTitle('Thrust Bearings');
  2775.  
  2776.     SetItem(RFlag[1],TRUE);
  2777.     SetItem(RFlag[2],TRUE);
  2778.     SetItem(RFlag[3],TRUE);
  2779.     SetItem(RFlag[4],TRUE);
  2780.  
  2781.     SetItem(20,ShowSect);
  2782.     SetField(12,Num2Str(4,ID));
  2783.     SetField(14,Num2Str(4,OD));
  2784.     SetField(16,Num2Str(4,T));
  2785.  
  2786.     10:SelField(12);
  2787.     REPEAT
  2788.         DialogEvent(Item);
  2789.         IF Item=1 THEN
  2790.         Done:=TRUE;
  2791.  
  2792.         IF Item=2 THEN
  2793.         BEGIN
  2794.             Done:=TRUE;
  2795.             Abort:=TRUE;
  2796.         END;
  2797.  
  2798.         IF (Item=6) OR (Item=7) THEN
  2799.         BEGIN
  2800.             SetRButton(2,Item);
  2801.             View:=Item-5;
  2802.         END;
  2803.  
  2804.         IF (Item=9) AND (NOT ItemSel(9)) THEN
  2805.         BEGIN
  2806.             SetRButton(3,Item);
  2807.             FOR k:=17 TO 19 DO
  2808.                 SetField(k,'in');
  2809.             Inch:=TRUE;
  2810.         END;
  2811.  
  2812.         IF (Item=10) AND (NOT ItemSel(10))THEN
  2813.         BEGIN
  2814.             SetRButton(3,Item);
  2815.             FOR k:=17 TO 19 DO
  2816.                 SetField(k,'mm');
  2817.             Inch:=FALSE;
  2818.         END;
  2819.  
  2820.         IF Item=20 THEN
  2821.         BEGIN
  2822.             ShowSect:=NOT ShowSect;
  2823.             SetItem(Item,ShowSect);
  2824.         END;
  2825.  
  2826.         IF (Item>=21) AND (Item<=27) THEN
  2827.         BEGIN
  2828.             SetRButton(1,Item);
  2829.             Type:=Item-21;
  2830.         END;
  2831.  
  2832.         IF (Item=31) OR (Item=32) THEN
  2833.         BEGIN
  2834.             SetRButton(4,Item);
  2835.             Style:=Item-30;
  2836.         END;
  2837.  
  2838.     UNTIL DONE;
  2839.  
  2840.     IF Abort THEN GOTO 30;
  2841.     OK:=ValidNumStr(GetField(12),ID);
  2842.     OK:=ValidNumStr(GetField(14),OD);
  2843.     OK:=ValidNumStr(GetField(16),T);
  2844.     IF ID < OD THEN GOTO 30;
  2845.  
  2846.     SysBeep;
  2847.     AlrtDialog('ID must be less than OD!');
  2848.     Done:=FALSE;
  2849.     GOTO 10;
  2850.  
  2851.     30:ClrDialog;
  2852. END;
  2853.  
  2854. Procedure DrawWasher(x0,y0,OD,ID:REAL);
  2855.  
  2856. VAR
  2857.     r1,r2 : REAL;
  2858.     x,y,r : ARRAY[1..13] OF REAL;
  2859.     n : INTEGER;
  2860.  
  2861. BEGIN
  2862.     r1:=OD/2;
  2863.     r2:=ID/2;
  2864.     x[1]:=0;        y[1]:=r1;        r[1]:=0;
  2865.     x[2]:=r1;        y[2]:=r1;        r[2]:=r1;
  2866.     x[3]:=r1;        y[3]:=-r1;    r[3]:=r1;
  2867.     x[4]:=-r1;    y[4]:=-r1;    r[4]:=r1;
  2868.     x[5]:=-r1;    y[5]:=r1;        r[5]:=r1;
  2869.     x[6]:=0;        y[6]:=r1;        r[6]:=0;
  2870.     x[7]:=0;        y[7]:=r2;        r[7]:=-1;
  2871.     x[8]:=-r2;    y[8]:=r2;        r[8]:=r2;
  2872.     x[9]:=-r2;    y[9]:=-r2;    r[9]:=r2;
  2873.     x[10]:=r2;    y[10]:=-r2;    r[10]:=r2;
  2874.     x[11]:=r2;    y[11]:=r2;    r[11]:=r2;
  2875.     x[12]:=0;        y[12]:=r2;    r[12]:=0;
  2876.     x[13]:=0;        y[13]:=r1;    r[13]:=-1;
  2877.  
  2878.     Absolute;
  2879.     MoveTo(x0,y0);
  2880.     OpenPoly;
  2881.     BeginPoly;
  2882.         FOR n:=1 TO 13 DO
  2883.         BEGIN
  2884.             x[n]:=x[n]+x0;
  2885.             y[n]:=y[n]+y0;
  2886.             IF r[n]<0 THEN
  2887.                 MoveTo(x[n],y[n])
  2888.             ELSE IF r[n]=0 THEN
  2889.                 LineTo(x[n],y[n])
  2890.             ELSE
  2891.                 ArcTo(x[n],y[n],r[n]);
  2892.         END;
  2893.     EndPoly;
  2894. END;
  2895.  
  2896. Procedure DrawPoint(x,y,r:REAL);
  2897. BEGIN
  2898.     IF r<0 THEN
  2899.         CurveThrough(x,y)
  2900.     ELSE IF r=0 THEN
  2901.         LineTo(x,y)
  2902.     ELSE
  2903.         ArcTo(x,y,r);
  2904. END;
  2905.  
  2906. {
  2907. Main program.
  2908. }
  2909. BEGIN
  2910.     PushAttrs;
  2911. {
  2912. Display dialog box and get information.
  2913. }
  2914.     OD:=3.000;
  2915.     ID:=2.000;
  2916.     T:=0.500;
  2917.  
  2918.     BearingDialog;
  2919.     SetCursor(ArrowC);
  2920.     GetInfo;
  2921.     IF Abort THEN GOTO 99;
  2922.     DSelectAll;
  2923.     GetPt(x0,y0);
  2924. {
  2925. Get units per inch and adjust parameters.
  2926. }
  2927.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  2928.     IF Inch THEN
  2929.     BEGIN
  2930.         ID:=ID*UPI;
  2931.         OD:=OD*UPI;
  2932.         T:=T*UPI;
  2933.     END ELSE
  2934.     BEGIN
  2935.         ID:=ID*UPI/25.4;
  2936.         OD:=OD*UPI/25.4;
  2937.         T:=T*UPI/25.4;
  2938.     END;
  2939. {
  2940. Draw top view.
  2941. }
  2942.     IF View=2 THEN
  2943.     BEGIN
  2944.         FillPat(1);
  2945.         DrawWasher(x0,y0,OD,ID);
  2946.         GOTO 99;
  2947.     END;
  2948. {
  2949. Determine roller size and calculate bearing dimensions.
  2950. }
  2951.     nWashers:=2;
  2952.     W:=(OD-ID)/2;
  2953.     IF Type=2 THEN
  2954.     BEGIN
  2955.         T1:=T;
  2956.         T:=2*T1/(3*(1+k1*k2*k4/3));
  2957.         T2:=2*(T1-k1*k2*k4*W/2)/3;
  2958.         IF T2<T THEN T:=T2;
  2959.         IF Style=2 THEN
  2960.         BEGIN
  2961.             T2:=2*(T1-W)/3;
  2962.             IF T2<T THEN T:=T2;
  2963.         END;
  2964.         nWashers:=3;
  2965.     END;
  2966.     rr1:=k1*W;
  2967.     IF rr1 > k1*T THEN rr1:=k1*T;
  2968.     rr2:=k2*rr1;
  2969.     rf:=k3*W;
  2970.     IF rf > k3*T THEN rf:=k3*T;
  2971.     IF Style=1 THEN
  2972.         s:=k4*rr2
  2973.     ELSE
  2974.         s:=2*rr1;
  2975.     tw:=(T-s)/2;
  2976.     wr:=k5*W;
  2977.     hr:=k6*s;
  2978.     lr:=k7*W;
  2979.     rr3:=(rr1+rr2)/2;
  2980.     ll:=k8*lr;
  2981.     odRet:=(OD+ID)/2+wr;
  2982.     idRet:=odRet-2*wr;
  2983.     dRoller:=(OD+ID)/2;
  2984. {
  2985. Draw bearing.
  2986. }
  2987. {
  2988. Draw washers.
  2989. }
  2990.     x1:=x0-OD/2;
  2991.     y1:=y0-(tw+s);
  2992.     ClosePoly;
  2993.     Absolute;
  2994.     FOR k:=1 TO nWashers DO
  2995.     BEGIN
  2996.         y1:=y1+tw+s;
  2997.         x[1]:=x1;        y[1]:=y1;        r[1]:=0;
  2998.         x[2]:=x1;        y[2]:=y1+tw;    r[2]:=0;
  2999.         x[3]:=x1+OD;    y[3]:=y1+tw;    r[3]:=0;
  3000.         x[4]:=x1+OD;    y[4]:=y1;        r[4]:=0;
  3001.         IF k=1 THEN
  3002.         BEGIN
  3003.             r[1]:=rf;
  3004.             r[4]:=rf;
  3005.         END ELSE IF ((Type<>2)AND(k=2))OR(k=3) THEN
  3006.         BEGIN
  3007.             r[2]:=rf;
  3008.             r[3]:=rf;
  3009.         END;
  3010.         MoveTo(x1,y1);
  3011.         FillPat(1);
  3012.         BeginPoly;
  3013.             FOR m:=1 TO 4 DO
  3014.                 DrawPoint(x[m],y[m],r[m]);
  3015.         EndPoly;
  3016.         IF ShowSect THEN
  3017.         BEGIN
  3018.             IF k=1 THEN
  3019.                 FillPat(12)
  3020.             ELSE IF k=2 THEN
  3021.                 FillPat(24)
  3022.             ELSE FillPat(12);
  3023.         END ELSE FillPat(1);
  3024.         x[3]:=x[1]+W;
  3025.         x[4]:=x[1]+W;
  3026.         BeginPoly;
  3027.             FOR m:=1 TO 4 DO
  3028.                 DrawPoint(x[m],y[m],r[m]);
  3029.         EndPoly;
  3030.         x[1]:=x[1]+OD;
  3031.         x[2]:=x[1];
  3032.         x[3]:=x[1]-W;
  3033.         x[4]:=x[3];
  3034.         BeginPoly;
  3035.             FOR m:=1 TO 4 DO
  3036.                 DrawPoint(x[m],y[m],r[m]);
  3037.         EndPoly;
  3038.     END;
  3039. {
  3040. Draw retainer(s).
  3041. }
  3042.     x1:=x0;
  3043.     y1:=y0-s/2;
  3044.     FOR k:=1 TO nWashers-1 DO
  3045.     BEGIN
  3046.         y1:=y1+tw+s;
  3047.         FillPat(1);
  3048.         Absolute;
  3049.         MoveTo(x1,y1);
  3050.         Relative;
  3051.         Rect(-odRet/2,hr/2,odRet/2,-hr/2);
  3052.         IF ShowSect THEN FillPat(2)
  3053.         ELSE FillPat(1);
  3054.         Rect(-odRet/2,hr/2,-idRet/2,-hr/2);
  3055.         Rect(odRet/2,hr/2,idRet/2,-hr/2);
  3056.     END;
  3057. {
  3058. Draw rollers.
  3059. }
  3060.     FillPat(1);
  3061.     x1:=x0-dRoller/2;
  3062.     y1:=y0+T/2;
  3063.     Absolute;
  3064.     MoveTo(x1,y1);
  3065.     IF (Type=1) OR (Type=2) THEN
  3066.     BEGIN
  3067.         Relative;
  3068.         Arc(-rr1,rr1,rr1,-rr1,0,360);
  3069.         Move(dRoller,0);
  3070.         Arc(-rr1,rr1,rr1,-rr1,0,360);
  3071.         IF Type=2 THEN
  3072.         BEGIN
  3073.             Move(0,tw+s);
  3074.             Arc(-rr1,rr1,rr1,-rr1,0,360);
  3075.             Move(-dRoller,0);
  3076.             Arc(-rr1,rr1,rr1,-rr1,0,360);
  3077.         END;
  3078.     END
  3079.  
  3080.     ELSE IF Type=3 THEN
  3081.     BEGIN
  3082.         Relative;
  3083.         Rect(-lr/2,rr1,lr/2,-rr1);
  3084.         Move(dRoller,0);
  3085.         Rect(-lr/2,rr1,lr/2,-rr1);
  3086.     END
  3087.  
  3088.     ELSE IF Type=4 THEN
  3089.     BEGIN
  3090.         Relative;
  3091.         Move(-lr/2,rr1);
  3092.         Poly(0,0, lr,-(rr1-rr2), 0,-2*rr2, -lr,-(rr1-rr2));
  3093.         Move(dRoller+lr,0);
  3094.         Poly(0,0, -lr,(rr1-rr2), 0,2*rr2, lr,(rr1-rr2));
  3095.     END
  3096.  
  3097.     ELSE IF Type=5 THEN
  3098.     BEGIN
  3099.         x1:=(dRoller+lr)/2;
  3100.         x[1]:=-x1;            y[1]:=y1+rr3;
  3101.         x[2]:=x[1]+ll;    y[2]:=y1+rr1;
  3102.         x[3]:=x[1]+lr;    y[3]:=y1+rr2;
  3103.         x[4]:=x[3];        y[4]:=y1-rr2;
  3104.         x[5]:=x[2];        y[5]:=y1-rr1;
  3105.         x[6]:=x[1];        y[6]:=y1-rr3;
  3106.         r[1]:=0;    r[2]:=-1;    r[3]:=0;
  3107.         r[4]:=0;    r[5]:=-1;    r[6]:=0;
  3108.         Absolute;
  3109.         i:=1;
  3110.         FOR m:=1 TO 2 DO
  3111.         BEGIN
  3112.             MoveTo(x0+i*x1,y1);
  3113.             BeginPoly;
  3114.                 FOR k:=1 TO 6 DO
  3115.                     DrawPoint(x0+i*x[k],y[k],r[k]);
  3116.             EndPoly;
  3117.             i:=-1;
  3118.         END;
  3119.     END;
  3120.     Group;
  3121.     PopAttrs;
  3122. 99:END;        {of ThrustBrg}
  3123.  
  3124. {
  3125. Main Program.
  3126. }
  3127. BEGIN
  3128.     MainDialog;
  3129.     SetCursor(ArrowC);
  3130.     GetInfo1;
  3131.     IF Abort THEN GOTO 99;
  3132.     If Type=1 THEN BallBearing
  3133.     ELSE If Type=2 THEN RollerBearing
  3134.     ELSE If Type=3 THEN TaperedRlrBrg
  3135.     ELSE If Type=4 THEN ThrustBrg;
  3136. 99:END;
  3137.  
  3138. RUN(Bearings);