home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / ARC2SEGS.MPC < prev    next >
Text File  |  1997-04-30  |  6KB  |  321 lines
  1. Procedure ConvToPoly;
  2. {
  3. ⌐1996, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure converts circles and arcs to a polygon by specifying the number of segments or the segment length.
  7. }
  8. LABEL 10,20,99;
  9.  
  10. VAR
  11.     a,b,f,r,Alpha,Beta,Theta1,Theta2,Theta3,x0,y0,x,y,SegLgth,NSegsR : REAL;
  12.     k,Method,nObjs,NSegs,ObjType : INTEGER;
  13.     SegLgthS : STRING;
  14.     Abort,OK : BOOLEAN;
  15.     LayerH,ObjH : HANDLE;
  16.     UPI,SF : REAL;
  17.     Fmt : INTEGER;
  18.     UM,UM2 : STRING;
  19.     UName,DA : LONGINT;
  20.  
  21. Procedure Dialog;
  22. {
  23. This procedure creates the dialog box.
  24. }
  25. VAR
  26.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  27.  
  28. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  29. VAR
  30.     scrx1,scry1,scrx2,scry2:INTEGER;
  31. BEGIN
  32.     GetScreen(scrx1,scry1,scrx2,scry2);
  33.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  34.     x2:=x1+Width; 
  35. END;
  36.  
  37. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  38. {
  39. This procedure locates the 'OK' and 'Cancel' buttons.
  40. }
  41. VAR
  42.     v1,v2,v3,v4 : INTEGER;
  43.     Mac : BOOLEAN;
  44.  
  45. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  46. VAR
  47.     Temp : INTEGER;
  48. BEGIN
  49.     Temp:=m1;
  50.     m1:=m3;
  51.     m3:=Temp;
  52.     Temp:=m2;
  53.     m2:=m4;
  54.     m4:=Temp;
  55. END;        {of Swap}
  56.  
  57. BEGIN
  58.     Mac:=FALSE;
  59.     GetVersion(v1,v2,v3,v4);
  60.     IF v4 = 1 THEN Mac:=TRUE;
  61.  
  62.     IF DialogType = 1 THEN
  63.     BEGIN
  64.         px1:=(scnw DIV 2) - 80;
  65.         px2:=(scnw DIV 2) - 10;
  66.         px3:=(scnw DIV 2) + 10;
  67.         px4:=(scnw DIV 2) + 80;
  68.         IF Mac THEN SWAP(px1,px2,px3,px4);
  69.  
  70.         py1:=scnh-40;
  71.         py2:=scnh-20;
  72.         py3:=py1;
  73.         py4:=py2;
  74.     END ELSE IF DialogType = 2 THEN
  75.     BEGIN
  76.         px1:=scnw - 180;
  77.         px2:=scnw - 110;
  78.         px3:=scnw - 90;
  79.         px4:=scnw - 20;
  80.         IF Mac THEN SWAP(px1,px2,px3,px4);
  81.  
  82.         py1:=scnh-40;
  83.         py2:=scnh-20;
  84.         py3:=py1;
  85.         py4:=py2;
  86.     END ELSE
  87.     BEGIN
  88.         px1:=scnw - 90;
  89.         px2:=scnw - 20;
  90.         px3:=px1;
  91.         px4:=px2;
  92.  
  93.         py1:=scnh -70;
  94.         py2:=scnh - 50;
  95.         py3:=scnh - 40;
  96.         py4:=scnh - 20;
  97.         IF Mac THEN SWAP(py1,py2,py3,py4);
  98.     END;
  99. END;        {of Locate Buttons}
  100.  
  101. Procedure MakeDialog;
  102. CONST
  103.     y1=100;
  104.     scnw=340;
  105.     scnh = 155;
  106.     DialogType = 1;
  107.  
  108. VAR
  109.     h : INTEGER;
  110.  
  111. BEGIN
  112.     AlignScr(scnw,x1,x2);
  113.     y2:=y1+scnh;
  114.     LocateButtons(DialogType,scnh,scnw );
  115.     
  116.     BeginDialog(1,1,x1,y1,x2,y2);
  117.         AddButton('OK',1,1,px1,py1,px2,py2);
  118.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  119.  
  120.         h:=-30;
  121.         AddField('Method:',3,1,20,39+h,185,55+h);
  122.         AddButton('Number of Segments:',4,3,20,65+h,185,80+h);
  123.         AddField('',5,2,190,65+h,265,80+h);
  124.  
  125.         AddButton('Segment Length:',6,3,20,90+h,173,105+h);
  126. AddField('',7,2,190,90+h,265,105+h);
  127.         AddField('',8,1,270,90+h,320,105+h);
  128.     EndDialog;
  129.         
  130. END;
  131.  
  132. BEGIN
  133.     MakeDialog;
  134. END;
  135.  
  136. Procedure InputFtIn(inputS:STRING; VAR a:REAL);
  137. {
  138. This procedure converts a 'Ft & In' string into decimal feet.
  139. }
  140. LABEL 90;
  141. VAR
  142.     feet,inches : REAL;
  143.     pos1,pos2 : INTEGER;
  144.     s1,s2 : STRING;
  145.     OK : BOOLEAN;
  146.  
  147. BEGIN
  148.     s1:='0';
  149.     s2:='0';
  150.     feet:=0;
  151.     inches:=0;
  152.     pos1:=Pos('''', inputS);
  153.     pos2:=Pos('"',inputS);
  154.     IF pos1=0 THEN
  155.     BEGIN
  156.         IF pos2=0 THEN
  157.             s2:=inputS
  158.         ELSE
  159.             s2:=Copy(inputS,1,pos2-1);
  160.         GOTO 90;
  161.     END ELSE
  162.     BEGIN
  163.         s1:=Copy(inputS,1,pos1-1);
  164.         IF Len(inputS)=pos1 THEN GOTO 90;
  165.         IF pos2=0 THEN
  166.         s2:=Copy(inputS,pos1+1,Len(inputS)-pos1)
  167.         ELSE
  168.         s2:=Copy(inputS,pos1+1,Len(inputS)-pos1-1);
  169.     END;
  170.     pos2:=Pos('-',s2);
  171.     IF pos2<>0 THEN
  172.         Delete(s2,pos2,1);
  173.     90: OK:=ValidNumStr(s1,feet);
  174.     OK:=ValidNumStr(s2,inches);
  175.     inches:=Abs(Inches);
  176.     a:=feet + inches/12;
  177. END;
  178.  
  179. Procedure GetInfo;
  180. {
  181. This procedure diaplays the dialog box and gets the information.
  182. }
  183. LABEL 10,90;
  184. VAR
  185.     Item : INTEGER;
  186.     Done : BOOLEAN;
  187.  
  188. BEGIN
  189.     Done:=FALSE;
  190.     Abort:=FALSE;
  191.     Method:=1;
  192.     GetDialog(1);
  193.     SetTitle('Convert Arc to Segments');
  194.     SetItem(4,TRUE);
  195.     SetField(5,'0');
  196.     SetField(7,'<n/a>');
  197.     SetField(8,UM);
  198.     SelField(5);
  199.     10:REPEAT
  200.         DialogEvent(Item);
  201.         IF Item=1 THEN
  202.             Done:=TRUE;
  203.         IF Item=2 THEN
  204.         BEGIN
  205.             Done:=TRUE;
  206.             Abort:=TRUE;
  207.         END;
  208.         IF ((Item=4)OR(Item=5))AND(Method<>1) THEN
  209.         BEGIN
  210.             SetItem(6,FALSE);
  211.             SetItem(4,TRUE);
  212.             Method:=1;
  213.             SetField(5,'0');
  214.             SetField(7,'<n/a>');
  215.             SelField(5);
  216.         END;
  217.         IF((Item=6)OR(Item=7))AND(Method<>2) THEN
  218.         BEGIN
  219.             SetItem(4,FALSE);
  220.             SetItem(6,TRUE);
  221.             Method:=2;
  222.             SetField(7,'0');
  223.             SetField(5,'<n/a>');
  224.             SelField(7);
  225.         END;   
  226.     UNTIL Done;
  227.     IF Abort THEN GOTO 90;
  228.     IF Method=1 THEN BEGIN
  229.         NSegs:=Str2Num(GetField(5));
  230.         IF NSegs>1 THEN GOTO 90;
  231.         Sysbeep;
  232.         SelField(5);
  233.         Done:=FALSE;
  234.         GOTO 10;
  235.     END ELSE
  236.     BEGIN
  237.         SegLgthS:=GetField(7);
  238.         IF UM=' Ft & In' THEN
  239.             InputFtIn(SegLgthS,SegLgth)
  240.         ELSE
  241.             SegLgth:=Str2Num(SegLgthS);
  242.         IF SegLgth>0 THEN GOTO 90;
  243.         Sysbeep;
  244.         SelField(7);
  245.         Done:=FALSE;
  246.         GOTO 10;
  247.     END;
  248.     90:ClrDialog;
  249. END;
  250.  
  251. {
  252. Main Program
  253. }
  254. BEGIN
  255.     LayerH:=ActLayer;
  256.     nObjs:=NumSObj(LayerH);
  257.     IF nObjs=1 THEN GOTO 10;
  258.         Sysbeep;
  259.         IF nObjs=0 THEN AlrtDialog('There are no objects selected!')
  260.         ELSE AlrtDialog('There are too many objects selected!');
  261.         GOTO 99;
  262.  
  263.     10:ObjH:=FSActLayer;
  264.     ObjType:=GetType(ObjH);
  265.     IF ObjType=6 THEN GOTO 20;
  266.         Sysbeep;
  267.         AlrtDialog('This command only works with circles and arcs.');
  268.         GOTO 99;
  269.  
  270.     20:Dialog;
  271.     f:=1;
  272.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  273.     IF (UM='"')AND(UM2=' sq ft') THEN
  274.     BEGIN
  275.         UM:=' Ft & In';
  276.         f:=12;
  277.     END
  278.     ELSE IF UM='''' THEN
  279.         UM:=' ft'
  280.     ELSE IF (UM='"')AND(UM2=' sq in') THEN
  281.         UM:=' in';
  282.     GetInfo;
  283.     IF Abort THEN GOTO 99;
  284.     DSelectAll;
  285.     HCenter(ObjH,x0,y0);
  286.     x0:=x0/f;
  287.     y0:=y0/f;
  288.     GetArc(ObjH,Theta1,Theta2);
  289.     r:=HPerim(ObjH)/Deg2Rad(Theta2);
  290.     x:=x0+r*Cos(Deg2Rad(Theta1));
  291.     y:=y0+r*Sin(Deg2Rad(Theta1));
  292.     IF Method=1 THEN
  293.         Alpha:=Deg2Rad(Theta2/NSegs)
  294.     ELSE BEGIN
  295.         Alpha:=2*ArcSin(SegLgth/(2*r));
  296.         NSegs:=Deg2Rad(Theta2)/Alpha;
  297.     END;
  298.     Theta3:=Deg2Rad(Theta1+Theta2);
  299.     Absolute;
  300.     OpenPoly;
  301.     BeginPoly;
  302.         LineTo(f*x,f*y);
  303.         FOR k:=1 TO NSegs DO
  304.         BEGIN
  305.             Beta:=Deg2Rad(Theta1)+k*Alpha;
  306.             IF Beta>Theta3 THEN Beta:=Theta3;
  307.             x:=x0+r*Cos(Beta);
  308.             y:=y0+r*Sin(Beta);
  309.             LineTo(f*x,f*y);
  310.         END;
  311.         IF Beta<Theta3 THEN
  312.         BEGIN
  313.             Beta:=Theta3;
  314.             x:=x0+r*Cos(Beta);
  315.             y:=y0+r*Sin(Beta);
  316.             LineTo(f*x,f*y);
  317.         END;
  318.     EndPoly;
  319. 99:END;
  320.  
  321. Run(ConvToPoly);