ezdxfread.pas

很管用的GIS控件

Unit EzDxfRead;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

Interface

// Added for GIS
{$I EZ_FLAG.PAS}

Uses
  Windows, SysUtils, Classes, EzDxfImport, EzDXFUtil, EzBaseGIS, Math;

Const
  EOL = #13#10;

const
  DXF_text_prompt = 3;

  ///////////////////////////////////////////////////////////////////////////////
  // DXF_Reader class definition
  ///////////////////////////////////////////////////////////////////////////////
Const
  MaxSizeOfBuf = 4096;
  //MaxSizeOfBuf = 10240;

Type
  tCharArray = Array[0..MaxSizeOfBuf - 1] Of char;

Type
  abstract_entity = Class;
  abstract_entity14 = Class;

  DXF_Reader = Class
  Private
    FGIS: TEzBaseGIS;
    DxfFile: TEzDxfFile; // belongs to
    BlocksToRead: Integer;
    // used when reading data from the file
    SizeOfBuf: integer;
    num_in_buf: integer;
    //IO_Stream  : TFileStream ;
    IO_chan: File;

    ii: integer;
    ec, fCode: integer;
    pBuf: ^tCharArray;
    Line_num: longint;
    fLine: shortstring;
    // useful bits to make parsing easier...
    file_pos: integer;
    marked_pos: integer;
    backflag: boolean;
    //datmode    : boolean;
    barposition: integer;
    //MyDlg      : TMifImportDlg;
    Procedure go_back_to_last( code: integer; Const str: shortstring );
    Procedure mark_position;
    Procedure goto_marked_position;
    //
    //procedure   go_back_to_start;
    Function NextGroupCode: integer;
    Function ValStr: shortstring;
    Function ValDbl: Double;
    Function ValInt: integer;
    Function code_and_string( Var group: integer; Var s: String ): boolean;
    Function code_and_double( Var group: integer; Var d: Double ): boolean;
    Function read_2Dpoint( Var p1: Point3D ): boolean;
    Function skip_upto_section( Const name: String ): boolean;
    // lowest level read function
    Function read_entity_data( ent: abstract_entity ): boolean;
    Function read_entity_data14( ent: abstract_entity14 ): boolean;
    Function read_generic( Var layer: integer ): abstract_entity;
    // we can read most entities with this one
    Function general_purpose_read( obj_type: TClass; Var entity: DXF_Entity; Var layer: integer ): boolean;
    // inserts/polylines need a little more complexity
    Function read_insert( Var entity: DXF_Entity; Var layer: integer ): boolean;
    Function read_polyline( Var entity: DXF_Entity; Var layer: integer ): boolean;
    Function read_lwpolyline( Var entity: DXF_Entity; Var layer: integer ): boolean;
    // this calls the others above
    Function read_entity( Const s, endstr: String; Var entity: DXF_Entity; Var layer: integer ): boolean;
  Public
    DXF_FILE: String;
    count_texts: integer;
    // Extents in (x,y) of the dataset
    min_extents: Point3D;
    max_extents: Point3D;
    // We will read the Entities in the layers into this list
    DXF_Layers: TList;
    colour_BYLAYER: boolean;
    Acad_version: integer;
    skipped: TStrings;
    ErrList: TStringlist;
    // Constructors and destructors
    Constructor Create( GIS: TEzBaseGIS;
      Const aName: shortstring; ADxfFile: TEzDxfFile );
    Destructor Destroy; Override;
    // Header section
    Function move_to_header_section: boolean;
    Function read_header: boolean;
    Function get_min_extent: Point3D;
    Function get_max_extent: Point3D;
    // R14侩
    // Class section
    Function move_to_Class_section: boolean;
    Function read_Class: boolean;
    // Blocks section
    Function move_to_blocks_section: boolean;
    Function read_blocks: boolean;
    Function read_block: boolean;
    Function Blocklayer: DXF_Layer;
    // Tables section
    Function move_to_tables_section: boolean;
    Function read_tables: boolean;
    Function read_layer_information: boolean;
    Function read_vport_information: boolean;
    Function layer_num( Const layername: String ): integer;
    // Entities section
    Function move_to_entity_section: boolean;
    Function read_entities: boolean;
    // These are the main routines to use
    Function read_file: boolean;
    Function remove_empty_layers: boolean;
    Function release_control_of_layers: TList;
    Procedure set_skipped_list( s: TStrings );
    Function findlayer( Const name: String; Var dxflayer: dxf_layer ): boolean;
  End;

  ///////////////////////////////////////////////////////////////////////////////
  // This is a simple class used only during file reads, it should not be used
  // as a base for any objects.
  // It is to allow all entities to be read using the same basic structure
  // even though they all use different group codes
  // Add extra group codes if you need to recognize them
  ///////////////////////////////////////////////////////////////////////////////
  abstract_entity = Class
  Public
    p1, p2, p3, p4: Point3D;
    rad_hgt: Double;
    angle1, angle2: Double;
    fv1, fv2, fv3: Double;
    thickness: Double;
    colour: integer;
    flag_70, flag_71, flag_72, flag_73, flag_74: integer;
    attflag: integer;
    namestr, tagstr, promptstr, text_style: String;
    LineStyle: String;
    layer: String;
    elev: Double;
    OCS_Z: Point3D;
    Procedure clear;
  End;

  //polyline_arc_begin

  abstract_entity14 = Class( abstract_entity )
    vertices: integer;
    polypoints: ppointlist;
    floatvals: ppointlist;
  End;

  //polyline_arc_end

  ///////////////////////////////////////////////////////////////////////////////
  // DXF file read exceptions will be this type
  ///////////////////////////////////////////////////////////////////////////////
