ezdxfread.pas

很管用的GIS控件

  End
  Else
  Begin
    Repeat
      If Not GotLine Then
      Begin
        fCode := -2;
        Result := fCode;
        exit;
      End;
    Until fLine <> '';
    Val( fLine, fCode, ec );
    If ec <> 0 Then
      fCode := -2
    Else If Not GotLine Then
      fCode := -2;
    Result := fCode;
  End;
End {NextGroupCode};

Function DXF_Reader.ValStr: shortstring;
Begin
  Result := fLine
End;

Function DXF_Reader.ValDbl: Double;
Begin
  Val( TrimRight(fLine), Result, ec );

  If ec <> 0 Then
    errlist.Add( SDXFInvalidFloat + inttostr( line_num ) );
  //    raise DXF_read_exception.Create('Invalid Floating point conversion',line_num);
End;

Function DXF_Reader.ValInt: integer;
Begin
  Val( fLine, Result, ec );

  If ec <> 0 Then
    Errlist.add( SDXFInvalidInteger + inttostr( line_num ) );
  //    raise DXF_read_exception.Create('Invalid Integer conversion',line_num);
End;

Function DXF_Reader.code_and_string( Var group: integer; Var s: String ): boolean;
Begin
  result := true;
  group := NextGroupCode;
  If group >= 0 Then
    s := ValStr
  Else If Not ( ( group = 0 ) And ( valstr = '' ) ) Then
    Result := False;
  // useful in debugging
  //  if (group=0) then begin astr := IntToStr(group)+' '+s; alb.Items.Add(astr); end;
End;

Function DXF_Reader.code_and_double( Var group: integer; Var d: Double ): boolean;
Begin
  Result := true;
  Group := NextGroupCode;
  If Group >= 0 Then
    d := Valdbl
  Else
    Result := false;
End;

// This routine is just for the $EXT(max/min) and should be used with care....

Function DXF_Reader.read_2Dpoint( Var p1: Point3D ): boolean;
Var
  GroupCode: integer;
Begin
  Repeat Groupcode := NextGroupCode;
  Until ( Groupcode = DXF_primary_X ) Or ( Groupcode < 0 );
  If Groupcode < 0 Then
  Begin
    result := false;
    exit;
  End;
  p1.x := Valdbl;
  result := code_and_double( Groupcode, p1.y ); { y next              }
End;

Function DXF_Reader.skip_upto_section( Const name: String ): boolean;
Var
  Group: integer;
  s: String;
Begin
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    If ( Group = 0 ) Then
    Begin
      If ( s = 'SECTION' ) Then
      Begin
        If Not code_and_string( Group, s ) Then
          break;
        If ( Group = DXF_name ) Then
        Begin
          If ( s = name ) Then
            result := true
          Else
            exit;
        End
        Else If skipped <> Nil Then
          Skipped.Add( s );
      End
      Else If skipped <> Nil Then
        Skipped.Add( s );
    End;
  Until result;
End;

