home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / delite / dxfview / acaddxf.pas next >
Encoding:
Pascal/Delphi Source File  |  1992-04-01  |  24.3 KB  |  775 lines
  1. {$N+ }            { 8087 Math Coprocessor on }
  2. {$E+ }            { include 8087 emulation   }
  3. {$V- }            { relaxed VAR-string check }
  4.  
  5. UNIT AcadDXF;     { Der Autocad DXF-Interpreter    Version 1.2  30.6.1991  }
  6.  
  7. INTERFACE
  8.  
  9.  TYPE   DXFErr  = (ok, filenotfound, syntax, eof_reached);
  10.  
  11.  function  InterpretDXF(name : string):DXFErr;
  12.  Procedure InitDXF;
  13.  
  14. { Der DXF-Interpreter bedient sich der graphischen Primitive des Kernels.
  15.   Vor der ersten Benutzung muß einmal InitDXF aufgerufen werden, um alle
  16.   Systemvariablen zu initialisieren und die Tabellen zu löschen.
  17.   Die Funktion InterpretDXF zeichnet eine DXF-Grafik in den aktuell ge-
  18.   setzten Viewport. Als name ist der volle Suchpfad ohne die Dateiexten-
  19.   sion DXF.
  20.   Zurückgeliefert wird ein Fehlercode:
  21.  
  22.      ok            :    Die Grafik wurde erfolgreich erstellt.
  23.      filenotfound  :    Unter dem angegebenen Namen existiert keine Datei.
  24.      syntax        :    Die Zeichnung wurde abgebrochen, weil ein
  25.                         fataler syntaktischer Fehler erkannt wurde.
  26.      eof_reached   :    Die DXF-Datei enthält nicht die EOF-Markierung.
  27.  
  28. }
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES Kernel;
  33.  
  34. CONST  NLayer  = 32;    { Anzahl der von uns verwalteten Lagen  }
  35.        NLtypes = 16;    { Anzahl der Linientypen  }
  36.        MaxEle  =  8;    { Anzahl der Strichelemente pro Linie   }
  37.  
  38. TYPE   NameStr    = String[15];
  39.  
  40.        Layer      = record
  41.                       name  : NameStr;       { Name des Layers    }
  42.                       flags : integer;
  43.                       color : integer;       { Farbe ordinal      }
  44.                       ltype : NameStr;       { Linienstil         }
  45.                     end;
  46.  
  47.        Ltype      = record
  48.                       name  : NameStr;      { Name des Linientyps }
  49.                       desc  : NameStr;      { Beschreibung        }
  50.                       flags : integer;      { Flags               }
  51.                       just  : integer;      { Justierungscode     }
  52.                       nE    : integer;      { Anzahl Elemente     }
  53.                       Totlen: double;       { Gesamtlänge Linie   }
  54.                       Eles  : array[1..MaxEle] of double;{ Elemente }
  55.                     end;
  56.  
  57. VAR    f: text;
  58.  
  59.        Layers : array[1..NLayer]  of Layer;   { Die Layer-Liste }
  60.        Ltypes : array[1..NLtypes] of Ltype;   { Die Linientypen }
  61.  
  62.        PolyLayer : string;   { Daten für Polylinien :   }
  63.        PolyMode  : integer;  { -1 = aus,  0 = nicht init. , 1 = init }
  64.        PolyFirstX: double;
  65.        PolyFirstY: double;
  66.        PolyLastX : double;
  67.        PolyLastY : double;
  68.  
  69.        Aspect    : double;
  70.  
  71.        { Autocad-Systemvariablen  }
  72.  
  73.        LIMMIN_X  : double;         { Zeichnungsgrenzen links unten   }
  74.        LIMMIN_Y  : double;
  75.        LIMMAX_X  : double;         { Zeichnungsgrenzen rechts oben   }
  76.        LIMMAX_Y  : double;
  77.        EXTMIN_X  : double;         { tatsächliche Grenze links unten }
  78.        EXTMIN_Y  : double;
  79.        EXTMAX_X  : double;         { tatsächliche Grenze rechts oben }
  80.        EXTMAX_Y  : double;
  81.        VIEWCTR_X : double;         { Zentrum des Ausschnitts         }
  82.        VIEWCTR_Y : double;
  83.        TDCREATE  : double;         { Datum der Erstellung            }
  84.        TDUPDATE  : double;         { Datum der letzten Modifikation  }
  85.        PDMODE    : integer;
  86.        PDSIZE    : double;
  87.  
  88.  
  89. CONST  NVars = 9;                  { Schlüsselworte aus Headerblock  }
  90.        SysWords : array[1..NVars] of NameStr =
  91.          ('$LIMMIN'   , '$LIMMAX'   , '$EXTMIN'  ,  '$EXTMAX',
  92.           '$VIEWCTR'  , '$TDCREATE' , '$TDUPDATE',  '$PDMODE',
  93.           '$PDSIZE');
  94.  
  95.        NEnt  = 10;                 { Schlüsselworte aus Entityblock  }
  96.        EntityWords : array[1..NEnt] of NameStr =
  97.          ('ENDSEC', 'LINE'   , 'ARC'     ,  'POINT',
  98.           'CIRCLE', 'TEXT'   , 'POLYLINE',  'VERTEX',
  99.           'SEQEND', 'SOLID');
  100.  
  101.        NTab  = 4;                  { Schlüsselworte aus Tabellenblock}
  102.        TabWords    : array[1..NTab] of NameStr =
  103.          ('LTYPE' ,  'LAYER'  ,  'STYLE',  'VIEW');
  104.  
  105.  
  106. procedure InitSysVars;            { Initialisierung aller Systemvariablen }
  107. Var i,j : integer;
  108. begin
  109.   Aspect    := 3*PortMaxX / (4*PortMaxY);   { Höhen/Breitenverhältnis }
  110.   PolyLayer := '';                          { PolyLinemodus aus }
  111.   PolyMode  := -1;
  112.   PolyFirstX:=  0;
  113.   PolyLastX :=  0;
  114.   PolyLastX :=  0;
  115.   PolyLastY :=  0;
  116.   LIMMIN_X  :=  0;
  117.   LIMMIN_Y  :=  0;
  118.   LIMMAX_X  := 15;
  119.   LIMMAX_Y  :=  11.25;
  120.   EXTMIN_X  :=  0;
  121.   EXTMIN_Y  :=  0;
  122.   EXTMAX_X  := 12;
  123.   EXTMAX_Y  :=  9;
  124.   VIEWCTR_X :=  5;
  125.   VIEWCTR_Y :=  5;
  126.   TDCREATE  :=  0;
  127.   TDUPDATE  :=  0;
  128.   PDMODE    :=  0;
  129.   PDSIZE    :=  0.1;
  130.  
  131.   for i := 1 to NLtypes do
  132.     With Ltypes[i] do
  133.       begin
  134.         name   := '';
  135.         desc   := '';
  136.         just   :=  0;
  137.         totlen :=  0;
  138.         nE     :=  0;
  139.         for j := 1 to MaxEle do
  140.           Eles[j] := 0;          { Strichelemente löschen }
  141.       end;
  142. end;
  143.  
  144.  
  145. procedure AddLType(lt: LType);   { Linientyp hinzufügen   }
  146. Var  i : integer;
  147. begin
  148.   i := 1;
  149.   while (ltypes[i].name <> '') and (i < NLtypes) do
  150.     i := succ(i);
  151.   if Ltypes[i].name = '' then
  152.     begin
  153.       ltypes[i] := lt;
  154.     end;
  155. end;
  156.  
  157.  
  158. procedure AddLayer(Lname: NameStr; Lflags,Lcolor : integer; Lltype : NameStr);
  159. Var  i : integer;
  160. begin
  161.   i := 1;
  162.   while (Layers[i].name <> '') and (i < NLayer) do
  163.     i := succ(i);                          { suche einen freien Eintrag }
  164.   if Layers[i].name = '' then
  165.     With Layers[i] do
  166.       begin
  167.         name  := LName;
  168.         flags := Lflags;
  169.         color := Lcolor;
  170.         ltype := LLtype;
  171.       end;
  172. end;
  173.  
  174.  
  175. procedure RemoveLayer(Lname: NameStr);
  176. Var i : integer;
  177. begin
  178.   i := 1;
  179.   while (Layers[i].name <> Lname) and (i < NLayer) do
  180.     i := succ(i);
  181.   if Layers[i].name = LName then
  182.     With Layers[i] do
  183.       begin
  184.         name  := '';
  185.         flags :=  0;
  186.         color :=  0;
  187.         ltype := '';
  188.       end;
  189. end;
  190.  
  191.  
  192. function GetLayerColor(Var LName : NameStr):integer;
  193. Var i : integer;
  194. begin
  195.   i := 1;
  196.   while (Layers[i].name <> Lname) and (i < NLayer) do
  197.     i := succ(i);
  198.   if Layers[i].name = LName then
  199.     GetLayerColor := Layers[i].color
  200.   else
  201.     GetLayerColor := 1;
  202. end;
  203.  
  204.  
  205. Procedure InitDXF;
  206. Var AktLine       : String;
  207.     Name,LineType : String;
  208.     Color         : LongInt;
  209.     i             : integer;
  210. Begin
  211.   for i := 1 to NLayer do
  212.     With Layers[i] do              { Alle Layer löschen }
  213.       begin
  214.         name  := '';
  215.         flags :=  0;
  216.         color :=  0;
  217.         ltype := '';
  218.       end;
  219.   If GetInitFileListFirst('AutoCad','Layer',AktLine) Then
  220.     Repeat
  221.       If GetParaName(AktLine,Name) and GetParaInteger(AktLine,Color) Then
  222.         Begin
  223.           if Not GetParaName(AktLine,LineType) Then
  224.             LineType := 'CONTINUOUS';
  225.           AddLayer(Name,0,Color,LineType);
  226.         End;
  227.     Until Not GetInitFileListNext('Layer',AktLine)
  228.   Else AddLayer('0',0,15,'CONTINUOUS');
  229. End;
  230.  
  231.  
  232. { Scale und XScale nehmen die Transformation der Autocad-Koordinaten in das
  233.   einfache Kernel-Koordinatensystem vor. Die Verzerrung durch das Seiten/
  234.   Höhenverhältnis des Bildschirms wird nicht berücksichtigt.   }
  235.  
  236. procedure Scale(Var x1,y1 : double);
  237. begin
  238.   x1 := (PortMaxX * (x1-LIMMIN_X)) / (LIMMAX_X-LIMMIN_X);
  239.   y1 := PortMaxY - ((PortMaxY * (y1-LIMMIN_Y)) / (LIMMAX_Y-LIMMIN_Y));
  240. end;
  241.  
  242.  
  243. procedure XScale(Var r: double);
  244. begin
  245.   r := (PortMaxX * r) / (LIMMAX_X-LIMMIN_X);
  246. end;
  247.  
  248. procedure YScale(Var r: double);
  249. begin
  250.   r := (PortMaxY * r) / (LIMMAX_Y-LIMMIN_Y);
  251. end;
  252.  
  253.  
  254. { Die Elementar-Prozeduren von Autocad arbeiten im Autocad-Koordinatensystem
  255.   und bedienen sich der Skalierungsprozeduren }
  256.  
  257. procedure DXFLine(x1,y1,x2,y2: double; layer: NameStr);            { Linie }
  258. begin
  259.   Scale(x1,y1);
  260.   Scale(x2,y2);
  261.   Line(Integer(Round(x1)),Integer(Round(y1)),
  262.        Integer(Round(x2)),Integer(Round(y2)),GetLayerColor(layer));
  263. end;
  264.  
  265.  
  266. procedure DXFArc(x,y,aa,ae,r : double; layer: NameStr);      { Kreissegment }
  267. begin
  268.   Scale(x,y);
  269.   YScale(r);
  270.   Arc(Integer(Round(x)),Integer(Round(y)),
  271.       Integer(Round(aa)),Integer(Round(ae)),
  272.       Integer(Round(r)),GetLayerColor(layer));
  273. end;
  274.  
  275.  
  276. procedure DXFPoint(x,y : double; layer: NameStr);                  { Punkt }
  277. Var len : double;
  278. begin
  279.   len := PDSIZE / 2;
  280.   Case PDMODE of
  281.     0,1  :  begin
  282.               Scale(x,y);
  283.               SetPoint(Integer(Round(x)),Integer(Round(y)),GetLayerColor(layer));
  284.             end;
  285.     2    :  begin
  286.               DXFLine(x-len,y    ,x+len,y,layer);
  287.               DXFLine(x    ,y-len,x    ,y+len,layer);
  288.             end;
  289.     3    :  begin
  290.               DXFLine(x-len,y-len,x+len,y+len,layer);
  291.               DXFLine(x+len,y-len,x-len,y+len,layer);
  292.             end;
  293.     end;
  294. end;
  295.  
  296.  
  297. procedure DXFCircle(x,y,r : double; layer: NameStr);           { Vollkreis }
  298. begin
  299.   Scale(x,y);
  300.   XScale(r);
  301.   Circle(Integer(Round(x)),Integer(Round(y)),
  302.          Integer(Round(r)),GetLayerColor(layer));
  303. end;
  304.  
  305.  
  306. procedure DXFText(x,y,h : double; str: string; layer: NameStr);     { Text }
  307. Var X0, Y0, FakX, FakY : Integer;
  308. begin
  309.   y := y + h/4;
  310.   Scale(x,y);
  311.   YScale(h);
  312.   X0   := Integer(Round(x));
  313.   Y0   := Integer(Round(y));
  314.   FakX := Integer(Round(h));
  315.   FakY := Integer(Round(h));
  316.   DrawText(X0,Y0,FakX,FakY,Str,GetLayerColor(layer));
  317. End;
  318.  
  319.  
  320. { GetNextGroup liest aus der DXF-Datei die nächste Gruppe und liefert als
  321.   direktes Ergebnis den Gruppencode zurück. Je nach Art der Gruppe (Text,
  322.   integer oder real ) wird einer der VAR-Parameter belegt. Bei Fehlern
  323.   wird 99 zurückgeliefert.   }
  324.  
  325. Function GetNextGroup(Var str: string; Var re: double; Var int: integer):integer;
  326. Var line: string;
  327.     code: integer;
  328.     err : integer;
  329.     i   : integer;
  330. begin
  331.   if eof(f) then GetNextGroup := 99  { Fehlercode }
  332.   else
  333.     begin
  334.       readln(f,line);                { Gruppencode lesen }
  335.       val(line, code, err);
  336.       GetNextGroup := code;
  337.       if err = 0 then
  338.         begin
  339.           readln(f,line);
  340.           Case code of
  341.             0.. 9  : str := line;
  342.            10..59  : val(line,  re, err);
  343.            60..79  : val(line, int, err);
  344.             end;
  345.           if err <> 0 then GetNextGroup := 99;
  346.         end
  347.       else GetNextGroup := 99;
  348.     end;
  349. end;
  350.  
  351. { Die Autocad DXF-Datei besteht aus vier Teilen, die grösstenteils fakultativ
  352.   sind. Für jeden Teil der Datei existiert eine eigene Prozedur zur Bear-
  353.   beitung.  }
  354.  
  355. procedure ProcHeader;        { Verarbeitet den Abschnitt "Header" }
  356. Var code : integer;
  357.     str  : string;
  358.     re   : double;
  359.     re1  : double;
  360.     re2  : double;
  361.     int  : integer;
  362.     code2: integer;
  363.     index: integer;
  364. begin
  365.   repeat
  366.     Code := GetNextGroup(str, re, int);
  367.     if code = 9 then                           { Autocad-Systemvariable   }
  368.       begin
  369.         index := 1;
  370.         while (SysWords[index] <> str) and (index < NVars) do
  371.           index := succ(index);
  372.         if SysWords[index] = str then
  373.           Case index of
  374.  
  375.             1 : begin
  376.                   code  := GetNextGroup(str, re1, int);
  377.                   code2 := GetNextGroup(str, re2, int);
  378.                   if (code = 10) and (code2 = 20) then
  379.                     begin
  380.                       LIMMIN_X := re1;
  381.                       LIMMIN_Y := re2;
  382.                     end;
  383.                 end;
  384.  
  385.             2 : begin
  386.                   code  := GetNextGroup(str, re1, int);
  387.                   code2 := GetNextGroup(str, re2, int);
  388.                   if (code = 10) and (code2 = 20) then
  389.                     begin
  390.                       LIMMAX_X := re1 ;
  391.                       LIMMAX_Y := re2 ;
  392.                     end;
  393.                 end;
  394.  
  395.             3 : begin
  396.                   code  := GetNextGroup(str, re1, int);
  397.                   code2 := GetNextGroup(str, re2, int);
  398.                   if (code = 10) and (code2 = 20) then
  399.                     begin
  400.                       EXTMIN_X := re1;
  401.                       EXTMIN_Y := re2;
  402.                     end;
  403.                 end;
  404.  
  405.             4 : begin
  406.                   code  := GetNextGroup(str, re1, int);
  407.                   code2 := GetNextGroup(str, re2, int);
  408.                   if (code = 10) and (code2 = 20) then
  409.                     begin
  410.                       EXTMAX_X := re1;
  411.                       EXTMAX_Y := re2;
  412.                     end;
  413.                 end;
  414.  
  415.             5 : begin
  416.                   code  := GetNextGroup(str, re1, int);
  417.                   code2 := GetNextGroup(str, re2, int);
  418.                   if (code = 10) and (code2 = 20) then
  419.                     begin
  420.                       VIEWCTR_X := re1;
  421.                       VIEWCTR_Y := re2;
  422.                     end;
  423.                  end;
  424.  
  425.              6 : begin
  426.                    code  := GetNextGroup(str, re1, int);
  427.                    if (code = 10) then TDCREATE := re1;
  428.                  end;
  429.  
  430.              7 : begin
  431.                    code  := GetNextGroup(str, re1, int);
  432.                    if (code = 10) then TDUPDATE := re1;
  433.                  end;
  434.  
  435.              8 : begin
  436.                    code := GetNextGroup(str, re1, int);
  437.                    if code = 70 then PDMODE := int;
  438.                  end;
  439.  
  440.              9 : begin
  441.                    code := GetNextGroup(str, re1, int);
  442.                    if code = 40 then PDSIZE := re1;
  443.                  end;
  444.  
  445.              end; { Case }
  446.       end;
  447.   until (code = 0) or (code = 99);             { Ende bei Code 0 oder Err }
  448. end;
  449.  
  450.  
  451. procedure ProcTables;        { Verarbeitet den Abschnitt "Tables" }
  452. Var   Code  : integer;
  453.       str   : string;
  454.       re    : double;
  455.       int   : integer;
  456.       index : integer;
  457.  
  458.   procedure ProcLtype;       { Subblock A "LTYPE" }
  459.   Var code : integer;
  460.       str  : string;
  461.       re   : double;
  462.       int  : integer;
  463.       i    : integer;
  464.       lt   : LType;
  465.   begin
  466.     code := GetNextGroup(str,re,int);       { Anzahl Einträge überlesen }
  467.  
  468.     repeat
  469.       code := GetNextGroup(str,re,int);
  470.       if (code = 0) and (str = 'LTYPE') then
  471.         begin
  472.           code := GetNextGroup(lt.name,re,int);
  473.           code := GetNextGroup(str,re,lt.flags);
  474.           code := GetNextGroup(lt.desc,re,int);
  475.           code := GetNextGroup(str,re,lt.just);
  476.           code := GetNextGroup(str,re,lt.nE);
  477.           code := GetNextGroup(str,lt.totlen,int);
  478.           if lt.nE > MaxEle then lt.nE := MaxEle;
  479.           for i := 1 to lt.nE do
  480.             code := GetNextGroup(str,lt.Eles[i],int);
  481.  
  482.           if code = 40 then
  483.             AddLtype(lt);
  484.         end;
  485.     until (code = 0) and ((str = 'ENDTAB') or (str = 'EOF'));
  486.   end;
  487.  
  488.   procedure ProcLayer;       { Subblock B "LAYER" }
  489.   Var code : integer;
  490.       str  : string;
  491.       re   : double;
  492.       int  : integer;
  493.       name : NameStr;
  494.       ltyp : NameStr;
  495.       color: integer;
  496.       flags: integer;
  497.   begin
  498.     code := GetNextGroup(str,re,int);       { Anzahl Einträge überlesen }
  499.  
  500.     repeat
  501.       code := GetNextGroup(str,re,int);
  502.       if (code = 0) and (str = 'LAYER') then
  503.         begin
  504.           code := GetNextGroup(name,re,int);
  505.           code := GetNextGroup(str,re,flags);
  506.           code := GetNextGroup(str,re,color);
  507.           code := GetNextGroup(ltyp,re,int);
  508.           if code = 6 then
  509.             AddLayer(name,flags,color,ltyp);
  510.         end;
  511.     until (code = 0) and ((str = 'ENDTAB') or (str = 'EOF'));
  512.   end;
  513.  
  514.   procedure ProcStyle;       { Subblock C "STYLE" }
  515.   begin
  516.     { für zukünftige Erweiterungen }
  517.   end;
  518.  
  519.   procedure ProcView;        { Subblock D "View"  }
  520.   begin
  521.     { für zukünftige Erweiterungen }
  522.   end;
  523.  
  524.  
  525.  
  526. begin
  527.   repeat
  528.     repeat                                  { Suche die nächste Tabelle   }
  529.       Code := GetNextGroup(str, re, int);
  530.     until (code = 99) or ((code = 0) and ((str='TABLE') or (str = 'ENDSEC')));
  531.     if (code = 0) and (str = 'TABLE') then
  532.       begin                                 { eine von 4 Tabellen gefunden }
  533.         Code := GetNextGroup(str,re,int);
  534.         if Code = 2 then
  535.           begin
  536.             index := 1;
  537.             while (TabWords[index] <> str) and (index < NTab) do
  538.               index := succ(index);
  539.             if TabWords[index] = str then
  540.               Case index of
  541.                  1  : ProcLtype;   { Tabelle "LTYPE" für Linientypen  }
  542.                  2  : ProcLayer;   { Tabelle "LAYER" für Layertypen   }
  543.                  3  : ProcStyle;   { Tabelle "STYLE" für Schriftstile }
  544.                  4  : ProcView;    { Tabelle "View"  für Ausschnitte  }
  545.               end; { Case }
  546.           end;
  547.       end;
  548.   until (Code = 99) or ((code = 0) and (str = 'ENDSEC'));
  549. end;
  550.  
  551. procedure ProcBlocks;        { Verarbeitet den Abschnitt "Blocks" }
  552. begin
  553.   { für zukünftige Erweiterungen }
  554. end;
  555.  
  556. procedure ProcEntities;      { Verarbeitet den Abschnitt "Entities" }
  557. Var code : integer;
  558.     str  : string;
  559.     re   : double;
  560.     re1  : double;
  561.     re2  : double;
  562.     re3  : double;
  563.     re4  : double;
  564.     re5  : double;
  565.     int  : integer;
  566.     code2: integer;
  567.     index: integer;
  568.     ready: boolean;
  569.     lay  : NameStr;
  570.     i    : integer;
  571.     FirstX : double;
  572.     FirstY : double;
  573. begin
  574.   ready := false;
  575.   repeat
  576.     Code := GetNextGroup(str, re, int);
  577.     if code = 0 then
  578.       begin
  579.         index := 1;
  580.         for i := 1 to length(str) do str[i] := Upcase(str[i]);
  581.         while (EntityWords[index] <> str) and (index < NEnt) do
  582.           index := succ(index);
  583.         if EntityWords[index] = str then
  584.           Case index of
  585.             1 : ready := true;              { ENDSEC erreicht }
  586.  
  587.             2 : begin                       { Line   }
  588.                   code  := GetNextGroup(lay, re5, int);
  589.                   code  := GetNextGroup(str, re1, int);
  590.                   if code = 62 then
  591.                       { Farbe nicht von Layer }
  592.                     code := GetNextGroup(str, re1, int);
  593.  
  594.                   code  := GetNextGroup(str, re2, int);
  595.                   code  := GetNextGroup(str, re3, int);
  596.                   code2 := GetNextGroup(str, re4, int);
  597.                   if (code = 11) and (code2 = 21) then
  598.                       DXFLine(re1,re2,re3,re4,lay)
  599.                    else
  600.                      write(#7);
  601.                 end;
  602.  
  603.             3 : begin                       { Arc   }
  604.                   code  := GetNextGroup(lay, re5, int);
  605.                   code  := GetNextGroup(str, re1, int);
  606.                   code  := GetNextGroup(str, re2, int);
  607.                   code  := GetNextGroup(str, re3, int);
  608.                   code  := GetNextGroup(str, re4, int);
  609.                   code2 := GetNextGroup(str, re5, int);
  610.                   if (code = 50) and (code2 = 51) then
  611.                       DXFArc(re1,re2,re4,re5,re3,lay);
  612.                 end;
  613.  
  614.             4 : begin                       { Point }
  615.                   code := GetNextGroup(lay,re1,int);
  616.                   code := GetNextGroup(str,re1,int);
  617.                   if code = 62 then
  618.                     code := GetNextGroup(str, re1, int);
  619.                   code2:= GetNextGroup(str,re2,int);
  620.                   if (code = 10) and (code2 = 20) then
  621.                      DXFpoint(re1,re2,lay);
  622.                 end;
  623.  
  624.             5 : begin                       { Circle }
  625.                   code := GetNextGroup(lay,re1,int);
  626.                   code := GetNextGroup(str,re1,int);
  627.                   code := GetNextGroup(str,re2,int);
  628.                   code2:= GetNextGroup(str,re3,int);
  629.                   if (code = 20) and (code2 = 40) then
  630.                      DXFCircle(re1,re2,re3,lay);
  631.                 end;
  632.  
  633.             6 : begin                        { Text }
  634.                   code := GetNextGroup(lay,re1,int);
  635.                   code := GetNextGroup(str,re1,int);
  636.                   code := GetNextGroup(str,re2,int);
  637.                   code := GetNextGroup(str,re3,int);
  638.                   code2:= GetNextGroup(str,re4,int);
  639.                   if (code = 40) and (code2 = 1) then
  640.                      DXFText(re1,re2,re3,str,lay);
  641.                 end;
  642.  
  643.             7 : begin                        { Polyline }
  644.                   code := GetNextGroup(lay,re1,int);
  645.     {             code2:= GetNextGroup(str,re1,int);  }
  646.     {             if code = 8 then                    }
  647.                     begin
  648.                       PolyLayer := lay;
  649.                       PolyMode  :=   0;
  650.                     end;
  651.                 end;
  652.  
  653.             8 : begin                        { Vertex  }
  654.                   code := GetNextGroup(lay,re1,int);
  655.                   code := GetNextGroup(str,re1,int);
  656.                   if code = 62 then
  657.                     code := GetNextGroup(str, re1, int);
  658.                   code2:= GetNextGroup(str,re2,int);
  659.                   if (code = 10) and (code2=20) then
  660.                     Case PolyMode of
  661.                       0 :  begin  { erster Punkt }
  662.                              PolyLastX := re1;
  663.                              PolyLastY := re2;
  664.                              PolyFirstX:= re1;
  665.                              PolyFirstY:= re2;
  666.                              PolyMode := 1;
  667.                            end;
  668.  
  669.                       1 : begin  { weiterer Punkt }
  670.                              DXFLine(PolyLastX,PolyLasty,re1,re2,PolyLayer);
  671.                              PolyLastX := re1;
  672.                              PolyLastY := re2;
  673.                            end;
  674.                      end;
  675.                 end;
  676.  
  677.             9 : begin
  678.                   { code := GetNextGroup(lay,re1,int); }
  679.                   PolyLayer := '';
  680.                   PolyMode  := -1; { abschalten }
  681. {                  DXFLine(PolyFirstX,PolyFirstY,PolyLastX,PolyLastY,PolyLayer);}
  682.                 end;
  683.  
  684.            10 : begin                      { Solid }
  685.                   code := GetNextGroup(lay,re1,int);  { layer }
  686.                   code2:= GetNextGroup(str,re1,int);
  687.                   code2:= GetNextGroup(str,re2,int);  { P1 }
  688.                   FirstX    := re1;
  689.                   FirstY    := re2;
  690.                   PolyLastX := re1;
  691.                   PolyLastY := re2;
  692.                   code := GetNextGroup(str,re1,int);  { P2 }
  693.                   code := GetNextGroup(str,re2,int);
  694.                   DXFLine(PolyLastX,PolyLasty,re1,re2,lay);
  695.                   PolyLastX := re1;
  696.                   PolyLastY := re2;
  697.                   code := GetNextGroup(str,re1,int);  { P3 }
  698.                   code := GetNextGroup(str,re2,int);
  699.                   DXFLine(PolyLastX,PolyLasty,re1,re2,lay);
  700.                   PolyLastX := re1;
  701.                   PolyLastY := re2;
  702.                   code := GetNextGroup(str,re1,int);
  703.                   code := GetNextGroup(str,re2,int);  { P4 }
  704.                   if (re1 = PolyLastX) and (re2 = PolyLastY)
  705.                     then
  706.                      begin
  707.                       re1 := FirstX;
  708.                       re2 := FirstY;
  709.                      end;
  710.                   DXFLine(PolyLastX,PolyLasty,re1,re2,lay);
  711.                 end;
  712.              else write(#7);
  713.             end; { Case }
  714.       end;
  715.   until (code = 99) OR ready;             { Ende bei Code 0 oder Err }
  716. end;
  717.  
  718.  
  719. function InterpretDXF(name : string):DXFErr;
  720. Var ready : boolean;
  721.     re    : double;
  722.     int   : integer;
  723.     str   : string;
  724.     code  : integer;
  725.  
  726. begin
  727.   HideMouse;
  728.   ready := false;
  729.   InitSysVars;
  730.   assign(f,name);
  731.   {$i- }
  732.   reset(f);
  733.   {$i+ }
  734.   if ioresult <> 0 then InterpretDXF := filenotfound
  735.   else
  736.    begin
  737.      InterpretDXF := ok;
  738.      repeat
  739.       repeat
  740.         Code := GetNextGroup(str, re, int);
  741.       until (code = 0) or (code = 99);             { aufsynchronisieren }
  742.       if code = 99 then InterpretDXF := syntax
  743.       else
  744.         begin
  745.          if str = 'EOF' then ready := true;
  746.          if str = 'SECTION' then
  747.            begin
  748.              Code := GetNextGroup(str,re,int);
  749.              if Code = 2 then
  750.                begin
  751.                  if str = 'HEADER'  then ProcHeader;
  752.                  if str = 'TABLES'  then ProcTables;
  753.                  if str = 'BLOCKS'  then ProcBlocks;
  754.                  If str = 'ENTITIES'then ProcEntities;
  755.                end;
  756.            end;
  757.         end;
  758.      until (Code = 99) or ready;
  759.      if not ready then InterpretDXF := syntax;
  760.      close(f);
  761.    end;
  762.   ShowMouse;
  763. end;
  764.  
  765.  
  766. end.
  767.  
  768.  
  769. { Revisionen :
  770.  
  771. 1.0     7.12.1990
  772. 1.1    15.12.1990    Polylinien sind jetzt robuster (Corel Draw Import)
  773. 1.2    30. 6.1991    Endung .dxf wird nicht mehr angehangen
  774.  
  775. }