home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / CRE_FCF.MPC < prev    next >
Text File  |  1997-04-30  |  20KB  |  1,073 lines
  1. Procedure CreateFCF;
  2. {
  3. (c)1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure creates a geometric tolerancing Feature Control Frame.
  7. }
  8.  
  9. LABEL 1,10,20,80,90,99;
  10.  
  11. CONST
  12.     CharWC = 0.09;
  13.     ClearWC = 0.07;
  14.     DiaLC = 0.17;
  15.     MCWC = 0.15;
  16.     STolWC = 0.25;
  17.  
  18. {The next two constants define the size of the geometric characteristic area}
  19.     GCSBoxLgthC = 0.34;
  20.     GCBoxHgtC = 0.2;
  21.  
  22. VAR
  23.     BoxHgt,GCBoxHgt : REAL;
  24.     GCSBoxLgth,TBoxLgth,DRBoxLgth : REAL;
  25.     CharW, ClearW,DiaL,DRefL,MCW,PTZL,TolL,STolW : REAL;
  26.     h,h1,x0,y0,x1,y1,xt,yt : REAL;
  27.     xb1,xb2,yb1,yb2,LScale : REAL;
  28.  
  29.     Width,sx1,sy1,sx2,sy2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  30.     nTolDialog,nDRefDialog,GeoSymNum : INTEGER;
  31.     ID2,i,n,TAreas,DAreas,TxtSize : INTEGER;
  32.     TMCSymNum : ARRAY[1..2] OF INTEGER;
  33.     DRMCSymNum : ARRAY[1..3] OF INTEGER;
  34.     RFlag : ARRAY[1..4] OF INTEGER;
  35.  
  36.     Abort,BigBox : BOOLEAN;
  37.     TDia,StatTol,PTZ : ARRAY[1..2] OF BOOLEAN;
  38.  
  39.     GCSymName : ARRAY[1..15] OF STRING;
  40.     PTZHgt,Tol : ARRAY[1..2] OF STRING;
  41.     DRef : ARRAY[1..3] OF STRING;
  42.     DiaChar : CHAR;
  43.  
  44.     LayerH,TextH : HANDLE;
  45.     GroupH : ARRAY[1..5] OF HANDLE;
  46.  
  47.     UPI : REAL;
  48.     Fmt : INTEGER;
  49.     UM,UM2 : STRING;
  50.     UName,DA : LONGINT;
  51.  
  52. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  53. {
  54. This procedure centers the dialog boxes on the screen.
  55. }
  56. VAR
  57.     scrx1,scry1,scrx2,scry2 : INTEGER;
  58.  
  59. BEGIN
  60.     GetScreen(scrx1,scry1,scrx2,scry2);
  61.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  62.     x2:=x1+Width; 
  63. END;
  64.  
  65. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  66. {
  67. This procedure locates the 'OK' and 'Cancel' buttons.
  68. }
  69. VAR
  70.     v1,v2,v3,v4 : INTEGER;
  71.     Mac : BOOLEAN;
  72.  
  73. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  74. VAR
  75.     Temp : INTEGER;
  76. BEGIN
  77.     Temp:=m1;
  78.     m1:=m3;
  79.     m3:=Temp;
  80.     Temp:=m2;
  81.     m2:=m4;
  82.     m4:=Temp;
  83. END;        {of Swap}
  84.  
  85. BEGIN
  86.     Mac:=FALSE;
  87.     GetVersion(v1,v2,v3,v4);
  88.     IF v4 = 1 THEN Mac:=TRUE;
  89.  
  90.     IF DialogType = 1 THEN
  91.     BEGIN
  92.         px1:=(scnw DIV 2) - 80;
  93.         px2:=(scnw DIV 2) - 10;
  94.         px3:=(scnw DIV 2) + 10;
  95.         px4:=(scnw DIV 2) + 80;
  96.         IF Mac THEN SWAP(px1,px2,px3,px4);
  97.  
  98.         py1:=scnh-40;
  99.         py2:=scnh-20;
  100.         py3:=py1;
  101.         py4:=py2;
  102.     END ELSE IF DialogType = 2 THEN
  103.     BEGIN
  104.         px1:=scnw - 180;
  105.         px2:=scnw - 110;
  106.         px3:=scnw - 90;
  107.         px4:=scnw - 20;
  108.         IF Mac THEN SWAP(px1,px2,px3,px4);
  109.  
  110.         py1:=scnh-40;
  111.         py2:=scnh-20;
  112.         py3:=py1;
  113.         py4:=py2;
  114.     END ELSE
  115.     BEGIN
  116.         px1:=scnw - 90;
  117.         px2:=scnw - 20;
  118.         px3:=px1;
  119.         px4:=px2;
  120.  
  121.         py1:=scnh -70;
  122.         py2:=scnh - 50;
  123.         py3:=scnh - 40;
  124.         py4:=scnh - 20;
  125.         IF Mac THEN SWAP(py1,py2,py3,py4);
  126.     END;
  127. END;        {of Locate Buttons}
  128.  
  129. {
  130. The following procedures create the various dialog boxes.
  131. }
  132.  
  133. Procedure GeomSymDialog;
  134. {
  135. This procedure creates the main dialog box.
  136. }
  137. Procedure MakeGeomSymDialog;
  138.  
  139. CONST
  140.     sy1=100;
  141.     scnh=270;
  142.     scnw=430;
  143.     DialogType = 2;
  144.  
  145. VAR
  146.     h : INTEGER;
  147.  
  148. BEGIN
  149.     AlignScr(scnw,sx1,sx2);
  150.     sy2:=sy1+scnh;
  151.     LocateButtons(DialogType,scnh,scnw);
  152.  
  153.     BeginDialog(1,1,sx1,sy1,sx2,sy2);
  154.         AddButton('OK',1,1,px1,py1,px2,py2);
  155.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  156.  
  157.         h:=35;
  158.         AddField('Geometric Characteristic:',5,1,20,44-h,290,60-h);
  159.          AddButton('Angularity',6,3,20,65-h,125,80-h);
  160.         AddButton('Circularity',7,3,20,85-h,125,100-h);
  161.         AddButton('Concentricity',8,3,20,105-h,125,120-h);
  162.         AddButton('Cylindricity',9,3,20,125-h,125,140-h);
  163.         AddButton('Flatness',10,3,20,145-h,125,160-h);
  164.  
  165.         AddButton('Parallelism',11,3,135,65-h,270,80-h);
  166.         AddButton('Perpendicularity',12,3,135,85-h,270,100-h);
  167.         AddButton('Position',13,3,135,105-h,270,120-h);
  168.         AddButton('Profile Line',14,3,135,125-h,270,140-h);
  169.         AddButton('Profile Surface',15,3,135,145-h,270,160-h);
  170.  
  171.         AddButton('Runout Circular',16,3,280,65-h,390,80-h);
  172.         AddButton('Runout Total',17,3,280,85-h,390,100-h);
  173.         AddButton('Straightness',18,3,280,105-h,390,120-h);
  174.         AddButton('Symmetry',19,3,280,125-h,390,140-h);
  175.         AddButton('None',20,3,280,145-h,390,160-h);
  176.  
  177.         AddButton('Composite Characteristic Box',34,2,20,175-h,235,190-h);
  178.  
  179.         AddField('No of Tolerance Areas:',21,1,20,205-h,180,220-h);
  180.         AddButton('1',22,3,20,225-h,50,240-h);
  181.         AddButton('2',23,3,60,225-h,90,240-h);
  182.  
  183.         AddField('No of Datum Areas:',24,1,210,205-h,350,220-h);
  184.         AddButton('0',25,3,210,225-h,240,240-h);
  185.         AddButton('1',26,3,250,225-h,280,240-h);
  186.         AddButton('2',27,3,290,225-h,320,240-h);
  187.         AddButton('3',28,3,330,225-h,360,240-h);
  188.     EndDialog;
  189. END;
  190.  
  191. BEGIN
  192.     MakeGeomSymDialog;
  193. END;
  194.  
  195. Procedure TolAreaDialog(TAreas : INTEGER);
  196. {
  197. This procedure defines the Tolerance Area(s) dialog box.
  198. }
  199.  
  200. Procedure MakeTolAreaDialog;
  201. LABEL 99;
  202.  
  203. CONST
  204.     sy1=50;
  205.     scnw=300;
  206.     DialogType = 2;
  207.  
  208. VAR
  209.     h,scnh,n,FieldID : INTEGER;
  210.     Title : ARRAY[1..2] OF STRING;
  211.  
  212. BEGIN
  213.     Title[1]:='Tolerance Area #1';
  214.     Title[2]:='Tolerance Area #2';
  215.  
  216.     scnh:=70+205*(TAreas);
  217.     AlignScr(scnw,sx1,sx2);
  218.     sy2:=sy1+scnh;
  219.     LocateButtons(DialogType,scnh,scnw);
  220.  
  221.     BeginDialog(2,1,sx1,sy1,sx2,sy2);
  222.         AddButton('OK',1,1,px1,py1,px2,py2);
  223.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  224.  
  225.         h:=5;
  226.         FieldID:=2;
  227.         FOR n:=1 TO TAreas DO
  228.         BEGIN
  229.             FieldID:=FieldID+1;
  230.             AddField('________________________________________',FieldID,1,20,h+8,285,h+24);
  231.             FieldID:=FieldID+1;
  232.             AddField(Title[n],FieldID,1,20,h-1,155,h+15);
  233.  
  234.             FieldID:=FieldID+1;
  235.             h:=h+35;
  236.             AddField('Tolerance:',FieldID,1,20,h-1,100,h+15);
  237.             FieldID:=FieldID+1;
  238.             AddField('',FieldID,2,105,h-1,170,h+15);
  239.  
  240.             FieldID:=FieldID+1;
  241.             AddButton('Diameter',FieldID,3,185,h,265,h+15);
  242.  
  243.             FieldID:=FieldID+1;
  244.             h:=h+30;
  245.             AddField('Material Condition:',FieldID,1,20,h-1,190,h+15);
  246.             FieldID:=FieldID+1;
  247.             h:=h+20;
  248.             AddButton('None',FieldID,3,20,h,70,h+15);
  249.             FieldID:=FieldID+1;
  250.             AddButton('Free State',FieldID,3,105,h,190,h+15);
  251.             FieldID:=FieldID+1;
  252.             AddButton('LMC',FieldID,3,220,h,270,h+15);
  253.  
  254.             FieldID:=FieldID+1;
  255.             h:=h+20;
  256.             AddButton('Tangent Plane',FieldID,3,50,h,165,h+15);
  257.             FieldID:=FieldID+1;
  258.             AddButton('MMC',FieldID,3,180,h,230,h+15);
  259.             FieldID:=FieldID+1;
  260.             h:=h+30;
  261.             AddButton('Statistical Tolerance',FieldID,2,20,h,300,h+15);
  262.  
  263.             FieldID:=FieldID+1;
  264.             h:=h+25;
  265.             AddButton('Projected Tolerance Zone',FieldID,2,20,h,300,h+15);
  266.  
  267.             FieldID:=FieldID+1;
  268.             h:=h+25;
  269.             AddField('Max Proj Height:',FieldID,1,20,h-1,140,h+15);
  270.             FieldID:=FieldID+1;
  271.             AddField('',FieldID,2,145,h,195,h+15);
  272.             h:=h+35;
  273.         END;
  274.     99:EndDialog;
  275. END;
  276.  
  277. BEGIN
  278.     MakeTolAreaDialog;
  279. END;
  280.  
  281. Procedure DRefAreaDialog(DAreas : INTEGER);
  282. {
  283. This procedure creates the Datum Reference Area(s) dialog box.
  284. }
  285. Procedure MakeDRefAreaDialog;
  286. LABEL 99;
  287.  
  288. CONST
  289.     sy1=50;
  290.     scnw=300;
  291.     DialogType = 2;
  292.  
  293. VAR
  294.     h,scnh,n,FieldID : INTEGER;
  295.     Title : ARRAY[1..3] OF STRING;
  296.  
  297. BEGIN
  298.     Title[1]:='Primary Datum Reference Area';
  299.     Title[2]:='Secondary Datum Reference Area';
  300.     Title[3]:='Tertiary Datum Reference Area';
  301.  
  302.     scnh:=50+117*(DAreas);
  303.     AlignScr(scnw,sx1,sx2);
  304.     sy2:=sy1+scnh;
  305.     LocateButtons(DialogType,scnh,scnw);
  306.  
  307.     BeginDialog(3,1,sx1,sy1,sx2,sy2);
  308.         AddButton('OK',1,1,px1,py1,px2,py2);
  309.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  310.  
  311.         h:=5;
  312.         FieldID:=2;
  313.         FOR n:=1 TO DAreas DO
  314.         BEGIN
  315.             FieldID:=FieldID+1;
  316.     AddField('________________________________________',FieldID,1,20,h+8,285,h+24);
  317.             FieldID:=FieldID+1;
  318.             AddField(Title[n],FieldID,1,20,h-1,280,h+15);
  319.  
  320.             FieldID:=FieldID+1;
  321.             h:=h+35;
  322.             AddField('Datum Reference Letter(s):',FieldID,1,20,h-1,210,h+15);
  323.             FieldID:=FieldID+1;
  324.             AddField('',FieldID,2,215,h-1,280,h+15);
  325.  
  326.             FieldID:=FieldID+1;
  327.             h:=h+30;
  328.             AddField('Material Condition:',FieldID,1,20,h-1,190,h+15);
  329.             FieldID:=FieldID+1;
  330.             h:=h+20;
  331.             AddButton('None',FieldID,3,20,h,70,h+15);
  332.             FieldID:=FieldID+1;
  333.             AddButton('LMC',FieldID,3,90,h,140,h+15);
  334.             FieldID:=FieldID+1;
  335.             AddButton('MMC',FieldID,3,160,h,210,h+15);
  336.             FieldID:=FieldID+1;
  337.             h:=h+35;
  338.         END;
  339.     99:EndDialog;
  340. END;
  341.  
  342. BEGIN
  343.     MakeDRefAreaDialog;
  344. END;
  345.  
  346. {
  347. The following procedures display the various dialog boxes and retrieve information from them.
  348. }
  349. Procedure SetRButton(i,Item : INTEGER);
  350. BEGIN
  351.     IF RFlag[i] <> Item THEN BEGIN
  352.         SetItem(RFlag[i],FALSE);
  353.         SetItem(Item,TRUE);
  354.         RFlag[i]:=Item;
  355.     END;
  356. END;
  357.  
  358. Procedure GetGeoTolInfo;
  359. {
  360. This procedure displays the main dialog box.
  361. }
  362. VAR
  363.     Done:Boolean;
  364.     i,Item:Integer;
  365.  
  366. BEGIN
  367.     Done:=FALSE;
  368.     Abort:=FALSE;
  369.     GeoSymNum:=1;
  370.     TAreas:=1;
  371.     DAreas:=1;
  372.     BigBox:=FALSE;
  373.     RFlag[1]:=6;
  374.     RFlag[2]:=22;
  375.     RFlag[3]:=26;
  376.     GetDialog(1);
  377.     SetTitle('Geometric Tolerancing - Feature Control Frame');
  378.     SetItem(RFlag[1],TRUE);
  379.     SetItem(RFlag[2],TRUE);
  380.     SetItem(RFlag[3],TRUE);
  381.     REPEAT
  382.         DialogEvent(Item);
  383.         IF Item=1 THEN
  384.             Done:=TRUE;
  385.  
  386.         IF Item=2 THEN
  387.         BEGIN
  388.             Done:=TRUE;
  389.             Abort:=TRUE;
  390.         END;
  391.  
  392.         IF (Item > 6)  AND (Item < 21) THEN
  393.         BEGIN
  394.             SetRButton(1,Item);        
  395.             GeoSymNum:=Item-5;
  396.         END;
  397.  
  398.         IF (Item = 22) OR (Item = 23) THEN
  399.         BEGIN
  400.             SetRButton(2,Item);
  401.             Tareas:=Item-21;
  402.         END;
  403.  
  404.         IF (Item > 24) AND (Item < 29) THEN
  405.         BEGIN
  406.             SetRButton(3,Item);
  407.             Dareas:=Item-25;
  408.         END;
  409.  
  410.         IF Item = 34 THEN
  411.         BEGIN
  412.             BigBox:=NOT BigBox;
  413.             SetItem(34,BigBox);
  414.         END;
  415.     UNTIL Done;
  416.     ClrDialog;
  417. END;
  418.  
  419. Procedure GetTolInfo;
  420. {
  421. This procedure displays the tolerance info dialog box(es).
  422. }
  423. VAR
  424.     Done:Boolean;
  425.     Item:Integer;
  426. BEGIN
  427.     Done:=FALSE;
  428.     Abort:=FALSE;
  429.     TMCSymNum[1]:=1;
  430.     TMCSymNum[2]:=1;
  431.     TDia[1]:=FALSE;
  432.     TDia[2]:=FALSE;
  433.     StatTol[1]:=FALSE;
  434.     StatTol[2]:=FALSE;
  435.     PTZ[1]:=FALSE;
  436.     PTZ[2]:=FALSE;
  437.     Tol[1]:=' ';
  438.     Tol[2]:=' ';
  439.     RFlag[1]:=9;
  440.     IF TAreas = 2 THEN
  441.         RFlag[2]:=24;
  442.     GetDialog(2);
  443.     SetTitle('Tolerance Areas');
  444.     SetItem(RFlag[1],TRUE);
  445.     SelField(6);
  446.     IF TAreas = 2 THEN
  447.         SetItem(RFlag[2],TRUE);
  448.  
  449.     REPEAT
  450.         DialogEvent(Item);
  451.         IF Item=1 THEN
  452.             Done:=TRUE;
  453.  
  454.         IF Item=2 THEN
  455.         BEGIN
  456.             Done:=TRUE;
  457.             Abort:=TRUE;
  458.         END;
  459.  
  460.         IF Item = 7 THEN
  461.         BEGIN
  462.             TDia[1]:= NOT TDia[1];
  463.             SetItem(7,TDia[1]);
  464.         END;
  465.  
  466.         IF (Item > 8) AND (Item < 14) THEN
  467.         BEGIN
  468.             SetRButton(1,Item);
  469.             TMCSymNum[1]:=Item-8;
  470.         END;
  471.  
  472.         IF Item = 14 THEN
  473.         BEGIN
  474.             StatTol[1]:= NOT StatTol[1];
  475.             SetItem(14,StatTol[1]);
  476.         END;
  477.  
  478.         IF Item = 15 THEN
  479.         BEGIN
  480.             PTZ[1]:= NOT PTZ[1];
  481.             SetItem(15,PTZ[1]);
  482.             IF PTZ[1] THEN SelField(17)
  483.             ELSE SetField(17,'');
  484.         END;
  485.  
  486.         IF Item = 22 THEN
  487.         BEGIN
  488.             TDia[2]:= NOT TDia[2];
  489.             SetItem(22,TDia[2]);
  490.         END;
  491.  
  492.         IF (Item > 23) AND (Item < 29) THEN
  493.         BEGIN
  494.             SetRButton(2,Item);
  495.             TMCSymNum[2]:=Item - 23;
  496.         END;
  497.  
  498.         IF Item = 29 THEN
  499.         BEGIN
  500.             StatTol[2]:= NOT StatTol[2];
  501.             SetItem(29,StatTol[2]);
  502.         END;
  503.  
  504.         IF Item = 30 THEN
  505.         BEGIN
  506.             PTZ[2]:= NOT PTZ[2];
  507.             SetItem(30,PTZ[2]);
  508.             IF PTZ[2] THEN SelField(32)
  509.             ELSE SetField(32,'');
  510.         END;
  511.  
  512.     UNTIL Done;
  513.     Tol[1]:=GetField(6);
  514.     PTZHgt[1]:=GetField(17);
  515.     IF TAreas = 2 THEN BEGIN
  516.         Tol[2]:=GetField(21);
  517.         PTZHgt[2]:=GetField(32);
  518.     END;
  519.     ClrDialog;
  520. END;
  521.  
  522. Procedure GetDRefInfo;
  523. VAR
  524.     Done:Boolean;
  525.     Item:Integer;
  526. BEGIN
  527.     Done:=FALSE;
  528.     Abort:=FALSE;
  529.     DRMCSymNum[1]:=1;
  530.     DRMCSymNum[2]:=1;
  531.     DRMCSymNum[3]:=1;
  532.     DRef[1]:=' ';
  533.     DRef[2]:=' ';
  534.     DRef[3]:=' ';
  535.     RFlag[1]:=8;
  536.     RFlag[2]:=17;
  537.     RFlag[3]:=26;
  538.     GetDialog(3);
  539.     SetTitle('Datum Reference Areas');
  540.     SetItem(8,TRUE);
  541.     IF (DAreas = 2) OR (DAreas = 3) THEN
  542.         SetItem(17,TRUE);
  543.     IF DAreas = 3 THEN
  544.         SetItem(26,TRUE);
  545.     SelField(6);
  546.  
  547.     REPEAT
  548.         DialogEvent(Item);
  549.         IF Item=1 THEN
  550.             Done:=TRUE;
  551.  
  552.         IF Item=2 THEN
  553.         BEGIN
  554.             Done:=TRUE;
  555.             Abort:=TRUE;
  556.         END;
  557.  
  558.         IF (Item > 7) AND (Item < 11) THEN
  559.         BEGIN
  560.             SetRButton(1,Item);
  561.             DRMCSymNum[1]:=2*Item-15;
  562.         END;
  563.  
  564.         IF (Item > 16) AND (Item < 20) THEN
  565.         BEGIN
  566.             SetRButton(2,Item);
  567.             DRMCSymNum[2]:=2*Item-33;
  568.         END;
  569.  
  570.         IF (Item > 25) AND (Item < 29) THEN
  571.         BEGIN
  572.             SetRButton(3,Item);
  573.             DRMCSymNum[3]:=2*Item-51;
  574.         END;
  575.  
  576.     UNTIL Done;
  577.     DRef[1]:=GetField(6);
  578.     IF (DAreas = 2) OR (DAreas = 3) THEN
  579.         DRef[2]:=GetField(15);
  580.     IF DAreas = 3 THEN
  581.         DRef[3]:=GetField(24);
  582.     ClrDialog;
  583. END;
  584.  
  585. Function GetActTextSize : INTEGER;
  586. {
  587. This function returns the active  text size.
  588. }
  589. VAR
  590.     a : INTEGER;
  591.     TextH : HANDLE;
  592.  
  593. BEGIN
  594.     DSelectAll;
  595.     TextOrigin(0,0);
  596.     BeginText;
  597.         ' '
  598.     EndText;
  599.     TextH:=FSActLayer;
  600.     GetActTextSize:=GetSize(TextH);
  601.     DelObject(TextH);
  602. END;
  603.  
  604. Procedure MakeGeomSymbol(SymNum : INTEGER);
  605. {
  606. This procedure creates the geometric tolerancing and material condition symbols used in the feature control frame.
  607. }
  608. VAR
  609.     A,p1,q1,r,r1 : REAL;
  610.     MatlCond : ARRAY[1..6] OF STRING;
  611.  
  612. BEGIN
  613.  
  614. {
  615. Define material condition symbol letters.
  616. }
  617.  
  618.     MatlCond[2]:='F';
  619.     MatlCond[3]:='L';
  620.     MatlCond[4]:='T';
  621.     MatlCond[5]:='M';
  622.     MatlCond[6]:='P';
  623.     r:=0.75*h;
  624.     r1:=0.5*h;
  625.     A:=Pi/6;
  626.     Relative;
  627.  
  628.     BeginGroup;
  629.     IF SymNum = 1 THEN
  630.     BEGIN
  631.         MoveTo(0.75*h, -0.433*h);
  632.         LineTo(-1.5*h, 0);
  633.         LineTo(1.5*h, 0.866*h);
  634.     END
  635.  
  636.     ELSE IF SymNum = 2 THEN
  637.     BEGIN
  638.         Arc(-r,r,r,-r,0,360);
  639.     END
  640.  
  641.     ELSE IF SymNum = 3 THEN
  642.     BEGIN
  643.         Arc(-r,r,r,-r,0,360);
  644.         Arc(-r1,r1,r1,-r1,0,360);
  645.     END
  646.  
  647.     ELSE IF SymNum = 4 THEN
  648.     BEGIN
  649.         q1:=0.75*h - 0.5*r1;
  650.         p1:=r1*Cos(A) - q1*Tan(A);
  651.         Arc(-r1,r1,r1,-r1,0,360);
  652.         MoveTo(p1, -0.75*h);
  653.         LineTo(1.5*h*Tan(A), 1.5*h);
  654.         MoveTo(-2*r1/Cos(A), 0);
  655.         LineTo(-1.5*h*Tan(A), -1.5*h);
  656.     END
  657.  
  658.     ELSE IF SymNum = 5 THEN
  659.     BEGIN
  660.         q1:=0.5*h;
  661.         p1:=0.75*h  - q1*Tan(A);
  662.         MoveTo(p1, -0.5*h);
  663.         LineTo(h*Tan(A), h);
  664.         LineTo(-1.5*h, 0);
  665.         LineTo(-h*Tan(A), -h);
  666.         LineTo(1.5*h, 0)
  667.     END
  668.  
  669.     ELSE IF SymNum = 6 THEN
  670.     BEGIN
  671.         q1:=0.75*h;
  672.         p1:=0.3*h  - q1*Tan(A);
  673.         MoveTo(p1, -0.75*h);
  674.         LineTo(1.5*h*Tan(A), 1.5*h);
  675.         MoveTo(-0.6*h, 0);
  676.         LineTo(-1.5*h*Tan(A), -1.5*h);
  677.     END
  678.  
  679.     ELSE IF SymNum = 7 THEN
  680.     BEGIN
  681.         MoveTo(-h, -0.75*h);
  682.         LineTo(2*h, 0);
  683.         MoveTo(-h, 0);
  684.         LineTo(0, 1.5*h);
  685.     END
  686.  
  687.     ELSE IF SymNum = 8 THEN
  688.     BEGIN
  689.         Arc(-r1,r1,r1,-r1,0,360);
  690.         MoveTo(-0.75*h, 0);
  691.         LineTo(1.5*h, 0);
  692.         MoveTo(-0.75*h, -0.75*h);
  693.         LineTo(0, 1.5*h);
  694.     END
  695.  
  696.     ELSE IF SymNum = 9 THEN
  697.     BEGIN
  698.         MoveTo(0, -h/2);
  699.         Arc(-h,h,h,-h,0,180);
  700.     END
  701.  
  702.     ELSE IF SymNum = 10 THEN
  703.     BEGIN
  704.         MoveTo(0, -h/2);
  705.         Arc(-h,h,h,-h,0,180);
  706.         MoveTo(-h, 0);
  707.         LineTo(2*h, 0);
  708.     END
  709.  
  710.     ELSE IF SymNum = 11 THEN
  711.     BEGIN
  712.         MoveTo(-0.75*h, -0.75*h);
  713.         LineTo(1.5*h, 1.5*h);
  714.         FillPat(2);
  715.         Poly(0,0, -0.354*h,-0.788*h, -0.424*h,0.424*h, 0.788*h,0.354*h);
  716.     END
  717.  
  718.     ELSE IF SymNum = 12 THEN
  719.     BEGIN
  720.         MoveTo(-1.3*h, -0.75*h);
  721.         LineTo(1.5*h, 1.5*h);
  722.         FillPat(2);
  723.         Poly(0,0, -0.354*h,-0.788*h, -0.424*h,0.424*h, 0.788*h,0.354*h);
  724.         MoveTo(-1.5*h, -1.5*h);
  725.         LineTo(1.1*h, 0);
  726.         LineTo(1.5*h, 1.5*h);
  727.         FillPat(2);
  728.         Poly(0,0, -0.354*h,-0.788*h, -0.424*h,0.424*h, 0.788*h,0.354*h);
  729.     END
  730.  
  731.     ELSE IF SymNum = 13 THEN
  732.     BEGIN
  733.         MoveTo(-h, 0);
  734.         LineTo(2*h, 0);
  735.     END
  736.  
  737.     ELSE IF SymNum = 14 THEN
  738.     BEGIN
  739.         MoveTo(-h, 0);
  740.         LineTo(2*h, 0);
  741.         MoveTo(-0.4*h, 0.5*h);
  742.         LineTo(-1.2*h, 0);
  743.         MoveTo(0, -h);
  744.         LineTo(1.2*h, 0);
  745.     END
  746.  
  747.     ELSE IF (SymNum >= 21) AND (SymNum <= 25) THEN
  748.     BEGIN
  749.         Arc(-r,r,r,-r,0,360);
  750.         TextOrigin(0, 0);
  751.         TextJust(2);
  752.         TextSize(0.8*TxtSize);
  753.         FillPat(0);
  754.         BeginText;
  755.             MatlCond[SymNum  - 19]
  756.         EndText;
  757.         TextH:=LNewObj;
  758.         GetBBox(TextH,xb1,yb1,xb2,yb2);
  759.         HMove(TextH,0,(yb1-yb2)/2);
  760.     END ELSE IF SymNum = 26 THEN
  761.  
  762.     BEGIN
  763.         OpenPoly;
  764.         BeginPoly;
  765.             LineTo(0, 0);
  766.             LineTo(0.433*h, 0.75*h);
  767.             LineTo(1.75*h, 0);
  768.             LineTo(0.433*h, -0.75*h);
  769.             LineTo(-0.433*h, -0.75*h);
  770.             LineTo(-1.75*h, 0);
  771.             LineTo(-0.433*h, 0.75*h);
  772.         EndPoly;
  773.         
  774.         TextJust(2);
  775.         TextSize(0.8*TxtSize);
  776.         FillPat(0);
  777.         Move(1.25*h, 0);
  778.         TextOrigin(0,0);
  779.         BeginText;
  780.             'ST'
  781.         EndText;
  782.         TextH:=LNewObj;
  783.         GetBBox(TextH,xb1,yb1,xb2,yb2);
  784.         HMove(TextH,0,(yb1-yb2)/2);
  785.     END;
  786.     EndGroup;
  787.  
  788.     FillPat(1);
  789.     TextSize(TxtSize);
  790. END;
  791.  
  792. {
  793. Main Program;
  794. }
  795. BEGIN
  796.     PushAttrs;
  797.     TextJust(2);
  798.     TextSpace(2);
  799.     FillPat(1);
  800.  
  801. {
  802. Display main dialog box and get information
  803. }
  804.  
  805.     GeomSymDialog;
  806.     SetCursor(ArrowC);
  807.     GetGeoTolInfo;
  808.     IF Abort THEN GOTO 99;
  809.  
  810. {
  811. Display tolerance dialog box and get tolerance information.
  812. }
  813.  
  814.     TolAreaDialog(TAreas);
  815.     GetTolInfo;
  816.     IF Abort THEN GOTO 99;
  817.  
  818. {
  819. Display Datum Reference dialog box and get datum reference information.
  820. }
  821.  
  822.     IF DAreas=0 THEN GOTO 10;
  823.     DRefAreaDialog(DAreas);
  824.     GetDRefInfo;
  825.     IF Abort THEN GOTO 99;
  826.     10:DSelectAll;
  827.  
  828. {
  829. Get default text size.
  830. }
  831.  
  832.     TxtSize:=GetActTextSize;
  833.     DiaChar:=Chr(175);
  834.  
  835. {
  836. Get layer scale and units per inch.
  837. }
  838.  
  839.     LayerH:=ActLayer;
  840.     LScale:=GetLScale(LayerH);
  841.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  842.  
  843. {
  844. Adjust constants for layer scale, units per inch and text size.
  845. }
  846.  
  847.     h1:=UPI*LScale*TxtSize/10;
  848.     h:=h1/10;
  849.     GCSBoxLgth:=GCSBoxLgthC*h1;
  850.     GCBoxHgt:=GCBoxHgtC*h1;
  851.     CharW:=CharWC*h1;
  852.     ClearW:=ClearWC*h1;
  853.     DiaL:=DiaLC*h1;
  854.     MCW:=MCWC*h1;
  855.     STolW:=STolWC*h1;
  856.  
  857. {
  858. Get insertion point.
  859. }
  860.  
  861.     1:GetPt(x0,y0);
  862.  
  863. {
  864. Draw Geometric Characteristic box and insert symbol. Convert symbol to a group and adjust size for layer scale.
  865. }
  866.  
  867.     Absolute;
  868.     MoveTo(x0,y0);
  869.     Relative;
  870.     x1:=x0;
  871.     yt:=y0 - GCBoxHgt/2;
  872.     BeginGroup;
  873.     IF GeoSymNum <> 15 THEN BEGIN
  874.         BeginGroup;
  875.         IF BigBox THEN BoxHgt:=2*GCBoxHgt
  876.         ELSE BoxHgt:=GCBoxHgt;
  877.         FillPat(1);
  878.         Rect(0,0,GCSBoxLgth,-BoxHgt);
  879.         Move(GCSBoxLgth/2,-BoxHgt/2);
  880.         MakeGeomSymbol(GeoSymNum);
  881.         EndGroup;
  882.         x1:=x0+GCSBoxLgth;
  883.     END;
  884.  
  885. {
  886. Create Tolerance box(es).
  887. }
  888.  
  889.     FOR n:=1 TO TAreas DO
  890.     BEGIN
  891.         IF Tol[n] = '' THEN GOTO 20;
  892.  
  893. {
  894. Calculate length of Tolerance box.
  895. }
  896.  
  897.         TolL:=Len(Tol[n])*CharW;
  898.         IF TDia[n] THEN BEGIN
  899.             Tol[n]:=Concat(DiaChar,' ',Tol[n]);
  900.             TolL:=TolL+DiaL;
  901.         END;
  902.         TBoxLgth:=TolL+2*ClearW;
  903.  
  904.         IF TMCSymNum[n] <> 1 THEN
  905.             TBoxLgth:=TBoxLgth + MCW + ClearW;
  906.  
  907.         IF StatTol[n] THEN
  908.             TBoxLgth:=TBoxLgth + STolW + ClearW;
  909.  
  910.         IF PTZ[n] THEN
  911.         BEGIN
  912.             TBoxLgth:=TBoxLgth + MCW +ClearW;
  913.             IF PTZHgt[n] <> '' THEN
  914.             BEGIN
  915.                 PTZL:=Len(PTZHgt[n])*CharW;
  916.                 TBoxLgth:=TBoxLgth + PTZL +ClearW;
  917.             END;
  918.         END;
  919.  
  920. {
  921. Draw Tolerance box.
  922. }
  923.  
  924.         xt:=x1;
  925.         DSelectAll;
  926.         Absolute;
  927.         MoveTo(xt, y0);
  928.         Relative;
  929.         BeginGroup;
  930.         FillPat(1);
  931.         Rect(0,0,TBoxLgth,-GCBoxHgt);
  932.  
  933. {
  934. Place tolerance text.
  935. }
  936.  
  937.         xt:=xt + TolL/2 + ClearW;
  938.         Absolute;
  939.         TextOrigin(xt, yt);
  940.         TextJust(2);
  941.         FillPat(0);
  942.         IF Tol[n] <> '' THEN BEGIN
  943.             BeginText;
  944.                 Tol[n]
  945.             EndText;
  946.         END;
  947.         TextH:=LNewObj;
  948.         GetBBox(TextH,xb1,yb1,xb2,yb2);
  949.         HMove(TextH,0,(yb1-yb2)/2);
  950.         xt:=xt + TolL/2 + ClearW;
  951.  
  952. {
  953. Insert material condition symbol, if needed.
  954. }
  955.  
  956.         IF TMCSymNum[n] <> 1 THEN BEGIN
  957.             xt:=xt + MCW/2;
  958.             Absolute;
  959.             MoveTo(xt, yt);
  960.             MakeGeomSymbol(TMCSymNum[n] + 19);
  961.             xt:=xt + MCW/2 + ClearW;
  962.         END;
  963.  
  964. {
  965. Insert Statistical Tolerance symbol, if needed.
  966. }
  967.  
  968.         IF StatTol[n] THEN BEGIN
  969.             Absolute;
  970.             MoveTo(xt, yt);
  971.             MakeGeomSymbol(26);
  972.             xt:=xt + STolW + ClearW;
  973.         END;
  974.  
  975. {
  976. Insert PTZ symbol and text, if needed.
  977. }
  978.  
  979.         IF PTZ[n] THEN BEGIN
  980.             Absolute;
  981.             xt:=xt + MCW/2;
  982.             MoveTo(xt, yt);
  983.             MakeGeomSymbol(25);
  984.             xt:=xt + MCW/2 + ClearW;
  985.  
  986.             IF PTZHgt[n] <> '' THEN BEGIN
  987.                 xt:=xt + PTZL/2;
  988.                 Absolute;
  989.                 TextOrigin(xt, yt);
  990.                 FillPat(0);
  991.                 BeginText;
  992.                     PTZHgt[n]
  993.                 EndText;
  994.                 TextH:=LNewObj;
  995.                 GetBBox(TextH,xb1,yb1,xb2,yb2);
  996.                 HMove(TextH,0,(yb1-yb2)/2);
  997.             END;
  998.         END;
  999.     x1:=x1 + TBoxLgth;
  1000.     EndGroup;
  1001.     20:END;
  1002.  
  1003. {
  1004. Create Datum Reference box(es).
  1005. }
  1006.  
  1007.     Absolute;
  1008.     MoveTo(x1, y0);
  1009.     Relative;
  1010.     FOR n:=1 TO DAreas DO BEGIN
  1011.     IF DRef[n] = '' THEN GOTO 80;
  1012.  
  1013. {
  1014. Calculate length of Datum Reference box.
  1015. }
  1016.  
  1017.         DRefL:=Len(DRef[n])*CharW;
  1018.         DRBoxLgth:=DRefL + 2*ClearW;
  1019.         IF DRMCSymNum[n] <> 1 THEN
  1020.             DRBoxLgth:=DRBoxLgth + MCW + ClearW;
  1021.  
  1022. {
  1023. Draw Datum Reference box.
  1024. }
  1025.  
  1026.         xt:=x1;
  1027.         Absolute;
  1028.         MoveTo(xt, y0);
  1029.         Relative;
  1030.         BeginGroup;
  1031.         FillPat(1);
  1032.         Rect(0,0,DRBoxLgth,-GCBoxHgt);
  1033.  
  1034. {
  1035. Place datum reference letter(s).
  1036. }
  1037.  
  1038.         xt:=xt + ClearW + DRefL/2;
  1039.         Absolute;
  1040.         TextOrigin(xt, yt);
  1041.         FillPat(0);
  1042.         IF DRef[n] <> '' THEN
  1043.         BEGIN
  1044.             BeginText;
  1045.                 DRef[n]
  1046.             EndText;
  1047.         END;
  1048.         TextH:=LNewObj;
  1049.         GetBBox(TextH,xb1,yb1,xb2,yb2);
  1050.         HMove(TextH,0,(yb1-yb2)/2);
  1051.         xt:=xt + DRefL/2 + ClearW;
  1052.  
  1053. {
  1054. Insert material condition symbol, if needed.
  1055. }
  1056.  
  1057.         IF DRMCSymNum[n] <> 1 THEN BEGIN
  1058.             xt:=xt + MCW/2;
  1059.             Absolute;
  1060.             MoveTo(xt, yt);
  1061.             MakeGeomSymbol(DRMCSymNum[n] + 19);
  1062.         END;
  1063.  
  1064.     EndGroup;
  1065.     x1:=x1 + DRBoxLgth;
  1066.     80:END;
  1067.  
  1068.     90:EndGroup;
  1069.     PopAttrs;
  1070. 99:END;
  1071.  
  1072. RUN(CreateFCF);
  1073.