home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / SHAFTBRK.MPC < prev    next >
Encoding:
Text File  |  1997-04-30  |  1.6 KB  |  87 lines
  1. Procedure ShaftBreak;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure creates a shaft break. Two points are selected across the diameter of the shaft to create the break.
  7. }
  8. LABEL 10,99;
  9.  
  10. CONST
  11.     ky0 = 0.052;
  12.     kx1 = 0.097;     ky1 = 0.104;
  13.     kx2 = 0.292;     ky2 = 0.208;
  14.  
  15. VAR
  16.     d,x1,y1,x2,y2,x3,y3,Theta : REAL;
  17.     x,y : ARRAY[1..8] OF REAL;
  18.     k : INTEGER;
  19.         
  20. Function xt(x,y,Theta : REAL) : REAL;
  21. BEGIN
  22.     xt:=x*Cos(Theta)-y*Sin(Theta);
  23. END;
  24.  
  25. Function yt(x,y,Theta : REAL) : REAL;
  26. BEGIN
  27.     yt:=x*Sin(Theta)+y*Cos(Theta);
  28. END;
  29.  
  30. {
  31. Main program.
  32. }
  33. BEGIN
  34.  
  35. {
  36. Get insertion points.
  37. }
  38.     Message('Click the two endpoints. Double-click to end command.');
  39.     10:DSelectAll;
  40.     GetLine(x1,y1,x2,y2);
  41. {
  42. Determine shaft diameter and angle of break.
  43. }
  44.     d:=Sqrt((y2-y1)^2 + (x2-x1)^2);
  45.     IF d = 0 THEN GOTO 99;
  46.     Theta:=ArcCos((x2-x1)/d);
  47.     IF y2 < y1 THEN Theta:=2*Pi-Theta; 
  48. {
  49. Calculate the vertices of the polyline.
  50. }
  51.     x[1]:=0;                y[1]:=0;
  52.     x[2]:=0;                y[2]:=ky0*d;
  53.     x[3]:=kx1*d;            y[3]:=ky1*d;
  54.     x[4]:=kx2*d;            y[4]:=ky2*d;
  55.     x[5]:=d/2;            y[5]:=0;
  56.     x[6]:=(1-kx2)*d;    y[6]:=-y[4];
  57.     x[7]:=d;                y[7]:=0;
  58.     x[8]:=x[6];            y[8]:=y[4];
  59.     FOR k:=1 TO 8 DO
  60.     BEGIN
  61.         x3:=x[k];        y3:=y[k];
  62.         x[k]:=x1+xt(x3,y3,Theta);
  63.         y[k]:=y1+yt(x3,y3,Theta);
  64.     END;
  65. {
  66. Draw break.
  67. }
  68.     Absolute;
  69.     MoveTo(x[1], y[1]);
  70.     OpenPoly;
  71.     BeginPoly;
  72.         LineTo(x[1],y[1]);
  73.         CurveTo(x[2],y[2]);
  74.         LineTo(x[3],y[3]);
  75.         CurveTo(x[4],y[4]);
  76.         LineTo(x[5],y[5]);
  77.         CurveTo(x[6],y[6]);
  78.         CurveThrough(x[7],y[7]);
  79.         CurveTo(x[8],y[8]);
  80.         LineTo(x[5],y[5]);
  81.     EndPoly;
  82.     Redraw;
  83.     GOTO 10;
  84.     99:ClrMessage;
  85. END;
  86.  
  87. Run(ShaftBreak);