{ --------------------------------------------------------------------------- }
{ Header section
{ --------------------------------------------------------------------------- }

Function DXF_Reader.move_to_header_section: boolean;
Begin
  result := skip_upto_section( 'HEADER' );
End;

Function DXF_Reader.read_header: boolean;
Var
  Group: integer;
  s: String;
Begin
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    // Add for Acadr14
    If ( group = 9 ) And ( s = '$ACADVER' ) Then
    Begin
      If ( NextGroupCode = 1 ) Then
      Begin
        //add for Acad2000
        If ( Valstr = 'AC1015' ) Then
          Acad_version := 2000;
        If ( Valstr = 'AC1014' ) Then
          Acad_version := 14;
        If ( Valstr = 'AC1012' ) Then
          Acad_version := 13;
        If ( Valstr = 'AC1009' ) Then
          Acad_version := 12;
      End;
    End;

    If ( group = 9 ) And ( s = '$EXTMAX' ) Then
    Begin
      If Not read_2Dpoint( max_extents ) Then
        break;
    End;
    If ( group = 9 ) And ( s = '$EXTMIN' ) Then
    Begin
      If Not read_2Dpoint( min_extents ) Then
        break;
    End;
    If ( group = 9 ) And ( s = '$CECOLOR' ) Then
    Begin
      If ( NextGroupCode = DXF_colornum ) And ( ValInt = 256 ) Then
        colour_BYLAYER := true;
    End;
    result := ( Group = 0 ) And ( s = 'ENDSEC' );
  Until result;
End;

{ --------------------------------------------------------------------------- }
{ Class section
{ --------------------------------------------------------------------------- }

Function DXF_Reader.move_to_Class_section: boolean;
Begin
  result := skip_upto_section( 'CLASSES' );
End;

Function DXF_Reader.read_Class: boolean;
Var
  Group: integer;
  s: String;
Begin
  // Add for Acadr14
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    result := ( Group = 0 ) And ( s = 'ENDSEC' );
  Until result;
End;

Function DXF_Reader.get_min_extent: Point3D;
Begin
  result := min_extents;
End;

Function DXF_Reader.get_max_extent: Point3D;
Begin
  result := max_extents;
End;
{ --------------------------------------------------------------------------- }
{ Blocks section
{ --------------------------------------------------------------------------- }

Function DXF_Reader.move_to_blocks_section: boolean;
Begin
  result := skip_upto_section( 'BLOCKS' );
End;

Function DXF_Reader.read_blocks: boolean;
Var
  Group: integer;
  s: String;
Begin
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    If ( Group = 0 ) And ( s = 'BLOCK' ) Then
    Begin
      If Not read_block Then
        break;
    End;
    result := ( Group = 0 ) And ( s = 'ENDSEC' );
  Until result;
End;

Function DXF_Reader.Blocklayer: DXF_Layer;
Var
  lp1: integer;
  layer: DXF_Layer;
Begin
  Result := Nil;
  For lp1 := 0 To DXF_Layers.count - 1 Do
  Begin
    layer := DXF_Layers[lp1];
    If layer.layer_name = 'Block_' Then
    Begin
      result := layer;
      exit;
    End;
  End;
End;

Function DXF_Reader.read_block: boolean;
Var
  Groupcode: integer;
  s: String;
  ent: abstract_entity;
  block: Block_;
  layer: integer;
  entity: DXF_Entity;
  MyLayer: DXF_Layer;

  // prohibit duplicate block name in block list,
  // check block name in block list
  Function checkblockexist( const blockname: String ): block_;
  Var
    bel: DXF_layer;
    bent: dxf_entity;
    lp0: integer;
  Begin
    result := Nil;
    bel := Blocklayer;
    If bel <> Nil Then
    Begin
      For lp0 := 0 To bel.entities.Count - 1 Do
      Begin
        bent := bel.entities[lp0];
        If block_( bent ).name = blockname Then
        Begin
          result := block_( bent );
          break;
        End;
      End;
    End;
  End;

Begin
  result := false;
  ent := read_generic( layer );
  layer := layer_num( 'Block_' ); // ALL BLOCKS GOING TO LAYER 'Block_' (makes things easier)
  If layer < 0 Then
    layer := DXF_Layers.Add( DXF_Layer.Create( 'Block_', 7, 'CONTINUOUS' ) );
  If ent <> Nil Then
  Begin
    //if copy(ent.namestr,1,1)<>'$' then begin
    If Not ( ent.namestr[1] In ['*', '$'] ) Then
    Begin
      block := Block_.Create( ent.namestr, ent.p1 );
      DXF_Layer( DXF_Layers[layer] ).add_entity_to_layer( block );
      Repeat
        If Not code_and_string( Groupcode, s ) Then
          break;
        If ( Groupcode = 0 ) Then
        Begin
          result := read_entity( s, 'ENDBLK', entity, layer );
          If entity <> Nil Then
          Begin
            If ( dxf_entity( entity ).colour = 0 ) And ( findlayer( ent.layer, Mylayer ) ) Then
              dxf_entity( entity ).setcolour_index( mylayer.Colour );
            //               if copy(block.name,1,1)<>'*' then // reference block check
            block.entities.Add( entity );
          End;
        End;
      Until result;
      ent.Free;
    End
    Else
      Repeat
        If Not code_and_string( Groupcode, s ) Then
          break;
        If ( Groupcode = 0 ) Then
          result := read_entity( s, 'ENDBLK', entity, layer );
      Until result;
  End;
End;

{ --------------------------------------------------------------------------- }
{ Tables (Layers - VPort) section
{ --------------------------------------------------------------------------- }

Function DXF_Reader.move_to_tables_section: boolean;
Begin
  result := skip_upto_section( 'TABLES' );
End;

Function DXF_Reader.read_tables: boolean;
Var
  Group: integer;
  s: String;
Begin
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    If ( Group = 0 ) And ( s = 'TABLE' ) Then
    Begin
      If Not code_and_string( Group, s ) Then
        break;
      If ( Group = DXF_name ) Then
      Begin
        If ( s = 'LAYER' ) Then
          read_layer_information
        Else If ( s = 'VPORT' ) Then
          read_vport_information
        Else If skipped <> Nil Then
          Skipped.Add( s );
      End;
    End;
    result := ( Group = 0 ) And ( s = 'ENDSEC' );
  Until result;
End;

Function DXF_Reader.read_layer_information: boolean;
Var
  Group, Lay_num: integer;
  s: String;
  NextLayer: Boolean;
Begin
  lay_num := -1;
  result := false;
  //  layerColor := bylayer ;

  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    If ( Group = 0 ) Then
    Begin
      If ( s = 'LAYER' ) Then
      Begin
        Nextlayer := false;
        // Acad R14... lwpolyline...
        Repeat
          If Not code_and_string( Group, s ) Then
            break;
          If ( Group = DXF_colornum ) And ( lay_num <> -1 ) Then
            If ValInt > 255 Then
              DXF_Layer( DXF_Layers[lay_num] ).Colour := 7
            Else
              DXF_Layer( DXF_Layers[lay_num] ).Colour := Valint;
          // Acad Layer Linestyle
          If ( Group = DXF_Line_Type ) And ( lay_num <> -1 ) Then
          Begin
            DXF_Layer( DXF_Layers[lay_num] ).LineStyle := AcadLineStyle.FindLineStyle( S );
            DXF_Layer( DXF_Layers[lay_num] ).LineType := S;
          End;
          // use for making layer if layer isn't
          If ( Group = DXF_name ) Then
            lay_num := DXF_Layers.Add( DXF_Layer.Create( s, 7, 'CONTINUOUS' ) );
          // NextLayer := (Group=0);
          NextLayer := ( Group = DXF_Line_Type ) Or ( Group = 0 );
        Until NextLayer;
      End
      Else If ( s = 'ENDTAB' ) Then
        result := true
      Else If skipped <> Nil Then
        Skipped.Add( s );
    End
    Else If ( Group = DXF_colornum ) And ( lay_num <> -1 ) Then
    Begin
      If ValInt > 255 Then
        DXF_Layer( DXF_Layers[lay_num] ).Colour := 7
      Else
        DXF_Layer( DXF_Layers[lay_num] ).Colour := Valint;
    End;
  Until result;
End;

// This no longer does anything !

Function DXF_Reader.read_vport_information: boolean;
Var
  Group: integer;
  s: String;
Begin
  result := false;
  Repeat
    If Not code_and_string( Group, s ) Then
      break;
    If ( Group = 0 ) Then
    Begin
      If ( s = 'VPORT' ) Then
      Begin
        If Not code_and_string( Group, s ) Then
          break;
        //Acad R14
        If Acad_version > 12 Then
          Repeat
            If Not code_and_string( Group, s ) Then
              break;
            result := ( Group = 2 );
          Until ( result );

        If ( Group = DXF_name ) Then
        Begin

          If ( s = '*ACTIVE' ) Then
            Repeat
              If Not code_and_string( Group, s ) Then
                break;
              { removed Aspectratio stuff since it never seems to make any difference
                and sometimes buggers everything up
                          if (Group=DXF_floatvals1) then Aspect := ValDbl;
              }
              result := ( Group = 0 ) And ( s = 'ENDTAB' );
            Until ( result )
          Else If skipped <> Nil Then
            Skipped.Add( s );
        End;
      End
      Else If skipped <> Nil Then
        Skipped.Add( s );
    End
  Until ( result );
End;

Function DXF_Reader.layer_num( Const layername: String ): integer;