home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / UPDATWKS.MPC < prev    next >
Encoding:
Text File  |  1996-06-28  |  2.7 KB  |  113 lines
  1. PROCEDURE UpDateWorksheet;
  2. {Last modified: 6/28/96}
  3. LABEL 1;
  4. CONST
  5.     kSpaceSymName = 'Space Name Box';
  6.     kRelationSymName = 'Relationship Box';
  7.     kWorksheetName='Area Worksheet';
  8.     kWorksheetTextSize = 10;
  9.     kWorksheetFont = 3;
  10.     kSpaceRec = 'Space';
  11.     kSpaceFld = 'Name';
  12.     kAdjacentRec = 'Adjacency';
  13.     kAdjacentFld = 'Code';
  14. VAR
  15.     WSH,lyr : HANDLE;
  16.     startRow,numRows,numCols,numNames,r1,r2,i,c : INTEGER;
  17.     str,worksheetName,spaceName : STRING;
  18.     doAlert1,doAlert2 : BOOLEAN;
  19.  
  20. PROCEDURE ProcessNames(han : HANDLE);
  21. LABEL 2;
  22. VAR
  23.     emptyRow: BOOLEAN;
  24.     str1,str2,str3: STRING;
  25.     a1:REAL;
  26.  
  27. BEGIN
  28. {** Reject if not a named object}
  29.     str1:= GetName(han);
  30.     IF (str1 = 'none') THEN GoTo 2;
  31.     a1:= HArea(han);
  32.  
  33. {** Reject if object is not on active layer}
  34.     IF GETLAYER(han) <> lyr THEN GOTO 2;
  35.     
  36. {** Reject if area is 0}
  37.     IF (a1 = 0) THEN GoTo 2;
  38.     str3:= Num2Str(2,a1);
  39.     
  40. {** Find valid named object in worksheet}
  41. {** If match found then load actual area}
  42.     FOR r1:= startRow TO numRows DO
  43.     BEGIN
  44.         str2:= GetCellStr(WSH,r1,1);
  45.         IF (str1 = str2) THEN
  46.         BEGIN
  47.             LoadCell(r1,3,str3);
  48.             GOTO 2;
  49.         END;
  50.     END;
  51.     
  52. {** If we got here then there is a space on drawing not listed in worksheet}
  53.  
  54. {** Find an empty row}
  55. {** If empty row found then load name and actual area}
  56. {** If no empty rows found then set alert flag for end of procedure}
  57.     FOR r2:= startRow TO numRows DO
  58.     BEGIN
  59.         emptyRow:= TRUE;
  60.         FOR c:= 1 TO numCols DO IF CellHasStr(WSH,r2,c) THEN emptyRow:= FALSE;
  61.  
  62.         IF emptyRow THEN
  63.         BEGIN
  64.             LoadCell(r2,3,str3);
  65.             LoadCell(r2,1,str1);
  66.             GoTo 2;
  67.         END;
  68.  
  69.         IF r2 = numRows THEN
  70.         BEGIN
  71.             doAlert1:= TRUE;
  72.             GoTo 2;
  73.         END;
  74.     END;    
  75. 2:END;
  76.  
  77. BEGIN
  78.     PUSHATTRS;
  79.     TextFont(kWorksheetFont);
  80.     TextSize(kWorksheetTextSize);
  81.     doAlert1:= FALSE;
  82. {** Try named worksheet CONST}
  83.     WSH:=GETOBJECT(kWorksheetName);
  84. {** Try active worksheet}
  85.     IF (WSH=NIL) THEN WSH:=ActSSheet;
  86. {** Try getting worksheet name from user}
  87.     IF (WSH=NIL) THEN BEGIN
  88.          worksheetName:=STRDIALOG('Enter the name of the worksheet to be sorted.','Worksheet 1');
  89.         WSH:=GETOBJECT(worksheetName);
  90.     END;
  91. {** If no worksheet then punch out with dialog╔}
  92.     IF ((WSH=NIL)|(GetType(WSH)<>18)) THEN BEGIN
  93.         SYSBEEP;
  94.         ALRTDIALOG('I can╒t find a worksheet by that name.');
  95.         GOTO 1;
  96.     END;
  97.     SelectSS(WSH);
  98.     SprdSize(WSH,numRows,numCols);
  99.     IF GETCELLSTR(WSH,1,1) = 'Name' THEN startRow:= 2
  100.     ELSE startRow:= 1;
  101.     IF GETCELLSTR(WSH,1,1) = '' THEN startRow:= 2;
  102.     lyr := ACTLAYER;
  103.     FOREACHOBJECT(ProcessNames,V);
  104.     
  105.     IF doAlert1 THEN
  106.     BEGIN
  107.         ALRTDIALOG('Some new spaces were skipped. Insert blank row(s) and run the ╘Update Worksheet╒ command again.');
  108.     END;
  109.     
  110.     {CLRMESSAGE;}
  111.     1:POPATTRS;
  112. END;
  113. RUN(UpDateWorksheet);