home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / ELBO_REC.MPC < prev    next >
Text File  |  1997-04-30  |  12KB  |  469 lines
  1. Procedure DrawElbow;
  2. {
  3. ⌐1996, Diehl Graphsoft, Inc.
  4. Developed by Frank Brault
  5. Last modified: 4/3/97
  6. }
  7. CONST
  8.     MaxPoints = 10;
  9.     kLineSize = 12;
  10.     kFilledPat = 5;
  11.     kPlainPat = 1;
  12.     kDashedLine = -2;
  13.     kLinedOffset = 1.0;
  14.  
  15. VAR
  16.     han1, han2 : HANDLE;
  17.     tempx,tempy : REAL;
  18.     a,b,c,d,e,f,g,h,i,j,m,n,L,r1,Alpha,theta : REAL;
  19.     x0,y0,x1,y1,x2,y2,L1x0,L1y0,L2x0,L2y0 : REAL;
  20.     clickX1,clickY1,clickX2,clickY2,qx1,qy1,qx2,qy2 : REAL;
  21.     verX1,verY1,verX2,verY2 : REAL;
  22.     x,y,xp,yp,R : ARRAY[1..MaxPoints] OF REAL;
  23.     xL1,yL1,xL2,yL2,RL1,RL2: ARRAY[1..3] OF REAL;
  24.     k,nPoints,dlogX1,dlogX2,item,quadrant,whichKey : INTEGER;
  25.     finished,cancel,aboveHor,leftOfVer : BOOLEAN;
  26.     lined,filled,insulated,labeled : BOOLEAN;
  27.     px1,py1,px2,py2,px3,py3,px4,py4 : INTEGER;
  28.     
  29.  
  30. PROCEDURE switch(VAR first,second:REAL);
  31. VAR
  32.     temporary:REAL;
  33. BEGIN
  34. {** Exchanges value in first with value in second}
  35.         temporary:=first;
  36.         first := second;
  37.         second := temporary;
  38. END;
  39.  
  40. Procedure DrawPolyPoint(x,y,R : REAL);
  41. {** This procedure draws a polyline point based on the value of R:
  42.     R = 0    ==> Corner point
  43.     R > 0    ==> Arc point of radius, R
  44.     R = -1    ==> Cubic spline point
  45.     R = any value less than 0 except -1
  46.             ==> Bezier control point                             }
  47.  
  48. BEGIN
  49.     IF R = 0 THEN
  50.         LineTo(x,y)
  51.     ELSE IF R > 0 THEN
  52.         ArcTo(x,y,R)
  53.     ELSE IF R = -1 THEN
  54.         CurveThrough(x,y)
  55.     ELSE
  56.         CurveTo(x,y);
  57. END;    {of DrawPolyPoint}
  58.  
  59. Function xt(x,y,x0,y0,Alpha:REAL) : REAL;
  60. {** This function transforms the x-coordinate of a point
  61.     relative to the x,y axis to an axis passing through
  62.     x0,y0 at an angle, Alpha. }
  63.  
  64. VAR
  65.     A : REAL;
  66.  
  67. BEGIN
  68.     A:=Deg2Rad(Alpha);
  69.     xt:=x0 + x*Cos(A) - y*Sin(A);
  70. END;    {of Function xt}
  71.  
  72. Function yt(x,y,x0,y0,Alpha:REAL) : REAL;
  73. {** This function transforms the y-coordinate of a point
  74.     relative to the x,y axis to an axis passing through
  75.     x0,y0 at an angle, Alpha. }
  76. VAR
  77.     A : REAL;
  78.  
  79. BEGIN
  80.     A:=Deg2Rad(Alpha);
  81.     yt:=y0 + y*Cos(A) + x*Sin(A);
  82. END;    {of Function yt}
  83.  
  84.  
  85. FUNCTION clickOnWhatSide(x1,y1,x2,y2,clickX,clickY:REAL):BOOLEAN;
  86.  
  87. {** This function determines the side of the line
  88.     that point clickX,clickY is on. It will return
  89.     an unpredictable result if x1,y1 and x2,y2
  90.     are the same.                                    }
  91.  
  92. VAR
  93.     M,B : REAL;
  94.     whichSide : BOOLEAN;
  95.  
  96. BEGIN
  97.     IF (x1 <> x2) AND (y1 <> y2) THEN
  98.     BEGIN
  99.         M := (y1-y2) / (x1-x2);
  100.         B := y1 - (M * x1);
  101.         IF clickY > (M * clickX) + B THEN whichSide := true
  102.         ELSE whichSide := false;
  103.         IF x1 < X2 THEN whichSide := NOT(whichSide);
  104.     END;
  105.     
  106.     IF x1 = x2 THEN
  107.     BEGIN
  108.         IF (y1 > y2) AND (clickX > x1) THEN whichSide := false;
  109.         IF (y1 > y2) AND (clickX < x1) THEN whichSide := true;
  110.         IF (y1 < y2) AND (clickX > x1) THEN whichSide := true;
  111.         IF (y1 < y2) AND (clickX < x1) THEN whichSide := false;
  112.     END;
  113.  
  114.     IF y1 = y2 THEN
  115.     BEGIN
  116.         IF (x1 > x2) AND (clickY > y1) THEN  whichSide := true;
  117.         IF (x1 > x2) AND (clickY < y1) THEN  whichSide := false;
  118.         IF (x1 < x2) AND (clickY > y1) THEN  whichSide := false;
  119.         IF (x1 < x2) AND (clickY < y1) THEN  whichSide := true;
  120.     END;
  121.     clickOnWhatSide := whichSide;
  122. END;
  123.  
  124.  
  125. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  126. {** This procedure calculates the horizontal center of the user screen
  127.     and returns the start and stop X values in screen coordinates.        }
  128. VAR
  129.     scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  130.     
  131. BEGIN
  132.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  133.     w := dX2 - dX1;
  134.     x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  135.     x2 := x1 + w;
  136. END;
  137.  
  138. Procedure LocateButtons2(scnh,scnw : INTEGER);
  139. {
  140. This procedure locates the 'OK' and 'Cancel' buttons centered at the bottom of the dialog box.
  141. }
  142. VAR
  143.     v1,v2,v3,v4 : INTEGER;
  144.  
  145. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  146. VAR
  147.     Temp : INTEGER;
  148. BEGIN
  149.     Temp:=m1;
  150.     m1:=m3;
  151.     m3:=Temp;
  152.     Temp:=m2;
  153.     m2:=m4;
  154.     m4:=Temp;
  155. END;        {of Swap}
  156.  
  157. BEGIN
  158.     px1:=scnw - 180;
  159.     px2:=scnw - 110;
  160.     px3:=scnw - 90;
  161.     px4:=scnw - 20;
  162.  
  163.     py1:=scnh-40;
  164.     py2:=scnh-20;
  165.     py3:=py1;
  166.     py4:=py2;
  167.  
  168.     GetVersion(v1,v2,v3,v4);
  169.     IF v4 = 1 THEN Swap(px1,px2,px3,px4);
  170.  
  171. END;        {of Locate Buttons2}
  172.  
  173.  
  174. {** Main program **}
  175.  
  176. BEGIN
  177.     pushAttrs;
  178.     ANGLEVAR;
  179.     FillFore(0,0,0);
  180.     PenSize(kLineSize);
  181.     
  182. {** Get angle with respect to x-axis and inside radius dimension of object.}
  183.     CENTERDIALOG(0,384,dlogX1,dlogX2);
  184.     LocateButtons2(152,384);
  185.     BEGINDIALOG(1,1,dlogX1,192,dlogX2,344);
  186.         ADDBUTTON('OK',1,1,px1,py1,px2,py2);
  187.         ADDBUTTON('Cancel',2,1,px3,py3,px4,py4);
  188.         ADDFIELD('Enter the elbow angle and the inside radius:',3,1,13,9,325,27);
  189.         ADDFIELD('Angle:',4,1,48,47,93,65);
  190.         ADDFIELD('Radius:',5,1,41,76,93,94);
  191.         ADDFIELD('90í',6,2,105,46,145,61);
  192.         ADDFIELD('12"',7,2,105,75,145,91);
  193.         ADDBUTTON('Lined',8,2,180,46,240,61);
  194.         ADDBUTTON('Filled',9,2,275,46,335,61);
  195.         ADDBUTTON('Insulated',10,2,180,75,260,91);
  196.         ADDBUTTON('Labeled',11,2,275,75,345,91);
  197.     ENDDIALOG;
  198.     
  199.     GetDialog(1);
  200.     finished := FALSE;
  201.     cancel:= FALSE;
  202.     SetTitle('Create Elbow');
  203.     REPEAT DialogEvent(item);
  204.         IF item = 2 THEN
  205.         BEGIN
  206.             finished := TRUE;
  207.             cancel := TRUE;
  208.         END;
  209.         IF item = 1 THEN finished := TRUE;
  210.         IF item > 7 THEN SetItem(item, not(ItemSel(item)));
  211.     UNTIL finished;
  212.     theta := Deg2Rad(Str2Num(GetField(6)));
  213.     r1:=Str2Num(GetField(7));
  214.     lined := ItemSel(8);
  215.     filled := ItemSel(9);
  216.     insulated := ItemSel(10);
  217.     labeled := ItemSel(11);
  218.     CLRDIALOG;
  219.         
  220.     IF NOT(cancel) THEN 
  221.     BEGIN
  222. {** Get angle and baseline of object. }
  223.         MESSAGE('Draw the baseline of the elbow...');
  224.         GetLine(x1,y1,x2,y2);
  225.         IF NOT((x1 = x2) AND (y1 = y2)) THEN
  226.         BEGIN
  227.             {IF (y1 < y2) THEN 
  228.             BEGIN
  229.                 Switch(y1,y2);
  230.                 Switch(x1,x2);
  231.             END;}
  232.             IF (x1 > x2) THEN 
  233.             BEGIN
  234.                 Switch(y1,y2);
  235.                 Switch(x1,x2);
  236.             END;
  237.             L:=Distance(x1,y1,x2,y2);
  238.             Alpha:=Rad2Deg(ArcCos((x2-x1)/L));
  239.             IF y2 < y1 THEN Alpha:=360 - Alpha;
  240.             
  241.     {** Draw a cross and get direction of object with respect to x-axis.}
  242.                 pushAttrs;
  243.                 PenSize(1);
  244.                 PenFore(65535,0,0);
  245.                 MoveTo(x1,y1);
  246.                 LineTo(x2,y2);
  247.                 han1:=LObject;
  248.                 qx1 := xt(L/2,-L/2,x1,y1,Alpha);
  249.                 qy1 := yt(L/2,-L/2,x1,y1,Alpha);
  250.                 MOVETO(qx1,qy1);
  251.                 qx2 := xt(L/2,L/2,x1,y1,Alpha);
  252.                 qy2 := yt(L/2,L/2,x1,y1,Alpha);
  253.                 LineTo(qx2,qy2);
  254.                 han2:=LObject;
  255.                 Redraw;
  256.                 popAttrs;
  257.             
  258.                 MESSAGE('Click in the quadrant of the desired elbow bend.');
  259.                 GetPt(clickX1,clickY1);
  260.             
  261.                 leftOfVer := clickOnWhatSide(x1,y1,x2,y2,clickX1,clickY1);
  262.                 aboveHor := clickOnWhatSide(qX1,qY1,qX2,qY2,clickX1,clickY1);
  263.                 
  264.                 IF aboveHor AND NOT(leftOfVer) THEN quadrant := 1;
  265.                 IF aboveHor AND leftOfVer THEN quadrant := 2;
  266.                 IF NOT(aboveHor) AND leftOfVer THEN quadrant := 3;
  267.                 IF NOT(aboveHor) AND NOT(leftOfVer) THEN quadrant := 4;
  268.  
  269.     {**    Determine the insertion point of object.}
  270.                 IF (quadrant = 1) | (quadrant = 2) THEN
  271.                 BEGIN
  272.                     x0:=x2;
  273.                     y0:=y2;
  274.                     IF lined THEN
  275.                     BEGIN
  276.                         L1x0:= x2 - kLinedOffset*Cos(Deg2Rad(Alpha));
  277.                         L1y0:= y2 - kLinedOffset*Sin(Deg2Rad(Alpha));
  278.                         L2x0:= x2 - (L - kLinedOffset)*Cos(Deg2Rad(Alpha));
  279.                         L2y0:= y2 - (L - kLinedOffset)*Sin(Deg2Rad(Alpha));
  280.                     END;
  281.                 END;
  282.                 IF (quadrant = 3) | (quadrant = 4) THEN
  283.                 BEGIN
  284.                     x0:=x1;
  285.                     y0:=y1;
  286.                     IF lined THEN
  287.                     BEGIN
  288.                         L1x0:= x1 +  kLinedOffset*Cos(Deg2Rad(Alpha));
  289.                         L1y0:= y1 + kLinedOffset*Sin(Deg2Rad(Alpha));
  290.                         L2x0:= x1 + (L - kLinedOffset)*Cos(Deg2Rad(Alpha));
  291.                         L2y0:= y1 + (L - kLinedOffset)*Sin(Deg2Rad(Alpha));
  292.                     END;
  293.                 END;
  294.                 Alpha := Alpha + 180;
  295.                 DSelectAll;
  296.             
  297.     {** Initialize variables with parmetric formulas of the object.}
  298.                 
  299.                 a := r1*tan(theta/2);
  300.                 b := r1*sin(theta);
  301.                 c := (r1 + L)*tan(theta/2);
  302.                 d := (r1 + L)*sin(theta);
  303.                 e := r1-(r1*cos(theta));
  304.                 f := r1-((r1 + L)*cos(theta));
  305.                 IF lined THEN 
  306.                 BEGIN
  307.                     g:= (r1 + kLinedOffset)*tan(theta/2);
  308.                     h:= (r1 + kLinedOffset)*sin(theta);
  309.                     i:= ((r1 + L) - kLinedOffset)*tan(theta/2);
  310.                     j:= ((r1 + L) - kLinedOffset)*sin(theta);
  311.                     m:= ((r1 + L) - kLinedOffset)-(((r1 + L) - kLinedOffset)*cos(theta));
  312.                     n:= (r1 + kLinedOffset)-((r1 + kLinedOffset)*cos(theta));
  313.                 END;
  314.  
  315.     
  316.     {** Calculate the coordinates of the poly points relative to the insertion point
  317.         of the object (x0,y0) at an angle of Alpha = 0.}
  318.             
  319.                             
  320.                 IF quadrant = 1 THEN
  321.                 
  322.                 BEGIN
  323.                     x[1]:=0;            y[1]:=0;        R[1]:=0;
  324.                     x[2]:=0;            y[2]:=-a;        R[2]:=r1;
  325.                     x[3]:=-e;            y[3]:=-b;        R[3]:=0;
  326.                     x[4]:=-f;            y[4]:=-d;        R[4]:=0;
  327.                     x[5]:=L;            y[5]:=-c;        R[5]:=r1 + L;
  328.                     x[6]:=L;            y[6]:=0;        R[6]:=0;
  329.                     IF lined THEN
  330.                     BEGIN
  331.                         xL1[1]:=0;            yL1[1]:=0;        RL1[1]:=0;
  332.                         xL1[2]:=0;            yL1[2]:=-g;        RL1[2]:=r1 + kLinedOffset;
  333.                         xL1[3]:=-n;            yL1[3]:=-h;        RL1[3]:=0;
  334.                         xL2[1]:=0;            yL2[1]:=0;        RL2[1]:=0;
  335.                         xL2[2]:=0;            yL2[2]:=-i;        RL2[2]:=(r1 + L) - kLinedOffset;
  336.                         xL2[3]:=-m;            yL2[3]:=-j;        RL2[3]:=0;
  337.                     END;
  338.                 END;
  339.  
  340.                 IF quadrant = 2 THEN
  341.                 
  342.                 BEGIN
  343.                     x[1]:=0;            y[1]:=0;        R[1]:=0;
  344.                     x[2]:=0;            y[2]:=a;        R[2]:=r1;
  345.                     x[3]:=-e;            y[3]:=b;        R[3]:=0;
  346.                     x[4]:=-f;            y[4]:=d;        R[4]:=0;
  347.                     x[5]:=L;            y[5]:=c;        R[5]:=r1 + L;
  348.                     x[6]:=L;            y[6]:=0;        R[6]:=0;
  349.                     IF lined THEN
  350.                     BEGIN
  351.                         xL1[1]:=0;            yL1[1]:=0;        RL1[1]:=0;
  352.                         xL1[2]:=0;            yL1[2]:=g;        RL1[2]:=r1 + kLinedOffset;
  353.                         xL1[3]:=-n;            yL1[3]:=h;        RL1[3]:=0;
  354.                         xL2[1]:=0;            yL2[1]:=0;        RL2[1]:=0;
  355.                         xL2[2]:=0;            yL2[2]:=i;        RL2[2]:=(r1 + L) - kLinedOffset;
  356.                         xL2[3]:=-m;            yL2[3]:=j;        RL2[3]:=0;
  357.                     END;
  358.                 END;
  359.  
  360.                 IF quadrant = 3 THEN
  361.                 
  362.                 BEGIN
  363.                     x[1]:=0;            y[1]:=0;        R[1]:=0;
  364.                     x[2]:=0;            y[2]:=a;        R[2]:=r1;
  365.                     x[3]:=e;            y[3]:=b;        R[3]:=0;
  366.                     x[4]:=f;            y[4]:=d;        R[4]:=0;
  367.                     x[5]:=-L;            y[5]:=c;        R[5]:=r1 + L;
  368.                     x[6]:=-L;            y[6]:=0;        R[6]:=0;
  369.                     IF lined THEN
  370.                     BEGIN
  371.                         xL1[1]:=0;            yL1[1]:=0;        RL1[1]:=0;
  372.                         xL1[2]:=0;            yL1[2]:=g;        RL1[2]:=r1 + kLinedOffset;
  373.                         xL1[3]:=n;            yL1[3]:=h;        RL1[3]:=0;
  374.                         xL2[1]:=0;            yL2[1]:=0;        RL2[1]:=0;
  375.                         xL2[2]:=0;            yL2[2]:=i;        RL2[2]:=(r1 + L) - kLinedOffset;
  376.                         xL2[3]:=m;            yL2[3]:=j;        RL2[3]:=0;
  377.                     END;
  378.                 END;
  379.  
  380.                 IF quadrant = 4 THEN
  381.                 
  382.                 BEGIN
  383.                     x[1]:=0;            y[1]:=0;        R[1]:=0;
  384.                     x[2]:=0;            y[2]:=-a;        R[2]:=r1;
  385.                     x[3]:=e;            y[3]:=-b;        R[3]:=0;
  386.                     x[4]:=f;            y[4]:=-d;        R[4]:=0;
  387.                     x[5]:=-L;            y[5]:=-c;        R[5]:=r1 + L;
  388.                     x[6]:=-L;            y[6]:=0;        R[6]:=0;
  389.                     IF lined THEN
  390.                     BEGIN
  391.                         xL1[1]:=0;            yL1[1]:=0;        RL1[1]:=0;
  392.                         xL1[2]:=0;            yL1[2]:=-g;        RL1[2]:=r1 + kLinedOffset;
  393.                         xL1[3]:=n;            yL1[3]:=-h;        RL1[3]:=0;
  394.                         xL2[1]:=0;            yL2[1]:=0;        RL2[1]:=0;
  395.                         xL2[2]:=0;            yL2[2]:=-i;        RL2[2]:=(r1 + L) - kLinedOffset;
  396.                         xL2[3]:=m;            yL2[3]:=-j;        RL2[3]:=0;
  397.                     END;
  398.                 END;
  399.                 
  400.                 ;
  401.     {** Calculate the points relative to the x and y axis of the drawing (0,0)
  402.         and, if appropiate, adjust for any rotation (Alpha).}
  403.         
  404.                 BEGINGROUP;
  405.                 
  406.                     IF filled THEN FillPat(kFilledPat) ELSE FillPat(kPlainPat);
  407.                     nPoints := 6;
  408.                     
  409.                     FOR k:=1 TO nPoints DO
  410.                     BEGIN
  411.                         xp[k]:=xt(x[k],y[k],x0,y0,Alpha);
  412.                         yp[k]:=yt(x[k],y[k],x0,y0,Alpha);
  413.                     END;
  414.                 
  415.     {** Move to the absolute coordinates of the first point and draw the polyline.}
  416.                         
  417.                     Absolute;
  418.                     MoveTo(x0,y0);
  419.                     ClosePoly;
  420.                     BeginPoly;
  421.                         FOR k:=1 TO nPoints DO
  422.                             DrawPolyPoint(xp[k],yp[k],R[k]);
  423.                     EndPoly;
  424.  
  425.     {** If user has asked for lined duct then draw the dashed curves.}
  426.  
  427.                     IF lined THEN
  428.                     BEGIN
  429.                         FillPat(0);
  430.                         PenPat(kDashedLine);
  431.                         nPoints := 3;
  432.                         FOR k:=1 TO nPoints DO
  433.                         BEGIN
  434.                             xp[k]:=xt(xL1[k],yL1[k],L1x0,L1y0,Alpha);
  435.                             yp[k]:=yt(xL1[k],yL1[k],L1x0,L1y0,Alpha);
  436.                         END;
  437.                     
  438.     {** Move to the absolute coordinates of the first point of the lining and draw the polyline.}
  439.                             
  440.                         MoveTo(L1x0,L1y0);
  441.                         OpenPoly;
  442.                         BeginPoly;
  443.                             FOR k:=1 TO nPoints DO
  444.                                 DrawPolyPoint(xp[k],yp[k],RL1[k]);
  445.                         EndPoly;
  446.                         
  447.                         FOR k:=1 TO nPoints DO
  448.                         BEGIN
  449.                             xp[k]:=xt(xL2[k],yL2[k],L2x0,L2y0,Alpha);
  450.                             yp[k]:=yt(xL2[k],yL2[k],L2x0,L2y0,Alpha);
  451.                         END;
  452.                         
  453.                         MoveTo(L2x0,L2y0);
  454.                         BeginPoly;
  455.                             FOR k:=1 TO nPoints DO
  456.                                 DrawPolyPoint(xp[k],yp[k],RL2[k]);
  457.                         EndPoly;
  458.                     END;
  459.                 ENDGROUP;
  460.         DelObject(han1);
  461.         DelObject(han2);
  462.         END;
  463.     END;
  464.     PopAttrs;
  465.     CLRMESSAGE;
  466. END;    {of Main program}
  467.  
  468. RUN(DrawElbow);
  469.