ezdxfread.pas

很管用的GIS控件

      End
      Else
      Begin
        j := 0;
        For i := 0 To trunc( num ) - 1 Do
        Begin
          TempVert2[VertNo + j].x := xcenter - x[i];
          TempVert2[VertNo + j].y := ycenter - y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End;
    End;
    vertno := vertno + trunc( num );
  End;

Begin
  result := false;
  closed_poly := false;
  entity := Nil;
  ent1 := abstract_entity.Create;
  //  ent1.colour := bylayer ;

  // read initial polyline data
  If Not read_entity_data( ent1 ) Then
  Begin
    ent1.Free;
    exit;
  End;
  layer := layer_num( ent1.layer );

  If ( ent1.colour = 0 ) And ( layer <> -1 ) Then
    ent1.Colour := Dxf_layer( dxf_layers[layer] ).colour;
  If ( layer = -1 ) Then
    layer := DXF_Layers.Add( DXF_Layer.Create( ent1.layer, ent1.colour, ent1.LineStyle ) );

  vertices := 0;
  faces := 0;
  ent2 := abstract_entity.Create;
  //  ent2.colour := bylayer ;

  //////////////////////////////////////////
  //////////////////////////////////////////
  If ( ent1.flag_70 And ( 64 + 16 ) ) = 0 Then
  Begin
    // THIS IS A NORMAL POLYLINE
    Repeat
      If ( NextGroupCode = 0 ) And ( ValStr = 'VERTEX' ) Then
      Begin
        ent2.clear;
        If read_entity_data( ent2 ) Then
        Begin
          tempvert[vertices] := ent2.p1;
          tempfv[vertices] := ent2.fv2;
          inc( vertices );
          If vertices >= max_vertices_per_polyline Then
            Goto vertex_overflow;
        End
        Else
        Begin
          // Errlist.Add('Polyline contained odd vertex'+inttostr(line_num));
          ent1.Free;
          ent2.Free;
          exit;
        End; // error
      End;
    Until fLine = 'SEQEND';
    // this should set result to true, because 0 SEQEND is next
    result := NextGroupCode = 0;
    If ( ( ent1.flag_70 ) And 1 ) = 1 Then
      closed_poly := true;

    // Added for new Polyline Arc...
    entity := Nil;
    If Checkbulge = false Then
      entity := Polyline_.Create( ent1.OCS_Z, vertices, @tempvert[0], ent1.colour,
        closed_poly, DXF_Layer( DXF_Layers[Layer] ).LineStyle )
    Else
    Begin
      m := 0;
      For i := 0 To vertices - 1 Do
        If tempfv[i] <> 0 Then
        Begin
          If i < ( vertices - 1 ) Then
          Begin
            If bulge2arc( tempvert[i], tempvert[i + 1], tempfv[i], cc, rr, sa, ea ) = 0 Then
            Begin
              tempvert2[m] := tempvert[i];
              inc( m );
              Arc( cc.x, cc.y, tempvert[i].z, rr, sa, ea, tempfv[i], m );
            End;
          End
          Else
          Begin
            If closed_poly Then
            Begin
              If bulge2arc( tempvert[i], tempvert[0], tempfv[i], cc, rr, sa, ea ) = 0 Then
              Begin
                tempvert2[m] := tempvert[i];
                inc( m );
                Arc( cc.x, cc.y, tempvert[i].z, rr, sa, ea, tempfv[i], m );
              End;
            End
            Else
            Begin
              tempvert2[m] := tempvert[i];
              inc( m );
            End;
          End;
        End
        Else
        Begin
          tempvert2[m] := tempvert[i];
          inc( m );
        End;
      If m > 0 Then
        Entity := Polyline_.Create( ent1.OCS_Z, m, @tempvert2[0], ent1.colour,
          closed_poly, DXF_Layer( DXF_Layers[Layer] ).LineStyle )
    End;
  End
  Else If ( ent1.flag_70 And 16 ) = 16 Then
  Begin
    // THIS IS A POLYGON MESH - a grid of vertices joined along M & N
    M := ent1.flag_71;
    N := ent1.flag_72;
    mn := 0;
    Repeat
      If ( NextGroupCode = 0 ) And ( ValStr = 'VERTEX' ) Then
      Begin
        If read_entity_data( ent2 ) Then
        Begin
          inc( mn );
          If ( ent2.Flag_70 And 64 ) = 64 Then
          Begin
            tempvert[vertices] := ent2.p1;
            inc( vertices );
            If vertices >= max_vertices_per_polyline Then
              Goto vertex_overflow;
          End
          Else
          Begin
            ent1.Free;
            ent2.Free;
            exit;
          End; // error
        End
        Else
        Begin
          ent1.Free;
          ent2.Free;
          exit;
        End; // error
      End;
    Until fLine = 'SEQEND';
    result := NextGroupCode = 0;
    If mn <> M * N Then
    Begin
      ent1.Free;
      ent2.Free;
      exit;
    End; // error
    If ent1.LineStyle = '' Then
      LS := DXF_Layer( DXF_Layers[Layer] ).LineStyle // bylayer
    Else
      LS := AcadLineStyle.FindLineStyle( ent1.linestyle );
    entity := Polygon_mesh_.Create( vertices, M, N, @tempvert[0], ent1.flag_70, ent1.colour, LS );
  End
    //////////////////////////////////////////
    //////////////////////////////////////////
  Else If ( ent1.flag_70 And 64 ) = 64 Then
  Begin
    // THIS IS A POLYFACE MESH - a vertex array with faces
    Repeat
      If ( NextGroupCode = 0 ) And ( ValStr = 'VERTEX' ) Then
      Begin
        If read_entity_data( ent2 ) Then
        Begin
          If ( ent2.Flag_70 And ( 128 + 64 ) ) = ( 128 + 64 ) Then
          Begin
            // this is a normal coordinate vertex
            tempvert[vertices] := ent2.p1;
            inc( vertices );
            If vertices >= max_vertices_per_polyline Then
              Goto vertex_overflow;
          End
          Else If ( ent2.Flag_70 And ( 128 ) ) = ( 128 ) Then
          Begin
            // this is a face definition vertex
            // negative indices indicate invisible edges
            tempface[faces].nf[0] := ent2.flag_71; // Abs( ent2.flag_71 ) - 1 index 1..n -> 0..n-1
            tempface[faces].nf[1] := ent2.flag_72;
            tempface[faces].nf[2] := ent2.flag_73;
            tempface[faces].nf[3] := ent2.flag_74;
            inc( faces );
          End
          Else
          Begin
            ent1.Free;
            ent2.Free;
            exit;
          End; // error
        End
        Else
        Begin
          ent1.Free;
          ent2.Free;
          exit;
        End; // error
      End;
    Until fLine = 'SEQEND';
    result := NextGroupCode = 0;
    If ent1.LineStyle = '' Then
      LS := DXF_Layer( DXF_Layers[Layer] ).LineStyle // bylayer
    Else
      LS := AcadLineStyle.FindLineStyle( ent1.linestyle );
    entity := Polyface_mesh_.Create( ent1.OCS_Z, vertices, faces, @tempvert[0], @tempface[0], ent1.colour, LS );
  End;
  //////////////////////////////////////////
  //////////////////////////////////////////
  ent1.Free;
  ent2.Free;
  exit; // next bit only when vertices overflow

  vertex_overflow:
  ent1.Free;
  ent2.Free;
  Errlist.Add( Format( SDXFPolylineBad, [max_vertices_per_polyline, line_num] ) );
  {  raise DXF_read_exception.Create('Polyline contained more than '+
      IntToStr(max_vertices_per_polyline)+' vertices',line_num);}
