expertcad/SRC/CadEngine/LoadDXF1.pas

unit LoadDXF;

Interface

uses SysUtils, Classes, Windows, Graphics, ComCtrls, Variants, PCTypesUtils,DrawObjects,Menus, DlgBase,  ExtDlgs,
  PCLayerDlg, OleCtnrs, Buttons, PCgui, GuiStrings, DrawEngine, PowerCad;

type

  TSections = (scHeader, scTables, scBlocks, scEntities, scUnknow);

  { Used to store readed groups from 0 group to 0 group. }
  TGroupTable = array[0..512] of Variant;

type
  TPoint2D = record
   X, Y, W: Real;
  end;

  TRect2D = record
   case Byte of
    0: (Left, Bottom, W1, Right, Top, W2: Real);
    1: (FirstEdge, SecondEdge: TPoint2D);
  end;


procedure ReadDXF(aPCad: TPowerCad);
procedure Rewind;
function ConsumeGroup: Boolean;
procedure NextSection;
{ Read the DXF header. }
procedure ReadHeader;

function ReadAnEntry(GroupDel: Word; var Values: TGroupTable): Word;

procedure ReadEntities;
procedure ReadEntity;
procedure LinePaint;

function ReOrderRect2D(const R: TRect2D): TRect2D;
function CartesianRect2D(const R: TRect2D): TRect2D;
function CartesianPoint2D(const P: TPoint2D): TPoint2D;

var
   FCad: TPowerCad;
   FCurrentSection: TSections;
   FStream: TextFile;
   FGroupCode: Word;
   FGroupValue: Variant;

   Entry: TGroupTable;

implementation

//--------------------------------------------------
//÷òåíèå ôàéëà ïî ñåêöèÿì
procedure ReadDXF(aPCad: TPowerCad);
begin
//  if fCADCmp2D = nil then Exit;
//  fUnableToReadAll := False;
  FCad := aPCad;
  Rewind;
  while (FCurrentSection <> scUnknow) do
   begin
     case FCurrentSection of
      scHeader: ReadHeader;
{      scTables: ReadTables;
      scBlocks: ReadBlocks; }
      scEntities: ReadEntities;
     end;
     NextSection;
   end;
end;
//--------------------------------------------------
//
procedure Rewind;
begin
  Reset(FStream);
  ConsumeGroup;
  NextSection;
end;

//--------------------------------------------------
function ConsumeGroup;
var
  TxtLine: String;
  LastSep: Char;
begin
  LastSep := DecimalSeparator;
  try
    ReadLn(FStream, FGroupCode);
    ReadLn(FStream, TxtLine);
    if EOF(FStream) then
     begin
       Result := False;
       Exit;
     end;
    case FGroupCode of
      0..9,
      999,
      1000..1009: FGroupValue := Trim(TxtLine);
      10..59,
      140..147,
      210..239,
      1010..1059: begin
        if Pos('.', TxtLine) > 0 then
         DecimalSeparator := '.'
        else
         DecimalSeparator := ',';
        try
         FGroupValue := StrToFloat_My(Trim(TxtLine));
        except
         FGroupValue := varEmpty;
        end;
      end;
      60..79,
      170..175,
      1060..1079 : begin
        if Pos('.', TxtLine) > 0 then
         DecimalSeparator := '.'
        else
         DecimalSeparator := ',';
        try
         FGroupValue := StrToInt(Trim(TxtLine));
        except
         FGroupValue := varEmpty;
        end;
      end;
    else
      FGroupValue := TxtLine;
    end;
    Result := True;
  finally
    DecimalSeparator := LastSep;
  end;
end;

//--------------------------------------------------
procedure NextSection;
begin
  FCurrentSection := scUnknow;
  while not ((FGroupCode = 0) and (FGroupValue = 'SECTION')) do
   if ConsumeGroup = False then Exit;
  ConsumeGroup;
  if FGroupValue = 'HEADER' then
   FCurrentSection := scHeader
  else if FGroupValue = 'TABLES' then
   FCurrentSection := scTables
  else if FGroupValue = 'BLOCKS' then
   FCurrentSection := scBlocks
  else if FGroupValue = 'ENTITIES' then
   FCurrentSection := scEntities;
  ConsumeGroup;
end;

//--------------------------------------------------
//÷òåíèå çàãîëîâêà áëîêà
procedure ReadHeader;

