home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / ROLL_BRG.MPC < prev    next >
Encoding:
Text File  |  1996-04-30  |  11.4 KB  |  461 lines
  1. Procedure RollerBearing;
  2. {
  3. (Windows vwesion)
  4. ⌐1996, Diehl Graphsoft, Inc.
  5. Developed by Tom Urie
  6.  
  7. This procedure draws a roller bearing.
  8. }
  9.  
  10. LABEL 20,30,40,99;
  11. CONST
  12.     RFW=0.666667;  {Used to determine width of roller {rw=W*RFW).}
  13.     RDF=0.5;  {Used to determine roller diameter.}
  14.     RF=0.25;  {Used to determine radius of fillet on inner and outer race.}
  15.     TF=0.25;  {Used to determine the amount of overlap of the inner and outer race over the roller.}
  16.     SF=0.75;  {Used to determine the spacing between rollers and, hence, the number of rollers.}
  17. VAR
  18.     ID,OD,W,t,a,b,c,d,rd,rr,rc,rw : REAL;
  19.     x0,y0,x1,y1,s : REAL;
  20.     r,r1,r2,r3,Theta1,Theta2,Phi,DeltaPhi : REAL;
  21.     Type,View,NRollers,n : INTEGER;
  22.     RFlag : ARRAY[1..3] OF INTEGER;
  23.     Ans,Abort,ShowSect,Inch,CFlag1 : BOOLEAN;
  24.     ODS,IDS,WS,DisplayUnits : STRING;
  25.     UPI : REAL;
  26.     Fmt : INTEGER;
  27.     UM,UM2 : STRING;
  28.     UName,DA : LONGINT;
  29.  
  30. Procedure BearingDialog;
  31. {
  32. This procedure defines the dialog box.
  33. }
  34. VAR
  35.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER;
  36.  
  37. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  38. VAR
  39.     scrx1,scry1,scrx2,scry2:INTEGER;
  40. BEGIN
  41.     GetScreen(scrx1,scry1,scrx2,scry2);
  42.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  43.     x2:=x1+Width; 
  44. END;
  45.  
  46. Procedure MakeDialog;
  47. CONST
  48.     y1=100;
  49.     scnh=270; scnw=360;
  50.     h=30;
  51. BEGIN
  52.     AlignScr(scnw,x1,x2);
  53.     y2:=y1+scnh;
  54.     px1:=scnw-160;
  55.     px2:=scnw-100;
  56.     px3:=scnw-80;
  57.     px4:=scnw-20;
  58.     py1:=scnh-40;
  59.     py2:=scnh-20;
  60.  
  61.     BeginDialog(1,1,x1,y1,x2,y2);
  62.         AddButton('OK',1,1,px3,py1-35,px4,py2-35);
  63.         AddButton('Cancel',2,1,px3,py1,px4,py2);
  64.         AddField('Inside Diameter:',4,1,20,165-h,145,180-h);
  65.         AddField('',5,2,150,165-h,225,180-h);
  66.         AddField('Outside Diameter:',6,1,20,190-h,145,205-h);
  67.         AddField('',7,2,150,190-h,225,205-h);
  68.         AddField('Width:',8,1,20,215-h,145,230-h);
  69.         AddField('',9,2,150,215-h,225,230-h);
  70.         AddField('View:',10,1,270,135-h,315,150-h);
  71.         AddButton('Section',11,3,270,160-h,350,175-h);
  72.         AddButton('Front',12,3,270,180-h,325,195-h);
  73.         AddField('Ring Configuration (Ribs-Inner/Ribs-Outer):',13,1,20,40-h,340,55-h);
  74.         AddButton('Double/Double',14,3,20,65-h,160,80-h);
  75.         AddButton('Double/None',15,3,20,85-h,175,100-h);
  76.         AddButton('None/Double',16,3,20,105-h,175,120-h);
  77.         AddButton('Single/Double',17,3,190,65-h,335,80-h);
  78.         AddButton('Double/Single',18,3,190,85-h,340,100-h);
  79.         AddButton('Single/Single',19,3,190,105-h,340,120-h);
  80.         AddButton('Show Section Lines',20,2,20,245-h,170,260-h);
  81.         AddField('Series:',22,1,20,135-h,60,150-h);
  82.         AddButton('Inch',23,3,65,135-h,115,150-h);
  83.         AddButton('Metric (mm)',24,3,120,135-h,210,150-h);
  84.         AddField('',25,1,233,165-h,255,180-h);
  85.         AddField('',26,1,233,190-h,255,205-h);
  86.         AddField('',27,1,233,215-h,255,230-h);
  87.     EndDialog;
  88. END;
  89.  
  90. BEGIN
  91.     MakeDialog;
  92. END;
  93.  
  94. Procedure GetInfo;
  95. {
  96. This procedure displays the dialox box and retrieves the information.
  97. }
  98. LABEL 10;
  99. VAR
  100.     Done:boolean;
  101.     Item:integer;
  102.  
  103. Procedure SetRButton(i,Item : INTEGER);
  104. BEGIN
  105.     IF RFlag[i] <> Item THEN BEGIN
  106.         SetItem(RFlag[i],FALSE);
  107.         SetItem(Item,TRUE);
  108.         RFlag[i]:=Item;
  109.     END;
  110. END;
  111.  
  112. BEGIN
  113.     Done:=FALSE;
  114.     Abort:=FALSE;
  115.     IF Ans THEN BEGIN
  116.         Ans:=FALSE;
  117.         GOTO 10;
  118.     END;
  119.     View:=1;
  120.     Type:=1;
  121.     ShowSect:=TRUE;
  122.     Inch:=TRUE;
  123.     ODS:='2.0000';
  124.     IDS:='1.0000';
  125.     WS:='0.625';
  126.     RFlag[1]:=14;
  127.     RFlag[2]:=11;
  128.     RFlag[3]:=23;
  129.     CFlag1:=TRUE;
  130.     DisplayUnits:='in';
  131.     10:GetDialog(1);
  132.     SetTitle('Roller Bearings');
  133.     SetItem(RFlag[1],TRUE);
  134.     SetItem(RFlag[2],TRUE);
  135.     SetItem(RFlag[3],TRUE);
  136.     SetItem(20,CFlag1);
  137.     SetField(5,IDS);
  138.     SetField(7,ODS);
  139.     SetField(9,WS);
  140.     SetField(25,DisplayUnits);
  141.     SetField(26,DisplayUnits);
  142.     SetField(27,DisplayUnits);
  143.     SelField(5);
  144.     REPEAT
  145.         DialogEvent(Item);
  146.         IF Item=1 THEN
  147.             Done:=TRUE;
  148.         IF Item=2 then BEGIN
  149.             Done:=TRUE;
  150.             Abort:=TRUE;
  151.         END;
  152.         IF (Item = 11) OR (Item = 12) THEN BEGIN
  153.             SetRButton(2,Item);
  154.             View:=Item-10;
  155.         END;
  156.         IF (Item > 13) AND (Item < 20) THEN BEGIN
  157.             SetRButton(1,Item);
  158.             Type:=Item-13;
  159.         END;
  160.         IF Item=20 THEN BEGIN
  161.         SetItem(Item,NOT CFlag1);
  162.         CFlag1:=NOT CFlag1;
  163.         END; 
  164.         IF Item = 23 THEN BEGIN
  165.             IF RFlag[3] <> Item THEN BEGIN
  166.                 SetRButton(3,Item);
  167.                 SetField(5,Num2Str(4,Str2Num(GetField(5))/25.4));
  168.                 SetField(7,Num2Str(4,Str2Num(GetField(7))/25.4));
  169.                 SetField(9,Num2Str(4,Str2Num(GetField(9))/25.4));
  170.                 SetField(25,'in');
  171.                 SetField(26,'in');
  172.                 SetField(27,'in');
  173.                 SelField(5);
  174.                 Inch:=TRUE;
  175.             END;
  176.         END;
  177.         IF Item = 24 THEN BEGIN
  178.             IF RFlag[3] <> Item THEN BEGIN
  179.                 SetRButton(3,Item);
  180.                 SetField(5,Num2Str(1,Str2Num(GetField(5))*25.4));
  181.                 SetField(7,Num2Str(1,Str2Num(GetField(7))*25.4));
  182.                 SetField(9,Num2Str(1,Str2Num(GetField(9))*25.4));
  183.                 SetField(25,'mm');
  184.                 SetField(26,'mm');
  185.                 SetField(27,'mm');
  186.                 SelField(5);
  187.                 Inch:=FALSE;
  188.             END;
  189.         END;
  190.     UNTIL DONE;
  191.     IDS:=GetField(5);
  192.     ODS:=GetField(7);
  193.     WS:=GetField(9);
  194.     ID:=Str2Num(IDS);
  195.     OD:=Str2Num(ODS);
  196.     W:=Str2Num(WS);
  197.     ShowSect:=CFlag1;
  198.     ClrDialog;
  199. END;
  200.  
  201. {
  202. Main program.
  203. }
  204. BEGIN
  205.     PushAttrs;
  206. {
  207. Define defaults.
  208. }
  209.     ID:=0.7500;
  210.     OD:=1.5000;
  211.     W:=0.6250;
  212. {
  213. Display dialog box and get information.
  214. }
  215.     BearingDialog;
  216.     DSelectAll;
  217.     Ans:=FALSE;
  218.     SetCursor(ArrowC);
  219.     20:GetInfo;
  220.     IF Abort THEN GOTO 99;
  221.     IF ID<OD THEN GOTO 30;
  222.     SysBeep;
  223.     AlrtDialog('ID must be less than OD!');
  224.     Ans:=TRUE;
  225.     IF Inch THEN
  226.         DisplayUnits:='in'
  227.     ELSE
  228.         DisplayUnits:='mm';
  229.     GOTO 20;
  230.     30:DSelectAll;
  231. {
  232. Get units per inch and adjust sizes accordingly.
  233. }
  234.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  235.     IF Inch THEN BEGIN
  236.         ID:=ID*UPI;
  237.         OD:=OD*UPI;
  238.         W:=W*UPI;
  239.     END
  240.     ELSE BEGIN
  241.         ID:=ID*UPI/25.4;
  242.         OD:=OD*UPI/25.4;
  243.         W:=W*UPI/25.4;
  244.     END;
  245. {
  246. Get insertion point.
  247. }
  248.     GetPt(x0,y0);
  249. {
  250. Calculate variables needed to draw bearing.
  251. }
  252.     t:=(OD-ID)/2;
  253.     rd:=RDF*t;
  254.     rw:=RFW*W;
  255.     rr:=rd/2;
  256.     a:=TF*rd;
  257.     b:=t/2-a;
  258.     c:=b-a;
  259.     d:=(w-rw)/2;
  260.     rc:=RF*b;
  261.     r1:=ID/2+b;
  262.     r2:=OD/2-b;
  263.     r3:=(OD+ID)/4;
  264.     FillPat(1);
  265.     IF View=2 THEN GOTO 40;
  266. {
  267. Draw Side View
  268. }
  269.     Absolute;    
  270.     MoveTo(x0,y0-(OD/2-rc));
  271.     Relative;
  272.     RECT(0,0,W,(OD-2*rc));
  273. {
  274. Inner Ring
  275. }
  276.         IF ShowSect THEN
  277.             FillPat(12);
  278.         ClosePoly;
  279.     IF (Type=1) OR (Type=2) OR (Type=5) THEN BEGIN
  280.         Absolute;
  281.         MoveTo(x0,y0+r1);
  282.         Relative;
  283.         BeginPoly;
  284.           ArcTo(0,-b,rc);
  285.             ArcTo(W,0,rc);
  286.           LineTo(0,b);
  287.             LineTo(-d,0);
  288.             LineTo(0,-a);
  289.             LineTo(-rw,0);
  290.             LineTo(0,a);
  291.             LineTo(-d,0);
  292.         EndPoly;
  293.         Move(0,-2*r1);
  294.         BeginPoly;
  295.           ArcTo(0,b,rc);
  296.             ArcTo(W,0,rc);
  297.           LineTo(0,-b);
  298.             LineTo(-d,0);
  299.             LineTo(0,a);
  300.             LineTo(-rw,0);
  301.             LineTo(0,-a);
  302.             LineTo(-d,0);
  303.         EndPoly;
  304.     END
  305.     ELSE BEGIN
  306.         Absolute;
  307.         MoveTo(x0,y0+r1-a);
  308.         Relative;
  309.         BeginPoly;
  310.           ArcTo(0,-c,rc);
  311.             ArcTo(W,0,rc);
  312.             IF Type=3 THEN BEGIN
  313.                 LineTo(0,c);
  314.                 LineTo(-W,0);
  315.             END
  316.             ELSE BEGIN
  317.               LineTo(0,b);
  318.                 LineTo(-d,0);
  319.                 LineTo(0,-a);
  320.                 LineTo(-(w-d),0);
  321.             END;
  322.         EndPoly;
  323.         Move(0,-2*(r1-a));
  324.         BeginPoly;
  325.           ArcTo(0,c,rc);
  326.             ArcTo(W,0,rc);
  327.             IF Type=3 THEN BEGIN
  328.                 LineTo(0,-c);
  329.                 LineTo(-W,0);
  330.             END
  331.             ELSE BEGIN
  332.               LineTo(0,-b);
  333.                 LineTo(-d,0);
  334.                 LineTo(0,a);
  335.                 LineTo(-(w-d),0);
  336.             END;
  337.         EndPoly;
  338.     END;
  339. {
  340. Draw Outer Ring.
  341. }
  342.     IF ShowSect THEN
  343.         FillPat(24);
  344.     ClosePoly;
  345.     IF Type=2 THEN BEGIN
  346.         Absolute;
  347.         MoveTo(x0,y0-(r2+a));
  348.         Relative;
  349.         BeginPoly;
  350.           ArcTo(0,-c,rc);
  351.             ArcTo(W,0,rc);
  352.             LineTo(0,c);
  353.             LineTo(-W,0);
  354.         EndPoly;
  355.         Move(0,2*(r2+a));
  356.         BeginPoly;
  357.           ArcTo(0,c,rc);
  358.             ArcTo(W,0,rc);
  359.             LineTo(0,-c);
  360.             LineTo(-W,0);
  361.         EndPoly;
  362.     END
  363.     ELSE BEGIN
  364.         Absolute;
  365.         MoveTo(x0,y0-r2);
  366.         Relative;
  367.         BeginPoly;
  368.           ArcTo(0,-b,rc);
  369.             ArcTo(W,0,rc);
  370.             IF (Type=5) OR (Type=6) THEN BEGIN
  371.                 LineTo(0,c);
  372.                 LineTo(-(W-d),0);
  373.                 LineTo(0,a);
  374.                 LineTo(-d,0);
  375.             END
  376.             ELSE BEGIN
  377.               LineTo(0,b);
  378.                 LineTo(-d,0);
  379.                 LineTo(0,-a);
  380.                 LineTo(-rw,0);
  381.                 LineTo(0,a);
  382.                 LineTo(-d,0);
  383.             END;
  384.         EndPoly;
  385.         Move(0,2*r2);
  386.         BeginPoly;
  387.           ArcTo(0,b,rc);
  388.             ArcTo(W,0,rc);
  389.             IF (Type=5) OR (Type=6) THEN BEGIN
  390.                 LineTo(0,-c);
  391.                 LineTo(-(W-d),0);
  392.                 LineTo(0,-a);
  393.                 LineTo(-d,0);
  394.             END
  395.             ELSE BEGIN
  396.               LineTo(0,-b);
  397.                 LineTo(-d,0);
  398.                 LineTo(0,a);
  399.                 LineTo(-rw,0);
  400.                 LineTo(0,-a);
  401.                 LineTo(-d,0);
  402.             END;
  403.         EndPoly;
  404.     END;
  405. {
  406. Draw Rollers
  407. }
  408.     FillPat(1);
  409.     Absolute;
  410.     MoveTo(x0+W/2,y0+r3);
  411.     Relative;
  412.     Rect(-rw/2,rd/2,rw/2,-rd/2);
  413.     Move(-rw/2,rd/2);
  414.     Line(rw,-rd);
  415.     Move(0,rd);
  416.     Line(-rw,-rd);
  417.     Move(rw/2,-(2*r3-rd/2));
  418.     Rect(-rw/2,rd/2,rw/2,-rd/2);
  419.     Move(-rw/2,rd/2);
  420.     Line(rw,-rd);
  421.     Move(0,rd);
  422.     Line(-rw,-rd);
  423.     GOTO 99;
  424. {
  425. Draw Front View.
  426. }
  427.     40:s:=SF*rd;
  428.     Phi:=2*s/r3;
  429.     NRollers:=2*PI/Phi;
  430.     DeltaPhi:=360/NRollers;
  431.     Phi:=-DeltaPhi;
  432.     IF Type=2 THEN
  433.         r2:=r2+a;
  434.     IF (Type=3) OR (Type=4) OR(Type=6) THEN
  435.         r1:=r1-a;
  436.     Theta1:=Rad2Deg(ArcCos((rr^2+r3^2-r2^2)/(2*rr*r3)));
  437.     Theta2:=Rad2Deg(ArcCos((rr^2+r3^2-r1^2)/(2*rr*r3)));
  438.     FillPat(1);
  439.     Absolute;
  440.     MoveTo(x0,y0);
  441.     Relative;
  442.     Arc(-OD/2,OD/2,OD/2,-OD/2,0,360);
  443.     Arc(-r2,r2,r2,-r2,0,360);
  444.     Arc(-r1,r1,r1,-r1,0,360);
  445.     Arc(-ID/2,ID/2,ID/2,-ID/2,0,360);
  446.     FOR n:=1 TO NRollers DO BEGIN
  447.         Phi:=Phi+DelTaPhi;
  448.         x1:=r3*Sin(Deg2Rad(Phi));
  449.         y1:=r3*Cos(Deg2Rad(Phi));
  450.         Absolute;
  451.         MoveTo(x0+x1,y0+y1);
  452.         Relative;
  453.         Arc(-rr,rr,rr,-rr,(270-Theta2-Phi),(Theta2-Theta1));
  454.         Arc(-rr,rr,rr,-rr,-(90-Theta1+Phi),(Theta2-Theta1));
  455.     END;
  456.     99:Group;
  457.     PopAttrs;
  458. END;
  459.  
  460. Run(RollerBearing);
  461.