home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / HOLES.MPC < prev    next >
Text File  |  1997-04-30  |  12KB  |  606 lines
  1. Procedure Holes;
  2. {
  3. @1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure allows the user to place an unlimited number of same size drilled or tapped holes on a drawing.
  7. }
  8. LABEL 5,10,15,20,30,90,99;
  9. CONST
  10.     Alpha=30;
  11.     k1sd=0.20;
  12.     k1st=0.125;
  13.     k2s=0.1875;
  14.     k1t=0.25;
  15.     k2t=0.125;
  16.     k3t=0.0625;
  17.     k4=0.20;
  18. VAR
  19.     x,y,x1,y1,xm,ym,Dia,ID,Depth,D2,DD2,Dy,MaxDia : REAL;
  20.     Beta,Beta1,CDia,CDepth,CAngle,CskDepth,DDepth,k1s : REAL;
  21.     DPenSize,DPenPat,KeyCode,Type,View : INTEGER;
  22.     Abort,OK,NextClick,CenterMark : BOOLEAN;
  23.     Counterbore, Countersink : BOOLEAN;
  24.  
  25. Procedure HoleDialog;
  26. {
  27. This procedure creates the dialog box.
  28. }
  29. VAR
  30.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  31.  
  32. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  33. VAR
  34.     scrx1,scry1,scrx2,scry2:INTEGER;
  35. BEGIN
  36.     GetScreen(scrx1,scry1,scrx2,scry2);
  37.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  38.     x2:=x1+Width; 
  39. END;
  40.  
  41. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  42. {
  43. This procedure locates the 'OK' and 'Cancel' buttons.
  44. }
  45. VAR
  46.     v1,v2,v3,v4 : INTEGER;
  47.     Mac : BOOLEAN;
  48.  
  49. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  50. VAR
  51.     Temp : INTEGER;
  52. BEGIN
  53.     Temp:=m1;
  54.     m1:=m3;
  55.     m3:=Temp;
  56.     Temp:=m2;
  57.     m2:=m4;
  58.     m4:=Temp;
  59. END;        {of Swap}
  60.  
  61. BEGIN
  62.     Mac:=FALSE;
  63.     GetVersion(v1,v2,v3,v4);
  64.     IF v4 = 1 THEN Mac:=TRUE;
  65.  
  66.     IF DialogType = 1 THEN
  67.     BEGIN
  68.         px1:=(scnw DIV 2) - 80;
  69.         px2:=(scnw DIV 2) - 10;
  70.         px3:=(scnw DIV 2) + 10;
  71.         px4:=(scnw DIV 2) + 80;
  72.         IF Mac THEN SWAP(px1,px2,px3,px4);
  73.  
  74.         py1:=scnh-40;
  75.         py2:=scnh-20;
  76.         py3:=py1;
  77.         py4:=py2;
  78.     END ELSE IF DialogType = 2 THEN
  79.     BEGIN
  80.         px1:=scnw - 180;
  81.         px2:=scnw - 110;
  82.         px3:=scnw - 90;
  83.         px4:=scnw - 20;
  84.         IF Mac THEN SWAP(px1,px2,px3,px4);
  85.  
  86.         py1:=scnh-40;
  87.         py2:=scnh-20;
  88.         py3:=py1;
  89.         py4:=py2;
  90.     END ELSE
  91.     BEGIN
  92.         px1:=scnw - 90;
  93.         px2:=scnw - 20;
  94.         px3:=px1;
  95.         px4:=px2;
  96.  
  97.         py1:=scnh -70;
  98.         py2:=scnh - 50;
  99.         py3:=scnh - 40;
  100.         py4:=scnh - 20;
  101.         IF Mac THEN SWAP(py1,py2,py3,py4);
  102.     END;
  103. END;        {of Locate Buttons}
  104.  
  105. Procedure MakeDialog;
  106. {
  107. This procedure defines the dialog box.
  108. }
  109. CONST
  110.     y1 = 100;
  111.     scnw = 390;
  112.     scnh = 275;
  113.     DialogType = 2;
  114.  
  115. VAR
  116.     h,h0 : INTEGER;
  117.  
  118. BEGIN
  119.     h0:=0;
  120.     AlignScr(scnw,x1,x2);
  121.     y2:=y1+scnh;
  122.     LocateButtons(DialogType,scnh,scnw);
  123.  
  124.     BeginDialog(1,1,x1,y1,x2,y2);
  125.         AddButton('OK',1,1,px1,py1,px2,py2);
  126.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  127.  
  128.         h:=h0;
  129.         AddField('Type:',30,1,20,9+h,60,25+h);
  130.         AddButton('Drilled',31,3,65,10+h,125,25+h);
  131.         AddButton('Tapped',32,3,130,10+h,200,25+h);
  132.  
  133.         h:=h0-25;
  134.         AddField('Size:',19,1,20,59+h,130,75+h);
  135.         AddField('Diameter:',5,1,20,79+h,110,95+h);
  136.         AddField('',6,2,115,80+h,180,95+h);
  137.         AddField('Total Depth:',14,1,20,104+h,110,120+h);
  138.         AddField('',15,2,115,105+h,180,120+h);
  139.  
  140.         h:=h0+95;
  141.         AddField('View:',26,1,20,19+h,100,35+h);
  142.         AddButton('Top view',16,3,20,80+h,100,95+h);
  143.         AddButton('Side view - blind hole',17,3,20,40+h,200,55+h);
  144.         AddButton('Side view - thru hole',18,3,20,60+h,200,75+h);
  145.  
  146.         h:=h0-30;
  147.         AddButton('Counterbore',20,2,220,40+h,320,55+h);
  148.         AddButton('Countersink',21,2,220,60+h,320,75+h);  
  149.         AddField('Diameter:',22,1,220,84+h,295,100+h);
  150.         AddField('',23,2,300,85+h,365,100+h);
  151.         AddField('Depth:',24,1,220,109+h,295,125+h);
  152.         AddField('',25,2,300,110+h,365,125+h);
  153.  
  154.         h:=h0+60;
  155.         AddField('Location:',7,1,220,h+54,295,h+70);
  156.         AddField('X:',8,1,220,h+79,245,h+95);
  157.         AddField('',9,2,250,h+80,325,h+95);
  158.         AddField('Y:',10,1,220,h+104,245,h+120);
  159.         AddField('',11,2,250,h+105,325,h+120);
  160.         AddButton('Next Click(s)',12,3,220,h+130,325,h+145);
  161.  
  162.         AddButton('Show Center Mark',13,2,20,h+140,160,h+155);
  163.  
  164.     EndDialog;
  165. END;
  166.  
  167. BEGIN
  168.     MakeDialog;
  169. END;
  170.  
  171. Procedure GetInfo;
  172. {
  173. This procedure displays the dialog box and retrieves the information.
  174. }
  175. LABEL 5,10,30,99;
  176. VAR
  177.     Item,NTimes : INTEGER;
  178.     RFlag : ARRAY[1..2] OF INTEGER;
  179.     Done : BOOLEAN;
  180.  
  181. Procedure SetRButton(i,Item : INTEGER);
  182. BEGIN
  183.     IF RFlag[i] <> Item THEN BEGIN
  184.         SetItem(RFlag[i],FALSE);
  185.         SetItem(Item,TRUE);
  186.         RFlag[i]:=Item;
  187.     END;
  188. END;
  189.  
  190. BEGIN
  191.     Done:=FALSE;
  192.     Abort:=FALSE;
  193.     NTimes:=NTimes+1;
  194.     IF NTimes>1 THEN GOTO 5;
  195.  
  196.     {Dia:=0.500;
  197.     Depth:=2.000;
  198.     CDia:=0.750;
  199.     CDepth:=0.500;}
  200.  
  201.     Type:=1;
  202.     View:=2;
  203.     RFlag[1]:=17;
  204.     RFlag[2]:=31;
  205.     NextClick:=TRUE;
  206.     CenterMark:=TRUE;
  207.     Counterbore:=FALSE;
  208.     Countersink:=FALSE;
  209.  
  210.     5:GetDialog(1);
  211.     SetTitle('Holes');
  212.     SetItem(12,NextClick);
  213.     SetItem(13,CenterMark);
  214.     SetItem(RFlag[1],TRUE);
  215.     SetItem(RFlag[2],TRUE);
  216.     SetField(6,Num2StrF(Dia));
  217.     IF View<>1 THEN
  218.         SetField(15,Num2StrF(Depth))
  219.     ELSE
  220.         SetField(15,'<n/a>');
  221.     SetItem(20, Counterbore);
  222.     SetItem(21, Countersink);
  223.     IF Counterbore OR Countersink THEN
  224.     BEGIN
  225.         SetField(23,Num2StrF(CDia));
  226.         IF View=1 THEN
  227.             SetField(25,'<n/a>')
  228.         ELSE IF Counterbore THEN
  229.             SetField(25,Num2StrF(CDepth))
  230.         ELSE
  231.         BEGIN
  232.             SetField(24,'Incl. Angle:');
  233.             SetField(25,Num2StrF(Beta1));
  234.         END;
  235.     END ELSE
  236.     BEGIN
  237.         SetField(23,'<n/a>');
  238.         SetField(25,'<n/a>');
  239.     END;
  240.     IF NextClick THEN
  241.     BEGIN
  242.         SetField(9,'');
  243.         SetField(11,'');
  244.     END ELSE
  245.     BEGIN
  246.         SetField(9,Num2StrF(x));
  247.         SetField(11,Num2StrF(y));
  248.     END;
  249.     SelField(6);
  250.  
  251.     10:REPEAT
  252.         DialogEvent(Item);
  253.         IF Item=1 THEN
  254.             Done:=TRUE;
  255.  
  256.         IF Item=2 THEN
  257.         BEGIN
  258.             Done:=TRUE;
  259.             Abort:=TRUE;
  260.         END;
  261.  
  262.         IF Item=9 THEN
  263.         BEGIN
  264.             IF NextClick THEN
  265.             BEGIN
  266.                 NextClick:=FALSE;
  267.                 SetItem(12,FALSE);
  268.                 SetField(9,Num2StrF(x));
  269.                 SetField(11,Num2StrF(y));
  270.                 SelField(9);
  271.             END;
  272.         END;
  273.  
  274.         IF Item=11 THEN
  275.         BEGIN
  276.             IF NextClick THEN
  277.             BEGIN
  278.                 NextClick:=FALSE;
  279.                 SetItem(12,FALSE);
  280.                 SetField(9,Num2StrF(x));
  281.                 SetField(11,Num2StrF(y));
  282.                 SelField(9);
  283.             END;
  284.         END;
  285.  
  286.         IF Item=12 THEN
  287.         BEGIN
  288.             IF NOT NextClick THEN
  289.             BEGIN
  290.                 NextClick:=TRUE;
  291.                 SetItem(12,TRUE);
  292.                 SetField(9,'');
  293.                 SetField(11,'');
  294.                 SelField(6);
  295.             END ELSE
  296.             BEGIN
  297.                 NextClick:=FALSE;
  298.                 SetItem(12,FALSE);
  299.                 SetField(9,Num2StrF(x));
  300.                 SetField(11,Num2StrF(y));
  301.                 SelField(9);
  302.             END;
  303.         END;
  304.  
  305.         IF Item=13 THEN BEGIN
  306.             CenterMark:=NOT CenterMark;
  307.             SetItem(13,CenterMark);
  308.         END;
  309.  
  310.         IF (Item=15) AND (View=1) THEN
  311.             Sysbeep;
  312.  
  313.         IF Item=16 THEN
  314.         BEGIN
  315.             SetRButton(1,Item);        
  316.             View:=1;
  317.             SetField(15,'<n/a>');
  318.             SetField(25,'<n/a>');
  319.         END;
  320.  
  321.         IF (Item=17) OR (Item=18) THEN
  322.         BEGIN
  323.             IF View=1 THEN
  324.             BEGIN
  325.                 SetField(15,Num2StrF(Depth));
  326.                 IF Counterbore OR Countersink THEN
  327.                     SetField(25,Num2StrF(CDepth));
  328.             END;
  329.             SetRButton(1,Item);        
  330.             View:=Item-15;
  331.         END;
  332.  
  333.         IF Item=20 THEN
  334.         BEGIN
  335.             Counterbore:=NOT Counterbore;
  336.             SetItem(20, Counterbore);
  337.             IF Counterbore THEN BEGIN
  338.                 Countersink:=FALSE;
  339.                 SetItem(21, FALSE);
  340.                 SetField(24,'Depth:');
  341.                 SetField(23,Num2StrF(CDia));
  342.                 IF View<>1 THEN
  343.                     SetField(25,Num2StrF(CDepth));
  344.             END ELSE IF NOT Countersink THEN
  345.             BEGIN
  346.                 SetField(23,'<n/a>');
  347.                 SetField(25,'<n/a>');
  348.             END;
  349.         END;
  350.  
  351.         If Item=21 THEN
  352.         BEGIN
  353.             Countersink:=NOT Countersink;    
  354.             SetItem(21, Countersink);
  355.             IF Countersink THEN BEGIN
  356.                 Counterbore:=FALSE;
  357.                 SetItem(20, FALSE);
  358.                 SetField(24,'Incl. Angle:');
  359.                 SetField(23,Num2StrF(CDia));
  360.                 IF View<>1 THEN
  361.                     SetField(25,Num2StrF(Beta1));
  362.             END ELSE IF NOT Counterbore THEN
  363.             BEGIN
  364.                 SetField(23,'<n/a>');
  365.                 SetField(25,'<n/a>');
  366.             END;
  367.         END;
  368.  
  369.         IF Item=23 THEN
  370.         BEGIN
  371.             IF NOT(Counterbore OR Countersink) THEN BEGIN
  372.                 SysBeep;
  373.                 SetField(23,'<n/a>');
  374.             END;
  375.         END;
  376.  
  377.         IF Item=25 THEN
  378.         BEGIN
  379.             IF (NOT(Counterbore OR Countersink))OR(View=1) THEN
  380.             BEGIN
  381.                 Sysbeep;
  382.                 SetField(25,'<n/a>');
  383.             END;
  384.         END;
  385.  
  386.         IF (Item=31) OR (Item=32) THEN
  387.         BEGIN
  388.             SetRButton(2,Item);        
  389.             Type:=Item-30;
  390.         END;
  391.  
  392.     UNTIL Done;
  393.     IF Abort THEN GOTO 99;
  394.     OK:=ValidNumStr(GetField(6),Dia);
  395.     OK:=ValidNumStr(GetField(15),Depth);
  396.     IF (Dia<=0) OR ((Depth<=0) AND (View< 1)) THEN
  397.     BEGIN
  398.         Sysbeep;
  399.         Done:=FALSE;
  400.         IF Dia<=0 THEN SelField(6)
  401.         ELSE SelField(15);
  402.         GOTO 10;
  403.     END;
  404.     IF Counterbore OR Countersink THEN
  405.         BEGIN;
  406.         OK:=ValidNumStr(GetField(23),CDia);
  407.         IF Counterbore THEN
  408.             OK:=ValidNumStr(GetField(25),CDepth)
  409.         ELSE
  410.             OK:=ValidNumStr(GetField(25),Beta1);
  411.         IF ((CDia<=0) OR ((((CDepth<=0) AND Counterbore) OR ((Beta1<=0) AND Countersink)) AND (View<>1))) THEN
  412.         BEGIN
  413.             Sysbeep;
  414.             Done:=FALSE;
  415.             IF CDia<=0 THEN SelField(23)
  416.             ELSE SelField(25);
  417.             GOTO 10;
  418.         END;
  419.     END;
  420.     OK:=ValidNumStr(GetField(9),x);
  421.     OK:=ValidNumStr(GetField(11),y);
  422.     99:ClrDialog;
  423. END;
  424.  
  425. Procedure CMark1(Dia,x,y : REAL);
  426. VAR
  427.     L1,L2 : REAL;
  428. BEGIN
  429.     PushAttrs;
  430.     PenPat(2);
  431.     PenSize(5);
  432.     L1:=k1t;
  433.     IF L1 > Dia/2 THEN L1:=0.5*Dia;
  434.     L2:=Dia/2 + k2t - k3t - L1/2;
  435.     Absolute;
  436.     MoveTo(x,y);
  437.     Relative;
  438.     Move(-(Dia/2+k2t),0);
  439.     Line(L2,0);
  440.     Move(k3t,0);
  441.     Line(L1,0);
  442.     Move(k3t,0);
  443.     Line(L2,0);
  444.     Absolute;
  445.     MoveTo(x,y);
  446.     Relative;
  447.     Move(0,-(Dia/2+k2t));
  448.     Line(0,L2);
  449.     Move(0,k3t);
  450.     Line(0,L1);
  451.     Move(0,k3t);
  452.     Line(0,L2);
  453.     PopAttrs;
  454. END;
  455.  
  456. {
  457. Main Program.
  458. }
  459. BEGIN
  460.     DSelectAll;
  461. {
  462. Display dialog box.
  463. }
  464.     HoleDialog;
  465.     SetCursor(ArrowC);
  466. {
  467. Get information from the dialog box.
  468. }
  469.     GetInfo;
  470.     IF Abort THEN GOTO 99;
  471. {
  472. Calculate variables.
  473. }
  474.     IF Type=1 THEN
  475.     BEGIN
  476.         k1s:=k1sd;
  477.         IF View= 3THEN Dy:=0
  478.     ELSE Dy:=Dia*Tan(Deg2Rad(Alpha))/2;
  479.     END ELSE
  480.     BEGIN
  481.         k1s:=k1st;
  482.         ID:=Dia*(1-k4);
  483.         IF View = 3 THEN
  484.         BEGIN
  485.             D2:=Depth;
  486.             Dy:=0;
  487.         END ELSE
  488.         BEGIN
  489.             D2:=Depth + k1s*Dia;
  490.             Dy:=ID*Tan(Deg2Rad(Alpha))/2;
  491.         END;
  492.         DDepth:=Depth;
  493.         DD2:=D2;
  494.     END;
  495.     DPenSize:=FPenSize;
  496.     DPenPat:=FPenPat;
  497.     PushAttrs;
  498. {
  499. Draw holes.
  500. }
  501.     IF NextClick THEN
  502.     BEGIN
  503.         Message('Click location of hole(s). Hit any key to quit.');
  504.         SetCursor(LgCrossC);
  505.     END;
  506.     WHILE NOT KeyDown(KeyCode) DO
  507.     BEGIN
  508.         IF NOT NextClick THEN GOTO 5;
  509.         IF MouseDown(x,y) THEN
  510.         BEGIN
  511.             5:Absolute;
  512.             MoveTo(x,y);
  513.             IF View>1 THEN GOTO 15;
  514. {
  515. Top view.
  516. }
  517.             Relative;
  518.             IF Counterbore OR Countersink THEN
  519.             BEGIN
  520.                 Arc(-CDia/2,CDia/2,CDia/2,-CDia/2,0,360);
  521.                 MaxDia:=CDia;
  522.             END    ELSE
  523.                 MaxDia:=Dia;
  524.             IF Type=1 THEN
  525.                 Arc(-Dia/2,Dia/2,Dia/2,-Dia/2,0,360)
  526.             ELSE
  527.             BEGIN
  528.                 PenPat(-2);
  529.                 PenSize(0.5*DPenSize);
  530.                 Arc(-Dia/2,Dia/2,Dia/2,-Dia/2,0,360);
  531.                 PenPat(DPenPat);
  532.                 PenSize(DPenSize);
  533.                 Arc(-ID/2,ID/2,ID/2,-ID/2,0,360);
  534.             END;
  535.             IF CenterMark THEN CMark1(MaxDia,x,y);
  536.             GOTO 90;
  537. {
  538. Side View.
  539. }
  540.             15:Relative;
  541.             DDepth:=Depth;
  542.             IF Counterbore THEN
  543.             BEGIN
  544.                 DDepth:=Depth-CDepth;
  545.                 DD2:=D2-CDepth;
  546.                 Move(-CDia/2,0);
  547.                 Rect(0,0,CDia,-CDepth);
  548.                 Move(CDia/2,-CDepth);
  549.             END ELSE IF Countersink THEN
  550.             BEGIN
  551.                 Beta:=Deg2Rad(Beta1/2);
  552.                 CskDepth:=(CDia-Dia)/(2*Tan(Beta));
  553.                 DDepth:=Depth-CskDepth;
  554.                 DD2:=D2-CskDepth;
  555.                 Move(-CDia/2,0);
  556.                 ClosePoly;
  557.                 Poly(0,0,(CDia-Dia)/2,-CskDepth,Dia,0,(CDia-Dia)/2,CskDepth);
  558.                 Move(-CDia/2,-CskDepth);
  559.             END;
  560.             IF Type=1 THEN
  561.             BEGIN
  562.                 Move(-Dia/2,0);
  563.                 Rect(0,0,Dia,-DDepth);
  564.                 IF View=3 THEN GOTO 20;
  565.                 Move(0,-DDepth);
  566.                 ClosePoly;
  567.                 Poly(0,0,Dia/2,-Dy,Dia/2,Dy);
  568.             END ELSE
  569.             BEGIN
  570.                 Move(-ID/2,0);
  571.                 Rect(0,0,ID,-DD2);
  572.                 PenPat(-2);
  573.                 PenSize(0.5*DPenSize);
  574.                 Move(-(Dia-ID)/2,0);
  575.                 Line(0,-DDepth);
  576.                 IF View = 2 THEN
  577.                     Line(Dia,0)
  578.                 ELSE
  579.                     Move(Dia,0);
  580.                 Line(0,DDepth);
  581.                 PenPat(DPenPat);
  582.                 PenSize(DPenSize);
  583.                 IF View=3 THEN GOTO 20;
  584.                 Move(-(Dia+ID)/2,-DD2);
  585.                 ClosePoly;
  586.                 Poly(0,0,ID/2,-Dy,ID/2,Dy);
  587.             END;
  588.             20:IF CenterMark THEN BEGIN
  589.                 PushAttrs;
  590.                 PenPat(-9);
  591.                 PenSize(10);
  592.                 Absolute;
  593.                 MoveTo(x,y+k2s);
  594.                 Line(0,-(Depth+Dy+2*k2s));
  595.                 PopAttrs;
  596.             END;
  597.             90:Group;
  598.             Redraw;
  599.             DSelectAll;
  600.             IF NOT NextClick THEN GOTO 99;
  601.         END;
  602.     END;
  603.     ClrMessage;
  604. 99:END;
  605.  
  606. RUN(Holes);