ezdxfimport.pas

很管用的GIS控件

  End;
  ///////////////////////////////////////////////////////////////////////////////
  // Face3D_ Definition - Should be 3DFace but can't name a type starting with 3
  ///////////////////////////////////////////////////////////////////////////////
  Face3D_ = Class( Polyline_ ) // always WCS
    Constructor Create( numpoints: integer; points: ppointlist; col: integer; closed_: boolean; LS: Integer );
    Function proper_name: String; Override; // save as 3DFACE not Face3D
    Procedure write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: integer ); Override;
  End;
  ///////////////////////////////////////////////////////////////////////////////
  // Solid_ Definition
  ///////////////////////////////////////////////////////////////////////////////
  Solid_ = Class( Face3D_ ) // always OCS
    thickness: Double;
    Constructor Create( OCSaxis: Point3D; numpoints: integer; points: ppointlist; col: integer; t: Double; LS: Integer );
    Function proper_name: String; Override;
    Procedure write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: integer ); Override;
    // Added for GIS
    Procedure AddToGIS( DxfImport: TEzDxfImport; OCS: pM ); Override;
  End;
  ///////////////////////////////////////////////////////////////////////////////
  // Polyline_ (polygon MxN grid mesh) Definition
  ///////////////////////////////////////////////////////////////////////////////
  Polygon_mesh_ = Class( Polyline_ ) // always WCS ???
    M, N: integer;
    closeM, closeN: boolean;
    Constructor Create( numpoints, Mc, Nc: integer; points: ppointlist; closebits, col: integer; LS: Integer );
    Function proper_name: String; Override;
    Procedure write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: integer ); Override;
    // Added for GIS
    Procedure AddToGIS( DxfImport: TEzDxfImport; OCS: pM ); Override;
  End;
  ///////////////////////////////////////////////////////////////////////////////
  // Polyline_ (polyface vertex array mesh) Definition
  ///////////////////////////////////////////////////////////////////////////////
  Polyface_mesh_ = Class( Polyline_ ) // always WCS ???
    numfaces: integer;
    facelist: pfacelist;
    Constructor Create( const OCSaxis: Point3D; numpoints, nfaces: integer;
      points: ppointlist; faces: pfacelist; col: integer; LS: Integer );
    Destructor Destroy; Override;
    Function proper_name: String; Override;
    Procedure write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: integer ); Override;
    // Added for GIS
    Procedure AddToGIS( DxfImport: TEzDxfImport; OCS: pM ); Override;
  End;
  //*****************************************************************************
  // DXF_layer class definition
  // A collection of entity lists. One for each type.
  //*****************************************************************************
  DXF_Layer = Class
    layer_name: String;
    layer_colinx: integer;
    entities: TList;
    LineStyle: integer; //GIS Style
    LineType: String; //AutoCAD LineType
    FContinueProcessing: Boolean;
    Constructor Create( Const l_name: String; Lcolor: integer; LS: String );
    Destructor Destroy; Override;

    Function num_entities: integer;
    Procedure AddToGIS( DxfImport: TEzDxfImport; OCS: pM );

    Property Colour: integer Read layer_colinx Write layer_colinx;
    Property name: String Read layer_name Write layer_name;
    Function add_entity_to_layer( entity: DXF_Entity ): boolean;
    // utilities
    Procedure max_min_extents( Var emax, emin: Point3D );
  End;
  //*****************************************************************************
  // DXF_Object class definition
  // A Collection of DXF_Layers - eg a whole DXF file.
  //*****************************************************************************
  DXF_Object = Class
    DxfFile: TEzDxfFile;
    FDXF_name: String;
    layer_lists: TList;
    emax: Point3D;
    emin: Point3D;
    // Create an empty object
    Constructor Create( ADxfFile: TEzDxfFile; Const aname: String );
    // Create an object and load from file
    Constructor Create_from_file( ADxfFile: TEzDxfFile; Const aname: String; skipped, errlog: Tstrings );
    Procedure save_to_file( Const aname: String );
    Destructor Destroy; Override;

    Procedure ReadDXF( Const aname: String; skipped, errlog: Tstrings );
    Function num_layers: integer;
    // add an empty layer
    Function new_layer( Const aname: String; DUPs_OK: boolean ): DXF_Layer;
    // add a pre-filled layer
    Function add_layer( layer: DXF_Layer ): boolean;
    // return the layer with a given name
    Function layer( Const aname: String ): DXF_Layer;
    // add an entity to a named layer
    Function add_entity_to_layer( entity: DXF_Entity; Const aname: String ): boolean;
    // return layer and Create if neccessary
    Function Create_or_find_layer( Const aname: String ): DXF_Layer;
    // Useful ones
    Function get_min_extent: Point3D;
    Function get_max_extent: Point3D;
    // update the extents (not really needed)
    Procedure max_min_extents( Var emax, emin: Point3D );

    Property name: String Read FDXF_name Write FDXF_name;

  End;

  // color handling (used only to allocate dynamic memory)
  TAcadColorPal = Class( TObject )
  Private
    FColorData: Array[0..256] Of integer;
    Function GetColors( Index: Integer ): Integer;
  Public
    Constructor Create;
    Function NumColors: Integer;
    Property Colors[Index: Integer]: Integer Read GetColors; Default;
  End;

  // Line Style handling (used only to allocate dynamic memory)
  TAcadLineStyle = Class( TObject )
  Private
    //FLineData: array[0..49] of string;
    //FEzStyle : array[0..49] of Integer;
  Public
    //constructor Create;
    Function NumLineStyles: Integer;
    Function FindLineStyle( const LineStyle: String ): Integer;
    Function GetLineStyle( Index: Integer ): String;
    //Property LineStyles[Index: integer]: String Read GetLineStyle; Default;
    Function ACADLineFromLine( index: integer ): String;
  End;


  ///////////////////////////////////////////////////////////////////////////////
  // Memory check variables
  ///////////////////////////////////////////////////////////////////////////////