Type
  DXF_read_exception = Class( Exception )
    line_number: integer;
    Constructor Create( Const err_msg: String; line: integer );
  End;

  // * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  // implementation
  // * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Implementation

// Added for GIS
Uses Forms, EzEntities, EzConsts, EzSystem;


// Basic DXF Group code
Const
  message_delay_ms = 1500;

  DXF_start = 0;
  DXF_text_def = 1;
  DXF_name = 2;
  DXF_othername2 = 4;
  DXF_entity_handle = 5;
  DXF_line_type = 6;
  DXF_text_style = 7;
  DXF_layer_name = 8;
  DXF_var_name = 9;
  DXF_primary_X = 10;
  DXF_primary_Y = 20;
  DXF_primary_Z = 30;
  DXF_other_X_1 = 11;
  DXF_other_Y_1 = 21;
  DXF_other_Z_1 = 31;
  DXF_other_X_2 = 12;
  DXF_other_Y_2 = 22;
  DXF_other_Z_2 = 32;
  DXF_other_X_3 = 13;
  DXF_other_Y_3 = 23;
  DXF_other_Z_3 = 33;
  DXF_elevation = 38;
  DXF_thickness = 39;
  DXF_floatval = 40;
  DXF_floatvals1 = 41;
  DXF_floatvals2 = 42;
  DXF_floatvals3 = 43;
  DXF_repeat = 49;
  DXF_angle1 = 50;
  DXF_angle2 = 51;
  DXF_angle3 = 52;
  DXF_angle4 = 53;
  DXF_angle5 = 54;
  DXF_angle6 = 55;
  DXF_angle7 = 56;
  DXF_angle8 = 57;
  DXF_angle9 = 58;
  DXF_visible = 60;
  DXF_colornum = 62;
  DXF_entities_flg = 66;
  DXF_ent_ident = 67;
  DXF_view_state = 69;
  DXF_70Flag = 70;
  DXF_71Flag = 71;
  DXF_72Flag = 72;
  DXF_73Flag = 73;
  DXF_74Flag = 74;
  DXF_extrusionx = 210;
  DXF_extrusiony = 220;
  DXF_extrusionz = 230;
  DXF_comment = 999;



///////////////////////////////////////////////////////////////////////////////
// abstract_entity implementation
// used when reading vertexes - just to make sure all flags are reset
// quicker than using Create/Destroy for each vertex.
///////////////////////////////////////////////////////////////////////////////

Procedure abstract_entity.clear;
Begin
  InitInstance( self );
End;

///////////////////////////////////////////////////////////////////////////////
// DXFReader implementation
///////////////////////////////////////////////////////////////////////////////

Constructor DXF_Reader.Create( GIS: TEzBaseGIS;
  Const aName: shortstring; ADxfFile: TEzDxfFile );
Begin
  Inherited Create;

  FGIS := GIS;
  DxfFile := ADxfFile;

  {IO_Stream := TFileStream.Create( aName, fmOpenRead or fmShareDenyWrite );
  IO_Stream.Position := 0; }

  AssignFile( IO_chan, aName );
  Try
    Reset( IO_chan, 1 );
  Except
    FileMode := 0;
    Reset( IO_chan, 1 );
  End;

  SizeOfBuf := MaxSizeOfBuf;
  GetMem( pBuf, SizeOfBuf );
  DXF_Layers := TList.Create;
  colour_BYLAYER := false;
  Line_num := 0;
  backflag := false;
  barposition := 0;
  {MyDlg:= TMifImportDlg.Create(Nil);
  MyDlg.DispMsg.Caption := Format(SDXFImportCaption, [MyDlg.GetShortDispname(aName)]);
  MyDlg.ProgressBar1.Position := 0;
  MyDlg.ProgressBar1.Max := IO_Stream.Size div MaxSizeOfBuf ;
  MyDlg.show ; }
  BlocksToRead := FileSize( IO_chan ) Div MaxSizeOfBuf;
  //IO_Stream.Size div MaxSizeOfBuf;
  //GmSystem.StartProgress(SDXFReading, 0, IO_Stream.Size div MaxSizeOfBuf);

  min_extents := origin3D;
  max_extents := origin3D;
  Acad_version := 12;
  dxf_file := extractfilename( aname );
  Errlist := TStringlist.Create;

  //added for GIS
  AcadColorPal := TAcadColorPal.Create;
  AcadLineStyle := TAcadLineStyle.Create;