End;

//polyline_arc_end

Function DXF_Reader.read_entity( Const s, endstr: String;
  Var entity: DXF_Entity; Var layer: integer ): boolean;
Begin
  entity := Nil;
  result := false;
  If ( s = 'POINT' ) Then
  Begin
    If Not general_purpose_read( Point_, entity, layer ) Then
      Errlist.add( SDXFPointBad + inttostr( line_num ) );
  End
  Else If ( s = 'INSERT' ) Then
  Begin
    If Not read_insert( entity, layer ) Then
      ErrList.add( SDXFINSERTBad + Inttostr( line_num ) );
  End
  Else If ( s = 'TEXT' ) Then
  Begin
    If Not general_purpose_read( Text_, entity, layer ) Then
      Errlist.add( SDXFTEXTBad + Inttostr( line_num ) );
  End
  Else If ( s = 'LINE' ) Then
  Begin
    If Not general_purpose_read( Line_, entity, layer ) Then
      Errlist.add( SDXFLINEBad + Inttostr( line_num ) );
  End
  Else If ( s = 'POLYLINE' ) Then
  Begin
    If Not read_polyline( entity, layer ) Then
      Errlist.add( SDXFPOLYLINEBad2 + inttostr( line_num ) );
  End
  Else If ( s = 'LWPOLYLINE' ) Then
  Begin
    If Not read_lwpolyline( entity, layer ) Then
      Errlist.add( SDXFLWPOLYLINEBad2 + inttostr( line_num ) );
  End
  Else If ( s = '3DFACE' ) Then
  Begin
    If Not general_purpose_read( Face3D_, entity, layer ) Then
      ErrList.add( SDXF3DFACEBad + Inttostr( line_num ) );
  End
  Else If ( s = 'SOLID' ) Then
  Begin
    If Not general_purpose_read( Solid_, entity, layer ) Then
      ErrList.add( SDXFSOLIDBad + Inttostr( line_num ) );
  End
  Else If ( s = 'CIRCLE' ) Then
  Begin
    If Not general_purpose_read( Circle_, entity, layer ) Then
      Errlist.add( SDXFCIRCLEBad + inttostr( line_num ) );
  End
  Else If ( s = 'ARC' ) Then
  Begin
    If Not general_purpose_read( Arc_, entity, layer ) Then
      ErrList.add( SDXFARCBad + inttostr( line_num ) );
  End
  Else If ( s = 'ATTDEF' ) Then
  Begin
    If Not general_purpose_read( AttDef_, entity, layer ) Then
      Errlist.add( SDXFATTDEFBad + inttostr( line_num ) );
  End
  Else If ( s = 'ATTRIB' ) Then
  Begin
    If Not general_purpose_read( Attrib_, entity, layer ) Then
      Errlist.add( SDXFATTRIBBad + inttostr( line_num ) );
  End
  Else If ( s = endstr ) Then
    result := true
  Else If skipped <> Nil Then
    Skipped.Add( s );