Var
  Dxf_Errshow: Integer;
  Dxf_Version: Integer;
  Text_height_control: Integer;
  Text_Small_Display: boolean;

  // Added for GIS
  AcadColorPal: TAcadColorPal = Nil;
  AcadLineStyle: TAcadLineStyle = Nil;

Implementation

Uses
  EzConsts, EzDXFRead, EzDXFWrite;

Const
  BYLAYER = 256;

Type

  ///////////////////////////////////////////////////////////////////////////////
  // DXF exceptions will be this type
  ///////////////////////////////////////////////////////////////////////////////
  EDXF_exception = Class( Exception );
  ///////////////////////////////////////////////////////////////////////////////
  // Default AutoCad layer colours (1..7) - (8..user defined)
  ///////////////////////////////////////////////////////////////////////////////



{ TEzDxfFile }

Destructor TEzDxfFile.Destroy;
Begin
  If Assigned( FDxf_Main ) Then
    FDxf_Main.Free;
  Inherited Destroy;
End;

function TEzDxfFile.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzDxfFile.SetAbout(const Value: TEzAbout);
begin
end;

Procedure TEzDxfFile.Notification( AComponent: TComponent;
  Operation: TOperation );
Begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( AComponent = FDrawBox ) Then
    FDrawBox := Nil;
End;

function TEzDxfFile.ProperColor(clr: TColor): TColor;
begin
  Result:= clr;
  If clr = ColorToRGB( FDrawBox.Color ) then
  begin
    if ColorToRGB( FDrawBox.Color ) = clWhite then
      Result:= clBlack
    else
      Result:= clWhite;
  end;
end;

Procedure TEzDxfFile.SetDrawBox( Const Value: TEzBaseDrawBox );
Begin
{$IFDEF LEVEL5}
  if Assigned( FDrawBox ) then FDrawBox.RemoveFreeNotification( Self );
{$ENDIF}
  If Value <> FDrawBox Then
  Begin
    Value.FreeNotification( Self );
  End;
  FDrawBox := Value;
End;

{ TEzDxfImport }

Constructor TEzDxfImport.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FCad:= TEzCad.Create( Nil );
  FCad.CreateNew('dummy');
  FTargetNames:= TStringList.Create;
  FExplodeBlocks := True;

  FConfirmProjectionSystem := True;
  FImportLayerList := TStringList.Create;
  FFullLayerList := TStringList.Create;
  FConverter := TEzImportConverter.Create;
  FMustDeleteConverter := True;
  FUseTrueType:= True;
  FImportBlocks:= True;
End;

Destructor TEzDxfImport.Destroy;
Begin
  FImportLayerList.Free;
  FFullLayerList.Free;
  If FMustDeleteConverter And ( FConverter <> Nil ) Then
    FConverter.free;
  FCad.Free;
  FTargetNames.Free;

  Inherited Destroy;
End;

Procedure TEzDxfImport.SetConverter( Value: TEzImportConverter );
Begin
  If ( FConverter <> Nil ) And FMustDeleteConverter Then
    FreeAndNil( FConverter );
  FConverter := Value;
  FMustDeleteConverter := False;
End;

Function TEzDxfImport.UpdateProgress: Boolean;
Var
  progress: integer;
Begin
  result := True;
  If Not Assigned( OnFileProgress ) Or ( FTotalEntities = 0 ) Then
    Exit;
  progress := round( ( FTotalProcessed / FTotalEntities ) * 100 );
  OnFileProgress( Self, FMsg, progress, FTotalProcessed, 0, result );
