home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / COIL_SPR.MPC < prev    next >
Encoding:
Text File  |  1996-04-30  |  11.3 KB  |  457 lines
  1. Procedure Spring;
  2. {
  3. (Windows version)
  4. ⌐1996, Diehl Graphsoft, Inc.
  5. Developed by Tom Urie
  6.  
  7. This procedure draws a coil spring.
  8. }
  9.  
  10. LABEL 10,20,30,99;
  11. VAR
  12.     D,L,L1,L1a,wd,Theta,Theta2 : REAL;
  13.     x0,y0,x,y,x1,y1,dx1,dy1,dx2,dy2,dx3,dy3,dx4,dy4 : REAL;
  14.     dx,dy,dx1a,dy1a,dx2a,dy2a,dx3a,dy3a : REAL;
  15.     xt,yt,dy5,dx5,dy6,FL : REAL;
  16.     i,j,n,NCoils,Type : INTEGER;
  17.     RFlag : ARRAY[1..2] OF INTEGER;
  18.     Abort,Section,CFlag1 : BOOLEAN;
  19.  
  20. Procedure SpringDialog;
  21. {
  22. This procedure defines the dialog box.
  23. }
  24. VAR
  25.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER;
  26.  
  27. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  28. VAR
  29.     scrx1,scry1,scrx2,scry2:INTEGER;
  30. BEGIN
  31.     GetScreen(scrx1,scry1,scrx2,scry2);
  32.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  33.     x2:=x1+Width; 
  34. END;
  35.  
  36. Procedure MakeDialog;
  37. CONST
  38.     y1=100;
  39.     scnh=190; scnw=420;
  40.     h=30;
  41. BEGIN
  42.     AlignScr(scnw,x1,x2);
  43.     y2:=y1+scnh;
  44.     px1:=scnw-160;
  45.     px2:=scnw-100;
  46.     px3:=scnw-80;
  47.     px4:=scnw-20;
  48.     py1:=scnh-40;
  49.     py2:=scnh-20;
  50.  
  51.     BeginDialog(1,1,x1,y1,x2,y2);
  52.         AddButton('OK',1,1,px1,py1,px2,py2);
  53.         AddButton('Cancel',2,1,px3,py1,px4,py2);
  54.         AddField('Mean Diameter:',4,1,20,45-h,145,60-h);
  55.         AddField('2.000',5,2,160,45-h,215,60-h);
  56.         AddField('Pitch:',6,1,20,70-h,100,85-h);
  57.         AddField('0.500',7,2,160,70-h,215,85-h);
  58.         AddField('Wire Diameter:',8,1,20,95-h,155,110-h);
  59.         AddField('0.3125',9,2,160,95-h,215,110-h);
  60.         AddField('No. of Active Coils:',10,1,20,120-h,145,135-h);
  61.         AddField('6',11,2,160,120-h,215,135-h);
  62.         AddField('Type of Ends:',12,1,245,40-h,365,55-h);
  63.         AddButton('Plain',13,3,245,65-h,300,80-h);
  64.         AddButton('Squared by Bending',14,3,245,85-h,395,100-h);
  65.         AddButton('Squared by Grinding',15,3,245,105-h,395,120-h);
  66.         AddButton('Squared and Ground',16,3,245,125-h,395,140-h);
  67.         AddButton('Section View',17,2,20,155-h,125,170-h);
  68.     EndDialog
  69. END;
  70.  
  71. BEGIN
  72.     MakeDialog;
  73. END;
  74.  
  75. Procedure GetInfo;
  76. {
  77. This procedure displays the dialog box and retrieves the information.
  78. }
  79. LABEL 10,99;
  80. VAR
  81.     Value : REAL;
  82.     Item : INTEGER;
  83.     Done,OK : BOOLEAN;
  84.  
  85. Procedure SetRButton(i,Item : INTEGER);
  86. BEGIN
  87.     IF RFlag[i] <> Item THEN BEGIN
  88.         SetItem(RFlag[i],FALSE);
  89.         SetItem(Item,TRUE);
  90.         RFlag[i]:=Item;
  91.     END;
  92. END;
  93.  
  94. BEGIN
  95.     Type:=1;
  96.     D:=1.3125;
  97.     WD:=0.1875;
  98.     L:=0.3215;
  99.     NCoils:=10;
  100.     Section:=FALSE;
  101.     Done:=FALSE;
  102.     Abort:=FALSE;
  103.     RFlag[1]:=13;
  104.     CFlag1:=FALSE;
  105.     GetDialog(1);
  106.     SetTitle('Coil Springs');
  107.     SetItem(RFlag[1],TRUE);
  108.     SetItem(17,CFlag1);
  109.     SetField(5,Num2StrF(D));
  110.     SetField(7,Num2StrF(L));
  111.     SetField(9,Num2StrF(WD));
  112.     SetField(11,Num2Str(0,NCoils));
  113.     SelField(5);
  114.     10:REPEAT
  115.         DialogEvent(Item);
  116.         IF Item=1 then
  117.             Done:=True;
  118.         IF Item=2 then BEGIN
  119.             Done:=TRUE;
  120.             Abort:=TRUE;
  121.         END;
  122.         IF (Item > 12) AND (Item < 17) THEN BEGIN
  123.             SetRButton(1,Item);
  124.             Type:=Item-12;
  125.         END; 
  126.         IF Item=17 THEN BEGIN
  127.             SetItem(Item,NOT CFlag1);
  128.             CFlag1:=NOT CFlag1;
  129.         END; 
  130.     UNTIL Done;
  131.     IF Abort THEN GOTO 99;
  132.     OK:=ValidNumStr(Getfield(5),D);
  133.     OK:=ValidNumStr(Getfield(7),L);
  134.     OK:=ValidNumStr(Getfield(9),WD);
  135.     OK:=ValidNumStr(Getfield(11),NCoils);
  136.     IF (D<=0) OR (L<=0) OR (WD<=0) OR (NCoils<=0) THEN BEGIN
  137.         SysBeep;
  138.         Done:=FALSE;
  139.         GOTO 10;
  140.     END;
  141.         Section:=CFlag1;
  142.     99:ClrDialog;
  143. END;
  144.  
  145. {
  146. Main Program.
  147. }
  148. BEGIN
  149.     DselectAll;
  150. {
  151. Display the dialog box and get the information.
  152. }
  153.     SpringDialog;
  154.     SetCursor(ArrowC);
  155.     GetInfo;
  156.     IF Abort THEN GoTo 99;
  157.     PushAttrs;
  158.     FillPat(1);
  159. {
  160. Get the location of the spring.
  161. }
  162.     GetPt(x0,y0);
  163. {
  164. Calculate the pitch angle and various information needed to draw the spring.
  165. }
  166.     Theta:=ArcTan(L/(2*D));
  167.     IF Theta < 0 THEN
  168.         Theta:=-Theta;
  169.     L1:=D/Cos(Theta)+wd;
  170.     dx1:=wd*(Cos(Theta)+Sin(Theta))/2;
  171.     dy1:=-wd*(Sin(Theta)-Cos(Theta))/2;
  172.     dx2:=wd*Sin(Theta);
  173.     dy2:=wd*Cos(Theta);
  174.     dx3:=L1*Cos(Theta);
  175.     dy3:=L1*Sin(Theta);
  176.     xt:=x0;
  177.     yt:=y0;
  178.     Absolute;
  179.     ClosePoly;
  180.     n:=NCoils+1;
  181.     IF (Type=2) OR (Type=4) THEN
  182.         n:=n+1;
  183.     x:=xt;
  184. {
  185. Draw coils.
  186.  
  187. Types 1 & 3.
  188. }
  189.     IF (Type=2) OR (Type=4) THEN GOTO 10;
  190.     FOR i:=1 TO 2 DO BEGIN
  191.         n:=n-1;
  192.         y:=yt+L;
  193.         FOR j:=1 TO n DO BEGIN
  194.             y:=y-L;
  195.             Absolute;
  196.             IF i=1 THEN
  197.                 MoveTo(x-dy1,y-dx1)
  198.             ELSE
  199.                 MoveTo(x-dx1,y-dy1);
  200.             Relative;
  201.             IF i=1 THEN BEGIN
  202.                 IF NOT Section THEN BEGIN
  203.                     BeginPoly;
  204.                     ArcTo(0,0,wd/2);
  205.                     ArcTo(-dx2,dy2,wd/2);
  206.                     ArcTo(dx3,dy3,wd/2);
  207.                     ArcTo(dx2,-dy2,wd/2);
  208.                     EndPoly;
  209.                 END;
  210.             END
  211.             ELSE BEGIN
  212.                 BeginPoly;
  213.                     ArcTo(0,0,wd/2);
  214.                     ArcTo(dx2,dy2,wd/2);
  215.                     ArcTo(dx3,-dy3,wd/2);
  216.                     ArcTo(-dx2,-dy2,wd/2);
  217.                 EndPoly;
  218.             END;
  219.         END;
  220.     END;
  221.     GOTO 20;
  222. {
  223. Types 2 & 4.
  224. }
  225.     10:dy4:=-dy1+dy2-dy3/2+wd/2;
  226.     IF dy4 < L/2 THEN
  227.         dy4:=L/2;
  228.     Theta2:=ArcTan(dy4/D);
  229.     IF Theta2 < 0 THEN
  230.         Theta2:=-Theta2;
  231.     L1a:=D/Cos(Theta2)+wd;
  232.     dx1a:=wd*(Cos(Theta2)+Sin(Theta2))/2;
  233.     dy1a:=-wd*(Sin(Theta2)-Cos(Theta2))/2;
  234.     dx2a:=wd*Sin(Theta2);
  235.     dy2a:=wd*Cos(Theta2);
  236.     dx3a:=L1a*Cos(Theta2);
  237.     dy3a:=L1a*Sin(Theta2);
  238.     FOR i:=1 TO 2 DO BEGIN
  239.         n:=n-1;
  240.         y:=yt+L;
  241.         FOR j:=1 TO n DO BEGIN
  242.             y:=y-L;
  243.             Absolute;
  244.             IF i=1 THEN BEGIN
  245.                     IF j=n THEN
  246.                         y:=y-(dy4-L/2);
  247.                     IF (j=1) OR (j=n) THEN
  248.                         MoveTo(x-dy1a,y-dx1a)
  249.                     ELSE
  250.                         MoveTo(x-dy1,y-dx1);
  251.             END
  252.             ELSE
  253.                 MoveTo(x-dx1,y-dy1);
  254.             Relative;
  255.             IF i=1 THEN BEGIN
  256.                 IF NOT Section THEN BEGIN
  257.                     IF (j=1) OR (j=n) THEN BEGIN
  258.                         IF Type <> 4 THEN BEGIN
  259.                             BeginPoly;
  260.                             ArcTo(0,0,wd/2);
  261.                             ArcTo(-dx2a,dy2a,wd/2);
  262.                             ArcTo(dx3a,dy3a,wd/2);
  263.                             ArcTo(dx2a,-dy2a,wd/2);
  264.                             EndPoly;
  265.                         END;
  266.                     END
  267.                     ELSE BEGIN
  268.                         BeginPoly;
  269.                         ArcTo(0,0,wd/2);
  270.                         ArcTo(-dx2,dy2,wd/2);
  271.                         ArcTo(dx3,dy3,wd/2);
  272.                         ArcTo(dx2,-dy2,wd/2);
  273.                         EndPoly;
  274.                     END;
  275.                 END;
  276.             END
  277.             ELSE BEGIN
  278.                 BeginPoly;
  279.                     ArcTo(0,0,wd/2);
  280.                     ArcTo(dx2,dy2,wd/2);
  281.                     ArcTo(dx3,-dy3,wd/2);
  282.                     ArcTo(-dx2,-dy2,wd/2);
  283.                 EndPoly;
  284.             END;
  285.         END;
  286.     END;
  287. {
  288. Draw ends.
  289. }
  290. 20:Absolute;
  291. {
  292. Type 1.
  293. }
  294.     IF Type=1 THEN BEGIN
  295.         MoveTo(xt-dx1,yt-(NCoils-1)*L-dy1);
  296.         Relative;
  297.         ClosePoly;
  298.         BeginPoly;
  299.             ArcTo(0,0,wd/2);
  300.             ArcTo(dx2,dy2,wd/2);
  301.             LineTo(dx3/2,-dy3/2);
  302.             LineTo(-dx2,-dy2);
  303.         EndPoly;
  304.         Absolute;
  305.         MoveTo(xt+D+dy1,yt+L/2-dx1);
  306.         Relative;
  307.         BeginPoly;
  308.             ArcTo(0,0,wd/2);
  309.             ArcTo(dx2,dy2,wd/2);
  310.             LineTo(-dx3/2,dy3/2);
  311.             LineTo(-dx2,-dy2);
  312.         EndPoly;
  313.     END
  314. {
  315. Type 2.
  316. }
  317.     ELSE IF Type=2 THEN BEGIN
  318.         Absolute;
  319.         ClosePoly;
  320.         MoveTo(xt-wd/2,yt-(NCoils-1/2)*L-dy4-wd/2);
  321.         Relative;
  322.         ClosePoly;
  323.         BeginPoly;
  324.             ArcTo(0,0,wd/2);
  325.             ArcTo(0,wd,wd/2);
  326.             LineTo((D+wd)/2,0);
  327.             LineTo(0,-wd);
  328.         EndPoly;
  329.         Absolute;
  330.         MoveTo(xt+D+wd/2,yt+dy4-wd/2);
  331.         Relative;
  332.         BeginPoly;
  333.             ArcTo(0,0,wd/2);
  334.             ArcTo(0,wd,wd/2);
  335.             LineTo(-(D+wd)/2,0);
  336.             LineTo(0,-wd);
  337.         EndPoly;
  338.     END
  339. {
  340. Type 3.
  341. }
  342.     ELSE IF Type=3 THEN BEGIN
  343.         dx3:=D/2+dx1-dx2;
  344.         dy3:=dx3*Tan(Theta);
  345.         dx4:=D/2+wd*Sin(Theta)/2;
  346.         dy4:=wd/2-dy1+dy2-dy3;
  347.         IF dy4 < 0 THEN BEGIN
  348.             dy3:=wd/2+dy2-dy1;
  349.             dx3:=dy3/Tan(Theta);    
  350.             dy4:=0;
  351.             dx4:=dx3+dx2-dx1+wd*Sin(Theta)/4;
  352.         END;
  353.         MoveTo(xt-dx1,yt-(NCoils-1)*L-dy1);
  354.         Relative;
  355.         ClosePoly;
  356.         BeginPoly;
  357.             ArcTo(0,0,wd/2);
  358.             ArcTo(dx2,dy2,wd/2);
  359.             LineTo(dx3,-dy3);
  360.             IF dy4 <> 0 THEN
  361.                 LineTo(0,-dy4);
  362.             LineTo(-dx4,0);
  363.         EndPoly;
  364.         Absolute;
  365.         MoveTo(xt+D+dx1,yt+L/2+dy1);
  366.         Relative;
  367.         BeginPoly;
  368.             ArcTo(0,0,wd/2);
  369.             ArcTo(-dx2,-dy2,wd/2);
  370.             LineTo(-dx3,dy3);
  371.             IF dy4 <> 0 THEN
  372.                 LineTo(0,dy4);
  373.             LineTo(dx4,0);
  374.         EndPoly;
  375.     END
  376. {
  377. Type 4.
  378. }
  379.     ELSE BEGIN
  380.         dx3:=D+dx1-dx2;
  381.         dy3:=dx3*Tan(Theta);
  382.         dx4:=D+wd*Sin(Theta);
  383.         dy4:=wd/2-dy1+dy2-dy3;
  384.         IF dy4 < 0 THEN BEGIN
  385.             dy3:=wd/2+dy2-dy1;
  386.             dx3:=dy3/Tan(Theta);    
  387.             dy4:=0;
  388.             dx4:=dx3+dx2-dx1+wd*Sin(Theta)/4;
  389.         END;
  390.         MoveTo(xt-dx1,yt-(NCoils-1)*L-wd/Cos(Theta)-dy1);
  391.         Relative;
  392.         ClosePoly;
  393.         BeginPoly;
  394.             ArcTo(0,0,wd/2);
  395.             ArcTo(dx2,dy2,wd/2);
  396.             LineTo(dx3,-dy3);
  397.             IF dy4 <> 0 THEN
  398.                 LineTo(0,-dy4);
  399.             LineTo(-dx4,0);
  400.         EndPoly;
  401.         Absolute;
  402.         MoveTo(xt+D+dx1,yt-L/2+wd/Cos(Theta)+dy1);
  403.         Relative;
  404.         BeginPoly;
  405.             ArcTo(0,0,wd/2);
  406.             ArcTo(-dx2,-dy2,wd/2);
  407.             LineTo(-dx3,dy3);
  408.             IF dy4 <> 0 THEN
  409.                 LineTo(0,dy4);
  410.             LineTo(dx4,0);
  411.         EndPoly;
  412.     END;
  413. {
  414. Draw sections.
  415. }
  416.     IF NOT Section THEN GOTO 30;
  417.     IF (Type=1) OR (Type=3) THEN
  418.         dy:=L/2
  419.     ELSE IF Type=2 THEN
  420.         dy:=dy4
  421.     ELSE
  422.         dy:=-L/2+wd/Cos(Theta);
  423.     yt:=yt+dy;
  424.     j:=1;
  425.     n:=NCoils;
  426.     IF (Type=2) OR (Type=4) THEN
  427.         n:=n+1;
  428.     Absolute;
  429.     MoveTo(xt+D,yt);
  430.     Relative;
  431.     Fillpat(27);
  432.     For i:=1 TO 2*n DO BEGIN
  433.         j:=-1*j;
  434.         Arc(-wd/2,wd/2,wd/2,-wd/2,0,360);
  435.         IF (i=1) OR (i=2*n-1) THEN
  436.             Move(j*D,-dy)
  437.         ELSE
  438.             Move(j*D,-L/2);
  439.     END;
  440.     30:Group;
  441. {
  442. Calculate length.
  443. }
  444.     IF Type=1 THEN
  445.         FL:=Ncoils*L+wd*Cos(Theta)
  446.     ELSE IF Type=2 THEN
  447.         FL:=(Ncoils-1/2)*L+2*dy4+wd
  448.     ELSE IF Type=3 THEN
  449.         FL:=(Ncoils-1/2)*L+wd
  450.     ELSE
  451.         FL:=L*(NCoils-3/2)+wd*(1+2/Cos(Theta));
  452.     Message('Length = ',FL:10:3);
  453.     PopAttrs;
  454. 99:END;
  455.  
  456. RUN(Spring);
  457.