End;
///////////////////////////////////////////////////////////////////////////////
// Main routines to use
///////////////////////////////////////////////////////////////////////////////

Function DXF_Reader.read_file: boolean;
Var
  lp1: integer;
  //DispText : array[0..255] of char ;
  canContinue: boolean;
Begin
  result := true;
  //StrpCopy( DispText, DXF_FILE+' Now Reading DXF File...');
  //thinking_bar(nil, DispText );

  //Added for GIS
  If fGIS <> Nil Then
    FGIS.UpdateCaption( SDXFReading );
  Try
    mark_position;
    If Not ( move_to_header_section And read_header ) Then
    Begin
      //Added for GIS
      If fGIS <> Nil Then
        FGIS.UpdateCaption( SDXFThereIsNoHeader );

      Sleep( message_delay_ms );
      goto_marked_position;
    End;
    mark_position;

    //Myadd for r14
    If Acad_version > 12 Then
      If Not ( move_to_class_section And read_class ) Then
      Begin
        //Thinking(nil,'No Header or invalid Header section in DXF file');
        // Added for GIS
        If fGIS <> Nil Then
          FGIS.UpdateCaption( SDXFThereIsNoHeader );
        Sleep( message_delay_ms );
        goto_marked_position;
      End;
    mark_position;

    If Not ( move_to_tables_section And read_tables ) Then
    Begin
      //Thinking(nil,'No Layer or Table Section in DXF file');
      // Added for GIS
      If fGIS <> Nil Then
        FGIS.UpdateCaption( SDXFThereIsNoLayers );
      Sleep( message_delay_ms );
      goto_marked_position;
    End;
    mark_position;

    If Not ( move_to_blocks_section And read_blocks ) Then
    Begin
      //Thinking(nil,'No Block or Invalid Block Section in DXF file');
      // Added for GIS
      If fGIS <> Nil Then
        FGIS.UpdateCaption( SDXFThereIsNoBlocks );
      Sleep( message_delay_ms );
      goto_marked_position;
    End;
    mark_position;
    // Added for GIS
    If fGIS <> Nil Then
      FGIS.UpdateCaption( SDXFReading );
    //thinking_bar(nil, DispText);
    If Not ( move_to_entity_section And read_entities ) Then
      Raise DXF_read_exception.Create( SDXFThereIsNoEntities, -1 );
  Except
    On E: DXF_read_exception Do
    Begin
      If assigned( FGis.OnError ) Then
      Begin
        FGis.OnError( FGis, E.Message, esImporting, canContinue );
      End;
    End;
    On E: EAccessViolation Do
    Begin
      If assigned( FGis.OnError ) Then
      Begin
        FGis.OnError( FGis, E.Message, esImporting, canContinue );
      End;
    End;
  End;
  If p1_eq_p2_3D( min_extents, origin3D ) Or p1_eq_p2_3D( max_extents, origin3D )
    Or (min_extents.x > max_extents.x) Or (min_extents.y > max_extents.y) Then
  Begin
    If fGIS <> Nil Then
      FGIS.UpdateCaption( SDXFThereIsNoMaxMin );
    //thinking(nil, 'No Exists Max/Min information in DXF File, Now Searching...');
    //sleep( message_delay_ms ); // just a delay to let the message be visible
    For lp1 := 0 To DXF_layers.count - 1 Do
    Begin
      If DXF_Layer(DXF_Layers[lp1]).layer_name <> 'Block_' then
        DXF_Layer( DXF_Layers[lp1] ).max_min_extents( max_extents, min_extents );
    End;
  End;
  //stopped_thinking;
  // Added for GIS
  //MyDlg.Release;
