home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / IMPORTS.MPC < prev    next >
Text File  |  1997-04-30  |  13KB  |  463 lines
  1. PROCEDURE ImportSurveyFile;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Frank Brault
  5. Based on original work by Erez Anzel
  6. Last modified: 04/18/97
  7.  
  8. For importing 3D coordinate data from a text file,
  9. then creating 3D loci from that data.
  10. Usually done for digitial terrain modeling.
  11. The imported data must be in 3, or 5 columns which are delimited,
  12. followed by a carriage return at the end of each line.
  13. The data file must be in the same folder as the MiniCad program.
  14. This macro was written to import data in the following order:
  15.  
  16. X, Y, Z (= E, N, Z) , Y, X, Z (= N, E, Z) , 
  17. pt.#, X, Y, Z, description , or pt.#, Y, X, Z, description
  18.  
  19. The second two formats incorporate the point number and point description,
  20. with the additional option of assigning these definitions to a database.
  21. Before running this macro, you should probably create a new layer
  22. or activate an empty layer which is to be used as a data layer for a terrain model.
  23.  
  24. This macro was written to work in Minicad
  25. for both Macintosh and Windows, version 7 or later.
  26. This macro will read Mac, Windows, and Unix data files.
  27. }
  28.  
  29. CONST
  30.     kMaxStrLen = 256;
  31.     kMaxArray = 6;
  32.     kEmptyString = '';
  33.     kZeroStr = '0.0';
  34.     kBiggestReal = 1.7E+308;
  35.     kSmallestReal = 5.0E-324;
  36.     kMaxCoord = 536870912.0; { MaxLongInt = (2**31) / 4 }
  37.     kTabChar = 9; {the ASCII value for a tab stop}
  38.     kLineFeedChar = 10; {the ASCII value for a line feed}
  39.     kCarriageReturnChar = 13;  {the ASCII value for a carriage return}
  40.     kCommaChar = 44;  {the ASCII value for a comma}
  41.     kColonChar = 58;  {the ASCII value for a colon}
  42.     kBackslashChar = 92;  {the ASCII value for a backslash}
  43.     kRecName = 'Survey Data';
  44.     kFld1 = 'Point #';
  45.     kFld2 = 'X';
  46.     kFld3 = 'Y';
  47.     kFld4 = 'Z';
  48.     kFld5 = 'Desc';
  49.     kTextFlag = 4;
  50.     kDimensionFlag = 9;
  51.     kDecPlaces = 9;
  52.  
  53. VAR
  54.     han : HANDLE;
  55.     x, y, z : REAL;
  56.     dataFileName : TEXT;
  57.     gX, gY, gZ : INTEGER;
  58.     frac,dispAcc : LONGINT;
  59.     ver1, ver2, ver3, ver4, format : INTEGER;
  60.     i, item, dLog1Width,dLog1Height : INTEGER;
  61.     bR,bT,bL,bB : INTEGER;  {** dialog <B>ox bounds}
  62.     cR,cT,cL,cB : INTEGER;  {** <C>ancel button }
  63.     dR,dT,dL,dB : INTEGER;  {** <D>efault Button }
  64.     cancel, finished, outOfBounds : BOOLEAN;
  65.     tryTabs, tryCommas : BOOLEAN;
  66.     unitMrk ,sqrUnitMrk, pathNameDelimiter : STRING;
  67.     counter, totalLines : LONGINT;
  68.     xFactor, yFactor, zFactor, upi : REAL;
  69.     minX, maxX, minY, maxY, minZ, maxZ : REAL;
  70.     xFirst, has5Flds, attachDB, centerData : BOOLEAN;
  71.     str1, str2, error, separator, fileNameText : STRING;
  72.     tabChar, lineFeedChar, carriageReturnChar : STRING;
  73.     commaChar, colonChar, backslashChar : STRING;
  74.     column : ARRAY[1..kMaxArray] OF STRING;
  75.  
  76. PROCEDURE SetUpDialog(wth,ht : INTEGER);
  77. {
  78. This procedure returns the bounding box coordinates
  79. of a dialog box and it's default and cancel buttons.
  80. }
  81. VAR
  82.     scrR,scrT,scrL,scrB : INTEGER;
  83.  
  84. Procedure Swap(VAR  p1,p2 : INTEGER);
  85. VAR
  86.     temp : INTEGER;
  87. BEGIN
  88.     temp := p1;
  89.     p1 := p2;
  90.     p2 := temp;
  91. END;
  92.  
  93. BEGIN
  94.     GetScreen(scrL,scrT,scrR,scrB);
  95. {** Determine the bounding box of the dialog}
  96.     bT := (scrB - ht)/3;
  97.     bB := bT + ht;
  98.     bR := (scrR DIV 2) - (wth DIV 2);
  99.     bL := bR + wth;
  100.     
  101. {** Determine both button X values}
  102.     cR := (wth DIV 2) - 80;
  103.     cL := (wth DIV 2) - 10;
  104.     dR := (wth DIV 2) + 10;
  105.     dL := (wth DIV 2) + 80;
  106.  
  107. {** Determine both button Y values}
  108.     cT := ht - 40;
  109.     cB := ht - 20;
  110.     dT := cT;
  111.     dB := cB;
  112.  
  113. {** If we're running on Windows, then
  114.     swap the cancel and default locations}
  115.     
  116.     IF ver4 = 2 THEN
  117.     BEGIN
  118.         SWAP(cR,dR);
  119.         SWAP(cL,dL);
  120.     END;
  121. END;
  122.  
  123.  
  124. PROCEDURE Toggle(first, second:INTEGER);
  125. BEGIN
  126.     SetItem(first,TRUE);
  127.     SetItem(second,FALSE);
  128. END;
  129.  
  130. PROCEDURE ToggleOn(first, second:INTEGER);
  131. BEGIN
  132.     SetItem(first,TRUE);
  133.     SetItem(second,FALSE);
  134.     SelField(10);
  135. END;
  136.  
  137. FUNCTION ValidStr(str : STRING) : BOOLEAN;
  138. BEGIN
  139.     IF (str = kEmptyString) THEN ValidStr := FALSE ELSE ValidStr := TRUE;
  140. END;
  141.  
  142. PROCEDURE MyReadLn(fileName : TEXT; VAR str, error : STRING);
  143.  
  144. VAR
  145.     done : BOOLEAN;
  146.     counter : INTEGER;
  147.     chr1 : CHAR;
  148.  
  149. BEGIN
  150.     done := FALSE;
  151.     counter := 0;
  152.     str := kEmptyString;
  153.     error := kEmptyString;
  154.  
  155.     WHILE NOT(EOLN(fileName) | EOF(fileName)) DO
  156.     BEGIN
  157.         READ(chr1);
  158.         str := CONCAT(str, chr1);
  159.     END;
  160.     counter := LEN(str);
  161.     IF counter = kMaxStrLen THEN error := CONCAT(error,'OVERFLOW!');    
  162. END;
  163.  
  164. PROCEDURE ParseStr(delimiter, str : STRING);
  165. VAR
  166.     item,n,a : INTEGER;
  167. BEGIN
  168. {** Initialize row array}
  169.     FOR n:=1 TO kMaxArray DO column[n]:= kEmptyString;
  170.     n := 1;
  171.     WHILE (POS(delimiter,str) <> 0) DO
  172.     BEGIN
  173.         item:= POS(delimiter,str);
  174.         column[n]:= COPY(str,1,item-1);
  175.         n := n + 1;
  176.         IF (POS(delimiter,str) <> 0) THEN DELETE(str,1,item);
  177.     END;
  178. {** Delete line terminator at last position of str
  179.     This takes into account Unix, DOS and Macintosh file formats}
  180.     IF ((Copy(str,LEN(str),1)) = lineFeedChar) THEN DELETE(str,LEN(str),1);
  181.     IF ((Copy(str,LEN(str),1)) = carriageReturnChar) THEN DELETE(str,LEN(str),1);
  182. {** Load remainder of str into next element of array}
  183.     column[n]:= str;
  184. END;
  185.  
  186. {*********  MAIN  *********}
  187.  
  188. BEGIN
  189. {** Prompt the user for the desired data file:}
  190.     MESSAGE('Please select a survey file to import...');
  191.     GETFILE(dataFileName);
  192.     CLRMESSAGE;
  193.     
  194. {** Check if there was an error in finding the file, or if the user canceled:}
  195.     IF NOT(FndError OR DidCancel) THEN
  196.     BEGIN
  197.         OPEN(dataFileName);
  198.         MyReadLn(dataFileName, str1, error);
  199.         CLOSE(dataFileName);
  200.         str2 := dataFileName;
  201.         
  202.     {** get Minicad version and platform info}
  203.         GetVersion(ver1,ver2,ver3,ver4);
  204.         
  205.     {** load string variables with constant ASSCI character values}
  206.         tabChar := Chr(kTabChar);
  207.         lineFeedChar := Chr(kLineFeedChar);
  208.         carriageReturnChar := Chr(kCarriageReturnChar);
  209.         commaChar := Chr(kCommaChar);
  210.         colonChar := Chr(kColonChar);
  211.         backslashChar := Chr(kBackslashChar);
  212.         
  213.  
  214.     {** Determine the name of the file for display in dialog}
  215.         IF ver4 = 1 THEN pathNameDelimiter := colonChar ELSE pathNameDelimiter := backslashChar;
  216.         i := 1;
  217.         WHILE (POS(pathNameDelimiter,str2) <> 0) DO
  218.         BEGIN
  219.             item:= POS(pathNameDelimiter,str2);
  220.             fileNameText:= COPY(str2,1,item-1);
  221.             i := i + 1;
  222.             IF (POS(pathNameDelimiter,str2) <> 0) THEN DELETE(str2,1,item);
  223.         END;
  224.  
  225.     {** Load remainder of str into fileNameText}
  226.         fileNameText:= str2;
  227.         str2 := CONCAT('1st line from ''',fileNameText,''' :');
  228.     
  229.     {** Initialize selector flag variables}
  230.         xFirst := TRUE;
  231.         has5Flds := FALSE;
  232.         attachDB := FALSE;
  233.         centerData := FALSE;
  234.         tryTabs := FALSE;
  235.         tryCommas := FALSE;
  236.         
  237.     {** If the first line has a tab char then we can test for number of fields, etc.}
  238.         IF (POS(tabChar,str1) <> 0) THEN
  239.         BEGIN
  240.             ParseStr(tabChar,str1);
  241.             IF ((column[4] <> kEmptyString) AND (column[5] <> kEmptyString)) THEN has5Flds := TRUE;
  242.             tryTabs := TRUE;
  243.         END;
  244.         
  245.     {** If the first line has a comma char then we can test for number of fields, etc.}
  246.         IF NOT(tryTabs) AND (POS(commaChar,str1) <> 0) THEN
  247.         BEGIN
  248.             ParseStr(commaChar,str1);
  249.             IF ((column[4] <> kEmptyString) AND (column[5] <> kEmptyString)) THEN has5Flds := TRUE;
  250.             tryCommas := TRUE;
  251.         END;
  252.         
  253.     {** Check if there was an error in opening the file:}
  254.         IF NOT(FndError) THEN
  255.         BEGIN
  256.             dLog1Width := 300;
  257.             dLog1Height := 346;
  258.             SetupDialog(dLog1Width,dLog1Height);
  259.             BeginDialog(1,1,bR,bT,bL,bB);
  260.                 AddButton('OK',1,1,dR,dT,dL,dB);
  261.                 AddButton('Cancel',2,1,cR,cT,cL,cB);
  262.                 AddField(str2,3,1,4,20,316,38);
  263.                 AddField(str1,4,1,4,44,316,65);
  264.                 AddField('Select File Format:',5,1,5,80,137,100);
  265.                 AddButton('Easting, Northing, Elevation (X, Y, Z)',6,3,15,102,290,120);
  266.                 AddButton('Northing, Easting, Elevation (Y, X, Z)',7,3,15,120,290,138);
  267.                 AddButton('Tab Delimited',8,3,15,153,290,171);
  268.                 AddButton('Other Character╔',9,3,15,171,150,189);
  269.                 AddField(commaChar,10,2,100,196,120,212);    
  270.                 AddButton('Data Contains Point # and Description',11,2,15,227,290,245);
  271.                 AddButton('Attach Database Info to Loci',12,2,15,245,290,263);
  272.                 AddButton('Center Data at Origin',13,2,15,263,290,278);
  273.             ENDDIALOG;
  274.             
  275.             GetDialog(1);
  276.             SetTitle('Survey File Import Setup Dialog');
  277.             finished := FALSE;
  278.             cancel:= FALSE;
  279.             SetItem(6,xFirst);
  280.             IF tryCommas THEN SetItem(9,TRUE) ELSE SetItem(8,TRUE);
  281.             SetItem(11,has5Flds);
  282.             SetItem(12,attachDB);
  283.             SetItem(13,centerData);
  284.             REPEAT DialogEvent(item);
  285.                 IF item = 6 THEN Toggle(6,7);
  286.                 IF item = 7 THEN Toggle(7,6);
  287.                 IF item = 8 THEN Toggle(8,9);
  288.                 IF item = 9 THEN ToggleOn(9,8);
  289.                 IF item = 11 THEN SetItem(11, not(ItemSel(11)));
  290.                 IF item = 12 THEN SetItem(12, not(ItemSel(12)));
  291.                 IF item = 13 THEN SetItem(13, not(ItemSel(13)));
  292.                 IF item = 2 THEN
  293.                 BEGIN
  294.                     finished := TRUE;
  295.                     cancel := TRUE;
  296.                 END;
  297.                 IF item = 1 THEN 
  298.                 BEGIN
  299.                     IF NOT(ValidStr(GetField(10))) THEN
  300.                     BEGIN
  301.                         SysBeep;
  302.                         SetField(10,'  ');
  303.                         SelField(10);
  304.                         WAIT(1);
  305.                         SetField(10,'');
  306.                         SelField(10);
  307.                     END
  308.                     ELSE
  309.                     finished := TRUE;
  310.                 END;
  311.             UNTIL finished;
  312.             xFirst := ItemSel(6);
  313.             has5Flds := ItemSel(11);
  314.             attachDB := ItemSel(12);
  315.             centerData := ItemSel(13);
  316.             IF itemSel(8) THEN separator := TabChar ELSE separator := GetField(10);
  317.             CLRDIALOG;
  318.             
  319.             IF NOT (Cancel) THEN
  320.             BEGIN
  321.             {** The user did not cancel, so open the file:}
  322.                 Open(dataFileName);
  323.             
  324.             {** Check if there was an error in opening the file:}
  325.                 IF NOT (fndError) THEN
  326.                 BEGIN
  327.                 {** Initialize variables}
  328.                 
  329.                     xFactor := 0;
  330.                     yFactor := 0;
  331.                     zFactor := 0;
  332.  
  333.                     IF has5Flds THEN
  334.                     BEGIN
  335.                         gX := 2;
  336.                         gY := 3;
  337.                         gZ := 4;
  338.                     END
  339.                     ELSE
  340.                     BEGIN
  341.                         gX := 1;
  342.                         gY := 2;
  343.                         gZ := 3;
  344.                     END;
  345.                     
  346.                     IF attachDB THEN
  347.                     BEGIN
  348.                         NewField(kRecName,kFld1,kZeroStr,kTextFlag,kDecPlaces);
  349.                         NewField(kRecName,kFld2,kZeroStr,kDimensionFlag,kDecPlaces);
  350.                         NewField(kRecName,kFld3,kZeroStr,kDimensionFlag,kDecPlaces);
  351.                         NewField(kRecName,kFld4,kZeroStr,kDimensionFlag,kDecPlaces);
  352.                         NewField(kRecName,kFld5,kZeroStr,kTextFlag,kDecPlaces);
  353.                     END;
  354.  
  355.                 {** This part determines the offset factors if the user has asked for the data to be centered}
  356.                     IF CenterData THEN
  357.                     BEGIN
  358.                         MESSAGE('One moment please...');
  359.                         SetCursor(WATCHC);
  360.                         counter := 0;
  361.                         
  362.                         minX:= kBiggestReal;
  363.                         maxX:= kSmallestReal;
  364.                         minY:= kBiggestReal;
  365.                         maxY:= kSmallestReal;
  366.                         minZ:= kBiggestReal;
  367.                         maxZ:= kSmallestReal;
  368.  
  369.                         WHILE NOT EOF(dataFileName) DO
  370.                         BEGIN
  371.                             MyReadLn(dataFileName, str1, error);
  372.                             IF NOT(EOF(dataFileName)) THEN
  373.                             BEGIN
  374.                                 ParseStr(separator,str1);
  375.                                 IF STR2NUM(column[gX]) < minX THEN minX := STR2NUM(column[gX]);
  376.                                 IF STR2NUM(column[gX]) > maxX THEN maxX := STR2NUM(column[gX]);
  377.                                 IF STR2NUM(column[gY]) < minY THEN minY := STR2NUM(column[gY]);
  378.                                 IF STR2NUM(column[gY]) > maxY THEN maxY := STR2NUM(column[gY]);
  379.                                 IF STR2NUM(column[gZ]) < minZ THEN minZ := STR2NUM(column[gZ]);
  380.                                 IF STR2NUM(column[gZ]) > maxZ THEN maxZ := STR2NUM(column[gZ]);
  381.                             END;
  382.                             counter := counter + 1;
  383.                         END;
  384.                         totalLines := counter - 1;
  385.                         xFactor := maxX-((maxX - minX)/2);
  386.                         yFactor := maxY-((maxY - minY)/2);
  387.                         zFactor := maxZ-((maxZ - minZ)/2);
  388.                         CLOSE(dataFileName);
  389.                         OPEN(dataFileName);
  390.                         SetCursor(ARROWC);
  391.                         CLRMESSAGE;
  392.                     END;
  393.                     
  394.                 {** Check the largest coordinates against the drawing space limits. }
  395.                     outOfBounds := FALSE;
  396.                     IF CenterData THEN
  397.                     BEGIN
  398.                         GetUnits(frac,dispAcc,format,upi,unitMrk,sqrUnitMrk);
  399.                         IF ABS(minX * frac) > kMaxCoord THEN outOfBounds := TRUE;
  400.                         IF ABS(maxX * frac) > kMaxCoord THEN outOfBounds := TRUE;
  401.                         IF ABS(minY * frac) > kMaxCoord THEN outOfBounds := TRUE;
  402.                         IF ABS(maxY * frac) > kMaxCoord THEN outOfBounds := TRUE;
  403.                         IF ABS(minZ * frac) > kMaxCoord THEN outOfBounds := TRUE;
  404.                         IF ABS(maxZ * frac) > kMaxCoord THEN outOfBounds := TRUE;
  405.                     END;
  406.                     
  407.                     IF outOfBounds THEN BEGIN
  408.                         SYSBEEP;
  409.                         ALRTDIALOG('Change the scale to a higher ratio to enter these points within the drawing bounds.');
  410.                     END;
  411.                     
  412.                     IF NOT OutOfBounds THEN
  413.                     BEGIN
  414.                     {** Keep reading lines until the end of file or until there's an error:}
  415.                         counter := 0;
  416.                         WHILE NOT EOF(dataFileName) DO
  417.                         BEGIN
  418.                             SetCursor(WATCHC);
  419.                             MyReadLn(dataFileName, str1, error);
  420.                             IF NOT(EOF(dataFileName)) THEN
  421.                             BEGIN
  422.                                 ParseStr(separator,str1);
  423.                                 IF xFirst THEN 
  424.                                 BEGIN
  425.                                     x := STR2NUM(column[gX])-xFactor;
  426.                                     y := STR2NUM(column[gY])-yFactor;
  427.                                 END
  428.                                 ELSE
  429.                                 BEGIN
  430.                                     x := STR2NUM(column[gY])-yFactor;
  431.                                     y := STR2NUM(column[gX])-xFactor;
  432.                                 END;
  433.                                 z := STR2NUM(column[gZ])-zFactor;
  434.                                 Locus3D(x, y, z);
  435.                                 counter := counter + 1;
  436.                                 IF centerData THEN
  437.                                 MESSAGE('Line ',counter,' of ',totalLines,' completed╔')
  438.                                 ELSE
  439.                                 MESSAGE('Line ',counter,' completed╔');
  440.                                 
  441.                             {** Load the fields with information if the user has asked to do so.}
  442.                                 IF attachDB THEN
  443.                                 BEGIN
  444.                                     SetRecord(LObject,kRecName);
  445.                                     IF has5Flds THEN SetRField(LObject,kRecName,kFld1,column[1]);
  446.                                     SetRField(LObject,kRecName,kFld2,column[gX]);
  447.                                     SetRField(LObject,kRecName,kFld3,column[gY]);
  448.                                     SetRField(LObject,kRecName,kFld4,column[gZ]);
  449.                                     IF has5Flds THEN SetRField(LObject,kRecName,kFld5,column[5]);
  450.                                 END;
  451.                             END;
  452.                         END;
  453.                         CLRMESSAGE;
  454.                     END;
  455.                     IF error <> '' THEN MESSAGE(error);
  456.                     CLOSE(dataFileName);
  457.                 END;
  458.             END;
  459.         END;
  460.     END;
  461. END;
  462. RUN(ImportSurveyFile);
  463.