home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / 2DCON23D.MPC < prev    next >
Text File  |  1997-04-30  |  12KB  |  379 lines
  1. PROCEDURE PolyTo3DObject;
  2. LABEL 1,2;
  3. CONST
  4.     kSourceClassStr = 'DTM Source Objs';
  5.     kLocusClassStr = '3DLocus';
  6.     kPolyClassStr = '3DPolys';
  7.     kLocusLayerStr = '_3DLocus';
  8.     kPolyLayerStr = '_3DPolys';
  9.     kNameLength = 20;
  10.     kPolyID = 5;
  11.     kLocus3Did = 9;
  12.     kPoly3Did = 25;
  13. VAR
  14.     polyHandle,layerHandle,targetHandle : HANDLE;
  15.     red, green, blue, numObjects, numSObjects : LONGINT;
  16.     startElev, interval, suffix, myClassStr, s : STRING;
  17.     item, other, x1, x2, badFld, ck, convertPref : INTEGER;
  18.     dlogX1, dlogY1, dlogX2, dlogY2 : INTEGER;
  19.     cancel,finished,didNothing,interrupted,foundNonPoly : BOOLEAN;
  20.     foundStartElev,foundInterval,setLocusBtn,isOpen : BOOLEAN;
  21.     dummy, n, height,targetX,targetY,targetZ : REAL;
  22.     prevLW, keyCode, copyCount, j : INTEGER;
  23.     targetLayerName,sourceLayerName,candidateLayerName : STRING;
  24.     polyLayerName,locusLayerName:STRING;
  25.     layerName : STRING;
  26.  
  27. {**********************************************************}
  28. {*           Proc PolyTo3DObject by Frank Brault          *}
  29. {*              ⌐ 1996 Diehl Graphsoft, Inc.                 *}
  30. {*  Convert procedure based on work by Craig Hollinshead  *}           
  31. {*       Converts contour polygons to 3D contour polys.   *}
  32. {*      Use to preprocess contour data for DTM external.  *}
  33. {**********************************************************}
  34.  
  35. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  36. VAR
  37. scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  38. BEGIN
  39. GetScreen(scrX1,scrY1,scrX2,scrY2);
  40. w := dX2 - dX1;
  41. x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  42. x2 := x1 + w;
  43. END;
  44.  
  45. PROCEDURE LowDialog(width,height : INTEGER; VAR x1,y1,x2,y2 : INTEGER);
  46. CONST
  47.     kScreenSpace = 16;
  48. VAR
  49.     scrX1,scrY1,scrX2,scrY2 : INTEGER;
  50. BEGIN
  51.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  52.     x1 := ((scrX1 + scrX2) DIV 2) - (width DIV 2);
  53.     x2 := x1 + width;
  54.     y2 := scrY2 - kScreenSpace;
  55.     y1 := y2 - height;
  56. END;
  57.  
  58. PROCEDURE AlertUser(fldNum : INTEGER);
  59.  BEGIN
  60.     SysBeep;
  61.     finished := FALSE;
  62.     selField(fldNum);    
  63. END;
  64.  
  65. Function PolyIsOpen(PolyH : HANDLE) : BOOLEAN;
  66. {** Written by Tom Urie ⌐ 1996 Diehl Graphsoft, Inc.}
  67. LABEL 10,99;
  68. VAR
  69.     x0,y0,x1,y1,x2,y2,Perim : REAL;
  70.     j,NumVert,Type : INTEGER;
  71.     sp,sp1 : STRING;
  72. BEGIN
  73.     Type:=GetType(PolyH);
  74.     IF Type <> 5 THEN GOTO 99;
  75.     NumVert:=GetVertNum(PolyH);
  76.     Perim:=0;
  77.     FOR j:=1 TO NumVert DO BEGIN;
  78.         GetPolyPt(PolyH,j,x2,y2);
  79.         IF j = 1 THEN BEGIN
  80.             x0:=x2; y0:=y2;
  81.             GOTO 10;
  82.         END;
  83.         Perim:=Perim + Distance(x2,y2,x1,y1);
  84.         10:x1:=x2; y1:=y2;
  85.     END;
  86.     Perim:=Perim + Distance(x1,y1,x0,y0);
  87.     sp:=Num2Str(5,Perim);
  88.     sp1:=Num2Str(5,HPerim(PolyH));
  89.     IF sp <> sp1 THEN
  90.         PolyIsOpen:=TRUE
  91.     ELSE
  92.         PolyIsOpen:=FALSE;
  93. 99:END;
  94.  
  95. Procedure Convert2Polys(sourceHandle : HANDLE; elev : REAL);
  96. VAR
  97.     verX,verY,verX2,verY2:REAL;
  98.     i,totVertex:INTEGER;
  99.     newHandle : HANDLE;
  100. BEGIN
  101.     totVertex:=GetVertNum(sourceHandle);
  102.     Layer(targetLayerName);
  103.     GetPolyPt(sourceHandle,1,verX,verY);
  104.     GetPolyPt(sourceHandle,2,verX2,verY2);
  105.     
  106. {** create 3D poly and acquire handle }
  107.     IF isOpen THEN OPENPOLY ELSE CLOSEPOLY;        
  108.     Poly3D(verX,verY,elev,verX2,verY2,elev);
  109.     newHandle:=LNewObj;
  110.     FOR i := 3 TO totVertex DO BEGIN
  111.         GetPolyPt(sourceHandle,i,verX,verY);
  112.         AddVertex3D(newHandle,verX,verY,elev);
  113.     END;
  114.     Layer(sourceLayerName);
  115.     SetLW(sourceHandle,prevLW); {** Make line weight what it was. }
  116.     SetPenFore(sourceHandle,red,green,blue); {** Make pen color normal. }
  117.     didNothing := False;
  118.     Redraw;
  119. END; {** of Convert2Polys procedure }
  120.  
  121.  
  122. Procedure Convert2Loci(sourceHandle : HANDLE; elev : REAL);
  123. VAR
  124.     verX,verY:REAL;
  125.     i,totVertex:INTEGER;
  126. BEGIN
  127.     totVertex:=GetVertNum(sourceHandle);
  128.     Layer(targetLayerName);
  129.     FOR i := 1 TO totVertex DO BEGIN
  130.         GetPolyPt(sourceHandle,i,verX,verY);
  131.         Locus3D(verX,verY,elev);
  132.     END;
  133.     Layer(sourceLayerName);
  134.     SetLW(sourceHandle,prevLW); {** Make line weight what it was. }
  135.     SetPenFore(sourceHandle,red,green,blue); {** Make pen color normal. }
  136.     didNothing := False;
  137.     Redraw;
  138. END; {** of Convert2Locci procedure }
  139.  
  140. BEGIN
  141.     Absolute;
  142.     PushAttrs;
  143.     didNothing := True;
  144.     isOpen := True;
  145.     interrupted := False;
  146.     foundStartElev := False;
  147.     foundInterval := False;
  148.     foundNonPoly := False;
  149.     setLocusBtn := False;
  150.     sourceLayerName := GetLName(ActLayer);
  151.     numObjects := Count((T=Poly) & (L=sourceLayerName));
  152.     numSObjects := Count((T=Poly) & (SEL=TRUE) AND (L=sourceLayerName));
  153.     IF ((numSObjects < 1) AND (numObjects < 1)) THEN BEGIN
  154.         SysBeep;
  155.         AlrtDialog('I found no 2D polygons in this layer. Be sure 2D polygons are present and try again.');
  156.         GOTO 2;
  157.     END;
  158.     SetCursor(WatchC);
  159.     
  160.     IF ((numSObjects = 1) AND (GetClass(FSActLayer) = kSourceClassStr))THEN BEGIN
  161.         interrupted := True;
  162.         IF (Len(sourceLayerName) < (kNameLength - Len(kLocusLayerStr))) Then copyCount := Len(sourceLayerName) ELSE copyCount := (kNameLength - Len(kLocusLayerStr));
  163.         locusLayerName := Concat(Copy(sourceLayerName, 1, copyCount),kLocusLayerStr);
  164.         IF (Len(sourceLayerName) < (kNameLength - Len(kPolyLayerStr))) Then copyCount := Len(sourceLayerName) ELSE copyCount := (kNameLength - Len(kPolyLayerStr));
  165.         polyLayerName := Concat(Copy(sourceLayerName, 1, copyCount),kPolyLayerStr);
  166.         layerHandle := FLayer;
  167.         targetLayerName := sourceLayerName; {Load legit value in so it won't be empty for first time through. }
  168.         WHILE (targetLayerName <> locusLayerName) AND (targetLayerName <> polyLayerName) DO BEGIN
  169.             IF layerHandle = NIL THEN GOTO 1;
  170.             targetLayerName := GetLName(layerHandle);
  171.             candidateLayerName := targetLayerName;
  172.             layerHandle := NextLayer(layerHandle);
  173.         END;
  174.         IF (candidateLayerName = locusLayerName) Then Layer(locusLayerName);
  175.         IF (candidateLayerName = polyLayerName) Then Layer(polyLayerName);
  176.         IF (GetLName(ActLayer) = sourceLayerName) Then GOTO 1;
  177.         targetHandle := FInLayer(ActLayer);
  178.         FOR j := 1 TO (NumObj(ActLayer) -1) DO targetHandle := NextObj(targetHandle);
  179.         IF (targetHandle <> NIL) Then Begin
  180.             IF (GetType(targetHandle) = kPoly3DID) THEN BEGIN
  181.                 Get3DCntr(targetHandle,targetX,targetY,targetZ);
  182.                 startElev := Num2StrF(targetZ);
  183.                 foundStartElev := True;
  184.                 WHILE ((targetHandle <> NIL) AND (targetZ = str2Num(StartElev))) DO Begin
  185.                     targetHandle := PrevObj(targetHandle);
  186.                     Get3DCntr(targetHandle,targetX,targetY,targetZ);
  187.                 End;
  188.                 IF (targetZ <> str2Num(StartElev)) Then Begin
  189.                     interval := Num2StrF(ABS(str2Num(startElev) - targetZ));
  190.                     startElev := Num2StrF(str2Num(StartElev) + str2Num(interval));
  191.                     foundInterval := True;
  192.                 End;
  193.             End;
  194.             IF (GetType(targetHandle) = kLocus3DID) THEN BEGIN
  195.                 GetLocus3D(targetHandle,targetX,targetY,targetZ);
  196.                 setLocusBtn := True;
  197.                 startElev := Num2StrF(targetZ);
  198.                 foundStartElev := True;
  199.                 WHILE ((targetHandle <> NIL) AND (targetZ = str2Num(StartElev))) DO Begin
  200.                     targetHandle := PrevObj(targetHandle);
  201.                     GetLocus3D(targetHandle,targetX,targetY,targetZ);
  202.                 End;
  203.                 IF (targetZ <> str2Num(StartElev)) Then Begin
  204.                     interval := Num2StrF(ABS(str2Num(startElev) - targetZ));
  205.                     startElev := Num2StrF(str2Num(StartElev) + str2Num(interval));
  206.                     foundInterval := True;
  207.                 End;
  208.             End;
  209.         End;
  210.     End;
  211.         
  212.     1:Layer(sourceLayerName);
  213.     IF NOT(foundStartElev) THEN startElev := Num2StrF(0);
  214.     IF NOT(foundInterval) THEN interval := Num2StrF(2);
  215.     fPenFore(red,green,blue);
  216.     SetCursor(ArrowC);
  217.     CenterDialog(0,320,x1,x2);
  218.     BeginDialog(1,1,x1,166,x2,377);
  219.         AddButton('OK',1,1,238,169,302,192);
  220.         AddButton('Cancel',2,1,156,169,220,192);
  221.         AddField('___________________________________',3,1,11,11,312,29);
  222.         AddField('Poly To 3D Object Setup Dialog',4,1,12,4,225,22);
  223.         AddField('Start Elevation:',5,1,12,50,123,68);
  224.         AddField('Interval:',6,1,60,79,124,97);
  225.         AddField(startElev,7,2,144,50,230,65);
  226.         AddField(interval,8,2,144,82,230,97);
  227.         AddButton('Create 3D Polygons',9,3,11,117,169,135);
  228.         AddButton('Create 3D Loci',10,3,11,135,169,153);
  229.     EndDialog;
  230.     
  231.     GetDialog(1);
  232.     finished := FALSE;
  233.     cancel:= FALSE;
  234.     other := 9;
  235.     SelField(7);
  236.     IF setLocusBtn THEN
  237.         setItem(10,TRUE)
  238.     ELSE
  239.         SetItem(9,TRUE);
  240.     REPEAT DialogEvent(item);
  241.         IF item = 1 THEN BEGIN
  242.             finished := TRUE;
  243.             {** Check for unusable field entries }
  244.             badFld := 0;
  245.             FOR ck := 7 TO 8 DO BEGIN
  246.                 IF NOT(ValidNumStr(GetField(ck), dummy)) THEN badFld := ck;
  247.             END;
  248.             IF (str2Num(GetField(8)) <= 0) THEN badFld := 8;
  249.             IF (badFld <> 0) THEN alertUser(badFld);
  250.         END;
  251.         IF item = 2 THEN
  252.         BEGIN
  253.             finished := TRUE;
  254.             cancel := TRUE;
  255.         END;
  256.     IF item > 8 THEN
  257.         BEGIN
  258.             SetItem(other,FALSE);
  259.             SetItem(item,TRUE);
  260.             other := item;
  261.         END;
  262.     UNTIL finished;
  263.     startElev := GetField(7);
  264.     interval := GetField(8);
  265.     IF ItemSel(9)THEN BEGIN
  266.         convertPref := kPoly3Did;
  267.         myClassStr := kPolyClassStr;
  268.         suffix := kPolyLayerStr;
  269.     END;
  270.     IF ItemSel(10)THEN BEGIN
  271.         convertPref := kLocus3Did;
  272.         myClassStr := kLocusClassStr;
  273.         suffix := kLocusLayerStr;
  274.     END; 
  275.     
  276.     CLRDIALOG;
  277.     IF cancel THEN GOTO 2;
  278.     IF Len(sourceLayerName) < (kNameLength - Len(suffix)) THEN copyCount := Len(sourceLayerName) ELSE copyCount := (kNameLength - Len(suffix));
  279.     targetLayerName := CONCAT(Copy(sourceLayerName,1,copyCount),suffix);
  280.     
  281. {** Prepare polys for processing }
  282.     IF NOT(interrupted) THEN BEGIN
  283.         IF numObjects > 25 THEN MESSAGE('One moment please╔');
  284.         SetCursor(WATCHC);
  285.         DSelectAll;
  286.         SelectObj((T=Poly) & (L=sourceLayerName));
  287.         polyHandle := FSACTLAYER;
  288.         if (PolyIsOpen(polyHandle)) THEN isOpen := True Else isOpen := False;
  289.         While polyHandle <> NIL DO BEGIN
  290.             IF GetType(polyHandle) = kPolyID THEN BEGIN
  291.                 SetClass(polyHandle,kSourceClassStr);
  292.                 SetPenFore(polyHandle,0,0,65535); {** Make it Blue. }
  293.                 polyHandle := NextSObj(polyHandle);
  294.                 if (PolyIsOpen(polyHandle)) THEN isOpen := True Else isOpen := False;
  295.             END
  296.             ELSE foundNonPoly := True;
  297.         END;
  298.     END;
  299.         ClrMessage;
  300.         polyHandle := FSActLayer;
  301.         if (PolyIsOpen(polyHandle)) THEN isOpen := True Else isOpen := False;
  302.         SetCursor(ARROWC);
  303.         DSelectAll;
  304.         IF NOT(interrupted) THEN DoMenuText('Fit To Objects');
  305.         SetSelect(polyHandle);
  306.     IF (interrupted AND didNothing) THEN
  307.         prevLW := 1
  308.     ELSE
  309.         prevLW := GetLW(polyHandle);
  310.     SetPenFore(polyHandle,65535,0,0); {** Make color Red. }
  311.     SetLW(polyHandle,28); {** Make line weight thicker. }
  312.     ReDrawAll;
  313.  
  314.     LowDialog(462,93,dlogX1, dlogY1, dlogX2, dlogY2);
  315.     BeginDialog(2,1,dlogX1, dlogY1, dlogX2, dlogY2);
  316.         AddButton('Next',1,1,381,60,445,83);
  317.         AddButton('Done',2,1,300,60,364,83);
  318.         AddField('Interval:',3,1,17,13,84,31);
  319.         AddField(interval,4,1,86,13,145,31);
  320.         AddField(startElev,5,1,238,39,300,57);
  321.         AddField('Height of highlighted contour:',6,1,17,39,228,57);
  322.         AddButton('Use same height as prev.',7,2,16,66,215,84);
  323.         AddButton('Up',8,1,239,12,271,35);
  324.         AddButton('Dn',9,1,239,60,271,83);
  325.         {AddButton('< Back',11,1,300,12,364,35);}
  326.         {AddButton('Skip >',10,1,381,12,445,35);}
  327.     EndDialog;
  328.     
  329.     GetDialog(2);
  330.     finished := FALSE;
  331.     cancel:= FALSE;
  332.     REPEAT DialogEvent(item);
  333.         IF KeyDown(keyCode) THEN BEGIN
  334.             IF keyCode = 30 THEN SetField(5,Num2StrF(str2Num(GetField(5)) + str2Num(interval)));
  335.             IF keyCode = 31 THEN SetField(5,Num2StrF(str2Num(GetField(5)) - str2Num(interval)));
  336.         END;
  337.         IF item = 1 THEN BEGIN
  338.             height := str2Num(GetField(5));
  339.             IF (convertPref = kLocus3Did) THEN Convert2Loci(polyHandle, height);
  340.             IF (convertPref = kPoly3Did) THEN Convert2Polys(polyHandle, height);
  341.             SelectObj(C = kSourceClassStr);
  342.             polyHandle := NextSObj(polyHandle);
  343.             if (PolyIsOpen(polyHandle)) THEN isOpen := True Else isOpen := False;
  344.             IF polyHandle = NIL THEN finished := True;
  345.             IF NOT(finished) THEN BEGIN
  346.                 DSelectAll;
  347.                 SetSelect(polyHandle);
  348.                 prevLW := GetLW(polyHandle);
  349.                 SetPenFore(polyHandle,65535,0,0); {** Make pen color Red. }
  350.                 SetLW(polyHandle,28); {** Make line weight thicker. }
  351.                 ReDrawAll;
  352.                 IF NOT(didNothing OR itemSel(7)) THEN SetField(5,Num2StrF(str2Num(GetField(5)) + str2Num(interval)));
  353.             END;
  354.         END;
  355.         IF item = 2 THEN BEGIN
  356.             finished := TRUE;
  357.             cancel := TRUE;
  358.         END;
  359.         IF item = 7 THEN SetItem(item,NOT(itemSel(item)));
  360.         IF item = 8 THEN BEGIN
  361.             IF (itemSel(7)) THEN SetItem(7,False);
  362.             SetField(5,Num2StrF(str2Num(GetField(5)) + str2Num(interval)));
  363.         END;
  364.         IF item = 9 THEN BEGIN
  365.             IF (itemSel(7)) THEN SetItem(7,False);
  366.             SetField(5,Num2StrF(str2Num(GetField(5)) - str2Num(interval)));
  367.         END;
  368. {** Do we need to Check that we have more than 2 vertexes? }
  369.     UNTIL finished;
  370.     CLRDIALOG;
  371.     IF cancel THEN GOTO 2;
  372.     IF (foundNonPoly = TRUE) THEN AlrtDialog('One or more non-polygon objects were found and ignored.');
  373.     DSelectAll;
  374.     2:IF NOT(didNothing) THEN Layer(targetLayerName);
  375.     PopAttrs;
  376. END;
  377.  
  378. RUN(PolyTo3DObject);
  379.