COMPILE SUBROUTINE DictToAcad(TableNames) /* Routine to export dictionary information to text file for use in Acad August 18, 2000 - John C. Henry - J.C. Henry, Inc. - Copyright 2000 */ DECLARE SUBROUTINE Utility DECLARE FUNCTION Utility $INSERT DICT_EQUATES equ CRLF$ to char(13):char(10) equ TAB$ TO CHAR(9) TableCnt = COUNT(TableNames,@VM) + (TableNames NE '') CurrPath = DRIVE() ;* Returns OI directory so backup one level CurrPath = FIELD(CurrPath,'\',1,COUNT(CurrPath,'\')):'\ACADTEXT' DirPath = UTILITY('CHOOSEDIR',@WINDOW,'Directory for Acad Text':@FM:CurrPath) FOR N = 1 TO TableCnt TableName = TableNames<1,N> FieldData = XLATE('DICT.':TableName,'%FIELDS%','','X') ;* Get the %FIELD% record from the dictionary MaxFields = COUNT(FieldData,@VM) + (FieldData NE '') PrintLines = '' TextLines = '' Symbolics = '' SymTextLines = '' SymSort = '' FieldSort = '' LineCnt = 0 FOR I = 1 TO MaxFields FieldName = FieldData IF FieldName[1,1] NE '%' THEN DictRec = XLATE('DICT.':TableName,FieldName,'','X') FMC = DictRec Part = DictRec Type = DictRec Master = DictRec S_M = DictRec DataType = DictRec Desc = DictRec Conv = DictRec Length = DictRec Justification = DictRec Formula = DictRec SWAP @VM WITH CRLF$ IN Formula Btree = DictRec XrefField = DictRec RelatedTo = DictRec RelatedFrom = DictRec Protected = DictRec CaseSensitive = DictRec IndexData = '' IF Btree = 1 THEN IndexData := 'Btree':CRLF$ IF XrefField = 1 THEN IndexData := 'Xref':CRLF$ IF CaseSensitive = 1 THEN IndexData := 'Case Sensitive':CRLF$ IF RelatedTo NE '' THEN IndexData := 'Related To: ':RelatedTo:CRLF$ IF RelatedFrom NE '' THEN IndexData := 'Related From: ':RelatedFrom:CRLF$ *IF Protected = 1 THEN IndexData := 'Protected' IF IndexData[-2,2] = CRLF$ THEN IndexData[-2,2] = '' TextLine = '' SymLine = '' SymTextLine = '' IF FieldName[-1,'B4'] NE '_ORG' THEN IF Type = 'S' THEN SymLine = '' SymLine<1,1> = FieldName SymLine<1,2> = DataType SymLine<1,3> = S_M SymLine<1,4> = Justification SymLine<1,5> = Length SymLine<1,6> = Conv SymLine<1,7> = Formula:CRLF$ SymLine<1,8> = IndexData SymTextLine = ' ':@VM:FieldName IF S_M[1,1] = 'M' THEN SymTextLine := '(s)' IF IndexData NE '' THEN SymTextLine := ' --> ':IndexData END ELSE PrintLine = '' PrintLine<1,1> = FMC PrintLine<1,2> = Part PrintLine<1,3> = FieldName PrintLine<1,4> = DataType PrintLine<1,5> = S_M PrintLine<1,6> = Justification PrintLine<1,7> = Length PrintLine<1,8> = Conv PrintLine<1,9> = Desc:CRLF$ PrintLine<1,10> = IndexData TextLine = '':@VM:FieldName IF S_M[1,1] = 'M' THEN TextLine := '(s)' IF IndexData NE '' THEN TextLine := ' --> ':IndexData END IF FMC NE '' THEN IF NOT(INDEX(PrintLine,'_ORG',1)) AND NOT(INDEX(PrintLine,'TW_',1)) THEN IF FMC = 0 AND Part NE '' THEN FMC := '.':Part LOCATE FMC IN FieldSort BY 'AR' USING @FM SETTING POS THEN FieldSort = INSERT(FieldSort,POS,0,0,FMC) END ELSE FieldSort = INSERT(FieldSort,POS,0,0,FMC) END TextLine<1,1> = FMT(FMC,'R#3') TextLines = INSERT(TextLines,POS,0,0,TextLine) PrintLines = INSERT(PrintLines,POS,0,0,PrintLine) END END ELSE *IF INDEX(SymTextLine,'-->',1) THEN LOCATE FieldName IN SymSort USING @FM SETTING POS ELSE SymSort = INSERT(SymSort,POS,0,0,FieldName) END Symbolics = INSERT(Symbolics,POS,0,0,SymLine) SymTextLines = INSERT(SymTextLines,POS,0,0,SymTextLine) *END END ;* End of sorting routine END ;* End of check for "_ORG" END ; * NEXT I TextLineCnt = COUNT(TextLines,@FM) + (TextLines NE '') /* IF TextLineCnt > 60 THEN TextLines = TableName:@FM:@FM:TextLines CONVERT @VM TO ' ' IN TextLines SWAP @FM WITH CRLF$ IN TextLines FileName = TableName:'.TXT' OSWRITE TextLines ON DirPath:'\':FileName Segment = 1 LOOP TextLines = TableName:@FM:'Symbolics-':Segment:@FM:@FM:FIELD(SymTextLines,@FM,1,TextLineCnt) SymTextLines[1,COL2()+1] = '' CONVERT @VM TO ' ' IN TextLines SWAP @FM WITH CRLF$ IN TextLines FileName = TableName:Segment:'.TXT' OSWRITE TextLines ON DirPath:'\':FileName UNTIL SymTextLines = '' Segment += 1 REPEAT END ELSE */ TextLines = TableName:@FM:@FM:TextLines:@FM:SymTextLines CONVERT @VM TO ',' IN TextLines ;* Excel export SWAP @FM WITH CRLF$ IN TextLines FileName = TableName:'.TXT' OSWRITE TextLines ON DirPath:'\':FileName *END NEXT N RETURN