End;

Destructor DXF_Reader.Destroy;
Var
  lp1: integer;
Begin
  If ( DXF_Layers <> Nil ) Then
    For lp1 := 0 To DXF_Layers.count - 1 Do
      DXF_Layer( DXF_Layers[lp1] ).Free;
  DXF_Layers.Free;
  CloseFile( IO_chan );
  //IO_Stream.free ;
  FreeMem( pBuf, SizeOfBuf );
  ErrList.free;

  //Added for GIS
  FreeAndNil( AcadColorPal );
  FreeAndNil( AcadLineStyle );

  //MyDlg.Release ;

  Inherited Destroy;
End;

{ --------------------------------------------------------------------------- }
{ Routines for fetching codes and values
{ --------------------------------------------------------------------------- }
(*procedure DXF_Reader.go_back_to_start;
begin
    Reset(IO_chan,1);
   //IO_Stream.Position := 0;
   num_in_buf := 0;
   ii         := 0;
end;*)

Procedure DXF_Reader.go_back_to_last( code: integer; Const str: shortstring );
Begin
  FCode := code;
  FLine := str;
  backflag := true;
End;

Procedure DXF_Reader.mark_position;
Begin
  marked_pos := File_pos + ii;
End;

Procedure DXF_Reader.goto_marked_position;
Begin
  //IO_Stream.Seek( Marked_pos, soFromCurrent) ;
  Seek( IO_chan, marked_pos );
  File_pos := marked_pos;
  num_in_buf := 0;
  ii := 0;
End;

Function DXF_Reader.NextGroupCode: integer;
  Function GotMore: boolean;
  Var
    Progress: integer;
    CanContinue: Boolean;
  Begin
    file_pos := FilePos( IO_chan );
    BlockRead( IO_chan, pBuf^, SizeOfBuf, num_in_buf );
    ec := IoResult;

    {file_pos := IO_Stream.Position ;
    ec := 0;
    try
      Remainsize :=IO_Stream.Size-file_pos ;
      if Remainsize<SizeofBuf then begin
        tempsize := Remainsize ;
        num_in_buf := Tempsize ;
      end else begin
        num_in_buf := sizeofbuf ;
        tempsize := sizeofbuf ;
      end ;
      IO_Stream.Read( pbuf^, Tempsize );
    except
      ec := -1 ;
    end ;}

    ii := 0;
    If ( ec = 0 ) And ( num_in_buf = 0 ) Then
      ec := -1;
    GotMore := ( ec = 0 );
    Inc( barposition );
    {ADxfFile: TEzDxfFile;}
    If Assigned( DxfFile.OnFileProgress ) Then
    Begin
      If BlocksToRead > 0 Then
        Progress := round( ( barposition / BlocksToRead ) * 100 )
      Else
        Progress := 100;
      DxfFile.OnFileProgress( DxfFile, DxfFile.FileName, Progress,
        barposition, 0, CanContinue );
      //If Not CanContinue Then        ;
    End;
    {MyDlg.Label3.Caption := inttostr(barposition)+' Blocks readen.';
    MyDlg.ProgressBar1.Position := barposition;
    MyDlg.Update ; }
    //GmSystem.UpdateProgress( barposition );
  End {GotMore};

  // Sometimes you get (download) a bad DXF file which has a couple of blank
  // lines in it. The commented retry code, can be used to skip blank lines, but you
  // should only use it as an emergency fix because you'll often find blank lines
  // in TEXT entities and other text strings.

  Function GotLine: boolean;
  Const
    CR = #13;
    LF = #10;
  Var
    c: char;
    //  label retry;
  Begin
    //  retry:
    c := #0;
    byte( fLine[0] ) := 0;
    While ( ii < num_in_buf ) Or GotMore Do
    Begin
      c := pBuf^[ii];
      inc( ii );
      If ( c <> CR ) And ( c <> LF ) And ( length( fLine ) < 255 ) Then
      Begin
        inc( fLine[0] );
        fLine[length( fLine )] := c
      End
      Else
      Begin // Extra code added to handle C/Unix style LF not CR/LF
        If ( c = CR ) Then
        Begin
          If ( ii < num_in_buf ) Or GotMore Then
          Begin
            If pBuf^[ii] = LF Then
            Begin
              inc( ii );
              break;
            End;
          End;
        End
        Else If ( c = LF ) Then
          break;
      End;
    End;
    GotLine := ( ec = 0 ) And ( ( c = CR ) Or ( c = LF ) );
    inc( Line_num );
    //    if fLine='' then goto retry;
  End;

Begin {NextGroupCode}
  If backflag Then
  Begin
    result := fCode;
    backflag := false;