End;

Function DXF_Reader.remove_empty_layers: boolean;
Var
  lp1: integer;
  layer: DXF_layer;
Begin
  For lp1 := DXF_Layers.count - 1 Downto 0 Do
  Begin
    layer := DXF_Layers[lp1];
    If layer.entities.count = 0 Then
    Begin
      DXF_Layers.Remove( layer );
      layer.Free;
    End;
  End;
  result := ( DXF_Layers.count > 0 );
End;

// Hand over ownership of the layers, the owner of the entity lists
// is now responsible for their destruction

Function DXF_Reader.release_control_of_layers: TList;
Begin
  result := DXF_Layers;
  DXF_Layers := Nil;
End;

// Since we're not reading all groupcodes, we offer the chance
// to dump the main titles into a list so we can see what
// we've missed

Procedure DXF_Reader.set_skipped_list( s: TStrings );
Begin
  skipped := s;
End;
///////////////////////////////////////////////////////////////////////////////
// DXF File exception
///////////////////////////////////////////////////////////////////////////////

Constructor DXF_read_exception.Create( Const err_msg: String; line: integer );
Begin
  If line > -1 Then
    message := err_msg + EOL + SDXFErrorInLine + IntToStr( line )
      //message := err_msg + #13#10 + 'Error occured at or near line number ' + IntToStr(line)
  Else
    message := err_msg;
End;

End.