var
  Entry: TGroupTable;
  fHasExtension: boolean;
  fExtension: Trect2D;

begin
  fHasExtension := False;
  fExtension.Right := 1000;
  fExtension.Top := 1000;
  fExtension.W1 := 1.0;
  fExtension.Left := -1000;
  fExtension.Bottom := -1000;
  fExtension.W2 := 1.0;
//  fAngleDir := adCounterClockwise;     óãîë ïîâîðîòà - CS4Shapes.pas
  while ReadAnEntry(9, Entry) <> 0 do
   begin
     if Entry[9] = '$ANGDIR' then
      begin
{        if Entry[70] = 1 then
         fAngleDir := adClockwise
        else
         fAngleDir := adCounterClockwise;
}      end
     else if Entry[9] = '$EXTMAX' then
      begin
        fExtension.Right := Entry[10];
        fExtension.Top := Entry[20];
        fHasExtension := True;
      end
     else if Entry[9] = '$EXTMIN' then
      begin
        fExtension.Left := Entry[10];
        fExtension.Bottom := Entry[20];
        fHasExtension := True;
      end;
   end;
        if fHasExtension then

{!!!!!!!CADSys4.pas!!!!!!!!
  function ReorderRect2D(const R: TRect2D): TRect2D;
   This function transforms a point into a point in
     which the coordinates are integers. To do the
     transformation the function <I=Round> is used.

     The resulting point is specified in Windows screen coordinate
     system.

     Parameters:

     <LI=<I=P2D> is the point being transformed.>

 }
           FExtension := ReOrderRect2D(FExtension);

end;
//--------------------------------------------------
{ GroupDel = Group delimiter }
function ReadAnEntry(GroupDel: Word; var Values: TGroupTable): Word;
begin
  Result := 0;
  { Find the start of the entry. }
  while (FGroupCode <> GroupDel) and (FGroupCode <> 0) do
   if ConsumeGroup = False then Exit;
  if (FGroupCode = 0) and (FGroupCode <> GroupDel) then Exit;
  { Read all values. }
  repeat
   if FGroupCode < 256 then
    Values[FGroupCode] := FGroupValue
   else if FGroupCode > 999 then
    { The extended data types are remapped from 256=1000. }
    Values[FGroupCode - 744] := FGroupValue;
   ConsumeGroup;
  until (FGroupCode = GroupDel) or (FGroupCode = 0);
  Result := GroupDel;
end;
//--------------------------------------------------
function ReOrderRect2D(const R: TRect2D): TRect2D;
begin
  Result := CartesianRect2D(R);
  if R.Left > R.Right then
   begin
     Result.Left := R.Right;
     Result.Right := R.Left;
   end;
  if R.Bottom > R.Top then
   begin
     Result.Bottom := R.Top;
     Result.Top := R.Bottom;
   end;
end;
//--------------------------------------------------
function CartesianRect2D(const R: TRect2D): TRect2D;
begin
  Result.FirstEdge := CartesianPoint2D(R.FirstEdge);
  Result.SecondEdge := CartesianPoint2D(R.SecondEdge);
end;
//--------------------------------------------------
function CartesianPoint2D(const P: TPoint2D): TPoint2D;
begin
  if (P.W <> 1.0) and (P.W <> 0.0) then
   begin
     Result.X := P.X / P.W;
     Result.Y := P.Y / P.W;
     Result.W := 1.0;
   end
  else
   Result := P;