End;

Procedure TEzDxfImport.SetLayerName( Const Value: String );
Begin
  FLayerName := ExtractFileName( ChangeFileExt( Value, '' ) );
  if (FDrawBox <> nil) and (FDrawBox.Gis <> Nil) then
  FLayer:= FDrawBox.Gis.Layers.LayerByName( FLayerName );
End;

Function TEzDxfImport.ReadDxf: Boolean;
Var
  alayer: Dxf_layer;
  Layer: TEzBaseLayer;
  i: Integer;
  blk: Block_;
  J: Integer;
  Index: integer;
  Symbol: TEzSymbol;
  K: Integer;
  ent: Dxf_entity;
  Found: Boolean;
  NativeEnt: TEzEntity;
  TempImport: TEzDxfImport;
{$IFDEF FALSE}
  i, j, K, PrevLayerCount: integer;
  ent: Dxf_entity;
  s: String;
  p: TEzPoint;
  Dxf_OffsetX, Dxf_OffsetY: Double;
{$ENDIF}
  Fullname: String;
  Extent: TEzRect;

{$IFDEF FALSE}
  Procedure OffsetPoint( Var p: Point3D );
  Begin
    p.x := p.x + Dxf_OffsetX;
    p.y := p.y + Dxf_OffsetY;
  End;
{$ENDIF}

Begin
  If FDrawBox = Nil Then
    EzGISError( SWrongEzGIS );
  If FConverter = Nil Then
    EzGISError( SWrongProjector );
  result := True;
  FreeAndNil( FDxf_Main );
  Try
    FDxf_Main := Dxf_Object.Create_from_file( self, FFileName, Nil, Nil );
    FDxf_Emin := Dxf_main.get_min_extent;
    FDxf_Emax := Dxf_main.get_max_extent;
    { build the layer list }
    FImportLayerList.Clear;
    With FDxf_Main Do
      For I := 0 To layer_lists.count - 1 Do
      Begin
        alayer := Dxf_layer( layer_lists[I] );
        FImportLayerList.AddObject( alayer.name, alayer );
        FFullLayerList.AddObject( alayer.name, alayer );
      End;
  Except
    result := False;
  End;

  { now convert to EzGis format }

  //Self.ExplodeBlocks := True;

  { set cad extents to map extents as is done in the dialog previously }
  DxfReferenceX := Dxf_Emin.x;
  DxfReferenceY := Dxf_Emin.y;
  DestReferenceX:= Dxf_Emin.x;
  DestReferenceY:= Dxf_Emin.y;

{$IFDEF FALSE}
  Dxf_offsetX := FDestReferenceX - FDxfReferenceX;
  Dxf_offsetY := FDestReferenceY - FDxfReferenceY;
{$ENDIF}

  { causes to set extension to undefined }
  FCAD.UpdateExtension;

  { Offset all entities if requested }
  Screen.Cursor := crHourGlass;
  Try
{$IFDEF FALSE}
    If ( Dxf_offsetX <> 0 ) Or ( Dxf_offsetY <> 0 ) Then
    Begin
      For I := 0 To FImportLayerList.Count - 1 Do
      Begin
        alayer := Dxf_layer( FImportLayerList.Objects[I] );
        If AnsiCompareText( alayer.layer_name, 'Block_' ) = 0 Then
          Continue;
        For J := 0 To alayer.entities.count - 1 Do
        Begin
          ent := Dxf_entity( alayer.entities[J] );
          If ent.classtype = Block_ Then
            With Block_( ent ) Do
            Begin
              OffsetPoint( basepoint );
            End
          Else If ( ent.classtype = Point_ ) Or ( ent.classtype = Circle_ ) Or
                  ( ent.classtype = Arc_ ) Then
            With Point_( ent ) Do
            Begin
              OffsetPoint( p1 );
            End
          Else If ( ent.classtype = Text_ ) Or
            ( ent.classtype = Attrib_ ) Or
            ( ent.classtype = Attdef_ ) Then
            With Text_( ent ) Do
            Begin
              OffsetPoint( p1 );
              OffsetPoint( align_pt );
            End
          Else If ent.classtype = Insert_ Then
            With Insert_( ent ) Do
            Begin
              OffsetPoint( p1 );
            End
          Else If ent.classtype = Line_ Then
            With Line_( ent ) Do
            Begin
              OffsetPoint( p1 );
              OffsetPoint( p2 );
            End
          Else If ent Is Polyline_ Then
            With Polyline_( ent ) Do
            Begin
              For K := 0 To numvertices - 1 Do
              Begin
                OffsetPoint( polypoints^[K] );
              End;
            End;