end;
//--------------------------------------------------
(*
procedure TDXF2DImport.ReadTables;
var
  Entry: TGroupTable;
begin
  if fCADCmp2D = nil then Exit;
  fDXFRead.ReadAnEntry(0, Entry);
  while fDXFRead.GroupValue <> 'ENDSEC' do
   begin
     if Entry[0] = 'LAYER' then
      begin
        if fSetLayers then
         with fCADCmp2D.Layers[fLayerList.Count] do
          begin
            Pen.Color := Colors[Abs(Round(Entry[62]))];
            Brush.Style := bsClear;
            Active := Entry[62] >= 0;
            Name := Entry[2];
          end;
        fLayerList.AddObject(Entry[2], fCADCmp2D.Layers[fLayerList.Count]);
      end;
     fDXFRead.ReadAnEntry(0, Entry);
   end;
end;

//--------------------------------------------------
procedure TDXF2DImport.ReadBlocks;
var
  Entry: TGroupTable;
  Tmp: TSourceBlock2D;
  NLayer: Integer;
begin
  if fCADCmp2D = nil then Exit;
  while DXFRead.GroupValue <> 'ENDSEC' do
   begin
     FDXFRead.ReadAnEntry(0, Entry);
     NLayer := FLayerList.IndexOf(Entry[8]);
     if NLayer > -1 then
      FCADCmp2D.CurrentLayer := NLayer;
     if Entry[0] = 'BLOCK' then
      begin
        Tmp := ReadSourceBlock(Entry);
        if Assigned(Tmp) then
         begin
           FCADCmp2D.AddSourceBlock(Tmp);
           { Entry[2] contains the name of the block for future ref. }
           fBlockList.AddObject(Entry[2], Tmp);
         end;
      end;
   end;
end;
//--------------------------------------------------
function TLayers.GetLayer(Index: Byte): TLayer;
begin
  Result := TLayer(Flayers.Items[Index]);
end;
//--------------------------------------------------
procedure TLayer.SetName(Nm: TLayerName);
begin
  if fName <> Nm then
   begin
     FName := Nm;
     FModified := True;
   end;
end; *)
//--------------------------------------------------
procedure ReadEntities;
//var
// Tmp: TObject2D;
begin
//  if fCADCmp2D = nil then Exit;
  while FGroupValue <> 'ENDSEC' do
   begin
//   ConsumeGroup;
   ReadEntity;
   {     Tmp := ReadEntity(False);
     if Assigned(Tmp) then
      begin
        Tmp.Transform(Scale2D(fScale, fScale));
        Tmp.ApplyTransform;
        FCADCmp2D.AddObject(-1, Tmp);
      end
     else
      fUnableToReadAll := True;}

   end;
end;
//--------------------------------------------------
{function TDXF2DImport.ReadEntity(IgnoreBlock: Boolean): TObject2D;
}
procedure ReadEntity;
//var
//  NLayer: Integer;
begin
  ReadAnEntry(0, Entry);
//  NLayer := FLayerList.IndexOf(Entry[8]);
//  if NLayer > -1 then
//   FCADCmp2D.CurrentLayer := NLayer;
  if Entry[0] = 'LINE' then
     LinePaint;
   //Result := ReadLine2D(Entry)
{  else if Entry[0] = 'ARC' then
   Result := ReadArc2D(Entry)
  else if Entry[0] = 'TRACE' then
   Result := ReadTrace2D(Entry)
  else if Entry[0] = 'SOLID' then
   Result := ReadSolid2D(Entry)
  else if Entry[0] = 'CIRCLE' then
   Result := ReadCircle2D(Entry)
  else if Entry[0] = 'ELLIPSE' then
   Result := ReadEllipse2D(Entry)
  else if Entry[0] = 'POLYLINE' then
   Result := ReadPolyline2D(Entry)
  else if Entry[0] = 'TEXT' then
   Result := ReadText2D(Entry)
  else if (not IgnoreBlock) and (Entry[0] = 'INSERT') then
   Result := ReadBlock(Entry);}
end;

//--------------------------------------------------
procedure LinePaint;
Var CurPos: TPoint;
 CurPos1: TPoint;
begin
{CurPos:= Point(Entry[10],Entry[20]);

Form2.Pipe.SetNewObj(CurPos);

CurPos:= Point(Entry[11],Entry[21]);
Form2.pipe.LinkNewObj(CurPos);

//îáðûâ ëèíèè
Form2.Pipe.BreakPolyline;
}
  CurPos:= Point(Entry[10],Entry[20]);
  CurPos1:= Point(Entry[11],Entry[21]);
  FCad.Line(FCad.GetLayerNbr('Ïîäëîæêà'), CurPos.X, CurPos.y, CurPos1.X, CurPos1.Y, 0, 0, 0, 0, False);
end;
//--------------------------------------------------
(*
//--------------------------------------------------
function Point2D(const X, Y: TRealType): TPoint2D;
begin
  Result.X := X;
  Result.Y := Y;
  Result.W := 1.0;
end;
*)
//--------------------------------------------------
//--------------------------------------------------
//--------------------------------------------------
//--------------------------------------------------
//--------------------------------------------------
end.