ezdxfimport.pas

很管用的GIS控件

      If Not ReadDxf Then
        Continue;
      Execute;
      FConfirmProjectionSystem := false;
    End;
    result := True;
  Finally
    FFileName := TmpFilename;
    FConfirmProjectionSystem := TmpBool;
  End;
End;

{$IFDEF BCB}
function TEzDxfImport.GetConfirmProjectionSystem: Boolean;
begin
  Result := FConfirmProjectionSystem;
end;

function TEzDxfImport.GetDestReferenceX: Double;
begin
  Result := FDestReferenceX;
end;

function TEzDxfImport.GetDestReferenceY: Double;
begin
  Result := FDestReferenceY;
end;

function TEzDxfImport.GetDxf_Emax: Point3D;
begin
  Result := FDxf_Emax;
end;

function TEzDxfImport.GetDxf_Emin: Point3D;
begin
  Result := FDxf_Emin;
end;

function TEzDxfImport.GetDxfReferenceX: Double;
begin
  Result := FDxfReferenceX;
end;

function TEzDxfImport.GetDxfReferenceY: Double;
begin
  Result := FDxfReferenceY;
end;

function TEzDxfImport.GetExplodeBlocks: Boolean;
begin
  Result := FExplodeBlocks;
end;

function TEzDxfImport.GetFullLayerList: TStrings;
begin
  Result := FFullLayerList;
end;

function TEzDxfImport.GetImportLayerList: TStrings;
begin
  Result := FImportLayerList;
end;

function TEzDxfImport.GetLayer: TEzBaseLayer;
begin
  Result := FLayer;
end;

function TEzDxfImport.GetLayerName: String;
begin
  Result := FLayerName;
end;

function TEzDxfImport.GetOnAfterImport: TNotifyEvent;
begin
  Result := FOnAfterImport;
end;

function TEzDxfImport.GetOnBeforeImport: TNotifyEvent;
begin
  Result := FOnBeforeImport;
end;

function TEzDxfImport.GetUseTrueType: Boolean;
begin
  Result := FUseTrueType;
end;

procedure TEzDxfImport.SetConfirmProjectionSystem(const Value: Boolean);
begin
  FConfirmProjectionSystem := Value;
end;

procedure TEzDxfImport.SetDestReferenceX(const Value: Double);
begin
  FDestReferenceX := Value;
end;

procedure TEzDxfImport.SetDestReferenceY(const Value: Double);
begin
  FDestReferenceY := Value;
end;

procedure TEzDxfImport.SetDxf_Emax(const Value: Point3D);
begin
  FDxf_EMax := Value;
end;

procedure TEzDxfImport.SetDxf_Emin(const Value: Point3D);
begin
  FDxf_EMin := Value;
end;

procedure TEzDxfImport.SetDxfReferenceX(const Value: Double);
begin
  FDxfReferenceX := Value;
end;

procedure TEzDxfImport.SetDxfReferenceY(const Value: Double);
begin
  FDxfReferenceY := Value;
end;

procedure TEzDxfImport.SetExplodeBlocks(const Value: Boolean);
begin
  FExplodeBlocks := Value;
end;

{$ENDIF}

{ TEzDxfExport }

Constructor TEzDxfExport.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FLayerNames := TStringList.Create;
End;

Destructor TEzDxfExport.Destroy;
Begin
  FLayerNames.Free;
  Inherited Destroy;
End;

Function TEzDxfExport.Execute: Boolean;
Var
  blocklayer, dxflayer: DXF_Layer; // DXF layer
  layer: TEzBaseLayer; // GIS layer
  I, J: Integer;
  Symbol: TEzSymbol;
  block: Block_;
  s: String;
  dxfentity: DXF_Entity; // DXF entity
  entity: TEzEntity; // GIS entity
  TmpVp: TEzBaseDrawBox;
  SymbolNames: TStrings;

  ExpSymbolList: TBits;  // +++ list of symbols to export
  Found: Boolean;

  Function ACADColorFromColor( Color: TColor ): Integer;
  Var
    i: integer;
  Begin
    If Color = clBlack Then
      Color := clWhite;
    Result := 7;
    For i := 0 To 255 Do
      If AcadColorPal[i] = Color Then
      Begin
        Result := i;
        Exit;
      End;
  End;

  Procedure AddGEntityToEntityList( entlist: TList; Ent: TEzEntity );
  Var
    MaxSize, Sx, Sy: Double;
    process: boolean;
    I, n, Idx1, Idx2, cnt: Integer;
    atts: Array[0..255] Of Attrib_;
    p1: Point3D;
    tempvert: Array[0..max_vertices_per_polyline - 1] Of Point3D;
  Begin
    process := True;
    Case Ent.EntityID Of
      idPlace:
        With TEzPlace( Ent ) Do
        Begin
          If ( SymbolTool.Index < 0 ) Or ( SymbolTool.Index > Ez_Symbols.Count - 1 ) Then
            SymbolTool.Index := 0;
          //Exit;
          Symbol := Ez_Symbols[SymbolTool.Index];
          If Symbol.Count = 0 Then Exit; // no entities in symbol
          With Symbol.Extension Do
          Begin
            MaxSize := dMax( Emax.X - Emin.X, Emax.Y - Emin.Y );
            Sx := SymbolTool.height / MaxSize;
            Sy := Sx;
            If Sx = 0 Then
              Sx := 1;
            If Sy = 0 Then
              Sy := 1;
          End;
          //PlaceSize := MaxSize * Sx;
          // now generate an insert
          //p1 := aPoint3D( Points[0].X - PlaceSize / 2, Points[0].Y - PlaceSize / 2, 0 );
          p1 := aPoint3D( Points[0].X, Points[0].Y , 0 );
          S := Trim( Symbol.Name );
          S := StringReplace( S, #32, '', [rfReplaceAll] );
          If Length( S ) = 0 Then
            S := Format(SSymbolCaption, [SymbolTool.Index] );
          dxfentity := Insert_.Create( WCS_Z, p1, aPoint3D( Sx, Sy, 1 ), SymbolTool.Rotangle,
            AcadColorFromColor(clWhite), 0, @atts[0], s );
          //Insert_(dxfentity).scale:=aPoint3D(Sx,Sy,0);
        End;
      idPolyline, idPolygon:
        Begin
          { includes multi-part polygons }
          n := 0;
          If Ent.Points.Parts.Count < 2 Then
          Begin
            Idx1 := 0;
            Idx2 := Ent.Points.Count - 1;
          End
          Else
          Begin
            Idx1 := Ent.Points.Parts[n];
            Idx2 := Ent.Points.Parts[n + 1] - 1;
          End;
          Repeat
            For cnt := Idx1 To Idx2 Do
            Begin
              tempvert[cnt-Idx1] := aPoint3D( Ent.Points[cnt].X, Ent.Points[cnt].Y, 0 );
            End;
            dxfentity := Polyline_.Create( WCS_Z, Succ( Idx2 - Idx1 ),
              @tempvert, ACADColorFromColor( TEzOpenedEntity( Ent ).PenTool.Color ),
              ( Ent.EntityID = idPolygon ), TEzOpenedEntity( Ent ).PenTool.Style );
            entlist.Add( dxfentity );
            If Ent.Points.Parts.Count < 2 Then Break;
            Inc( n );
            If n >= Ent.Points.Parts.Count Then Break;
            Idx1 := Ent.Points.Parts[n];
            If n < Ent.Points.Parts.Count - 1 Then
              Idx2 := Ent.Points.Parts[n + 1] - 1
            Else
              Idx2 := Ent.Points.Count - 1;
          Until False;
          process:= false;
        End;
      idArc, idRectangle, idEllipse:
        Begin
          For I := 0 To Ent.DrawPoints.Count - 1 Do
            tempvert[I] := aPoint3D( Ent.DrawPoints[I].X, Ent.DrawPoints[I].Y, 0 );
          dxfentity := Polyline_.Create( WCS_Z, Ent.DrawPoints.Count,
            @tempvert, ACADColorFromColor( TEzOpenedEntity( Ent ).PenTool.Color ),
            ( Ent.EntityID In [idPolygon, idRectangle, idEllipse] ), TEzOpenedEntity( Ent ).PenTool.Style );
        End;
      idTrueTypeText:
        With TEzTrueTypeText( Ent ) Do
        begin
          dxfentity := Text_.Create( WCS_Z,
            aPoint3D( Points[0].X, Points[0].Y - Dist2D( Points[0], Points[1] ), 0 ),
            Origin3D, FontTool.Angle, Text,  '',
            Dist2D( Points[0], Points[1] ),
            ACADColorFromColor( FontTool.Color ), 0 );
        end;
      idFittedVectText:
        With TEzFittedVectorText( Ent ) Do
        Begin
          dxfentity := Text_.Create( WCS_Z, aPoint3D( Points[0].X, Points[0].Y, 0 ),
            Origin3D, DegToRad( Angle ), Text, '', Dist2D( Points[0], Points[1] ),
            ACADColorFromColor( FontColor ), 0 );
        End;
      idJustifVectText:
        With TEzJustifVectorText( Ent ) Do
        Begin
          dxfentity := Text_.Create( WCS_Z, aPoint3D( Points[0].X, Points[0].Y, 0 ),
            Origin3D, DegToRad( Angle ), Text, '', Dist2D( Points[0], Points[1] ),
            ACADColorFromColor( FontColor ), 0 );
        End;
    Else
      process := false;
    End;

    If process Then
      entlist.Add( dxfentity );
  End;

Begin
  result := false;
  If FDrawBox = Nil Then
    EzGISError( SWrongEzGIS );

  TmpVp := FDrawBox;
  FDXF_Main := DXF_Object.Create( Self, FFileName );
  If ( AcadColorPal = Nil ) Then
    AcadColorPal := TAcadColorPal.Create;
  If ( AcadLineStyle = Nil ) Then
    AcadLineStyle := TAcadLineStyle.Create;

  // check if export of symbols is needed
  ExpSymbolList:= TBits.Create;
  Found:= False;
  For I := 0 To FLayerNames.Count - 1 Do
  Begin
    layer := TmpVp.GIS.Layers.LayerByName( FLayerNames[I] );
    If layer = Nil Then Continue;
    Layer.First;
    Layer.StartBuffering;
    Try
      While Not Layer.Eof Do
      Begin
        If Layer.RecIsDeleted Then
        Begin
          Layer.Next;
          Continue;
        End;
        If Layer.RecEntityID = idPlace then
        begin
          entity:= Layer.RecLoadEntity;
          if entity <> nil then
            try
              with (entity as TEzPlace) do
                if SymbolTool.Index >= 0 then
                begin
                  ExpSymbolList[SymbolTool.Index] := True;
                  Found:= True;
                end;
            finally
              entity.free;
            end;
        end;
        Layer.Next;
      End;
    Finally
      layer.EndBuffering;
    End;
  end;

  Screen.Cursor := crHourglass;
  SymbolNames:= TStringList.Create;
  Try
    If Found then
    begin
      // first generate a layer of blocks (coming from symbols of GIS)
      blocklayer := FDXF_Main.new_layer( 'Block_', false );
      // Generate block headers (from TEzBaseGIS symbols)
      For I := 0 To Ez_Symbols.Count - 1 Do
      Begin
        If (I > ExpSymbolList.Size-1) Or Not ExpSymbolList[I] then Continue;
        Symbol := Ez_Symbols[I];

        S := Trim( Symbol.Name );
        s := StringReplace( s, #32, '', [rfReplaceAll] );
        If Length( S ) = 0 Then
          S := Format(SSymbolCaption, [I] );
        while SymbolNames.IndexOf( S ) >= 0 do
        begin
          s := 'A' + s;
        end;
        SymbolNames.Add( S );
        // Create new block
        block := Block_.Create( s, Origin3D );
        blocklayer.add_entity_to_layer( block );

        // generate the entities of the block here
        For J := 0 To Symbol.Count - 1 Do
          AddGEntityToEntityList( block.entities, Symbol.Entities[J] );
      End;
    End;

    // now generate all requested layers
    For I := 0 To FLayerNames.Count - 1 Do
    Begin
      layer := TmpVp.GIS.Layers.LayerByName( FLayerNames[I] );
      If layer = Nil Then
        Continue;
      dxflayer := FDXF_Main.new_layer( layer.Name, false );
      //nEntities:= layer.RecordCount;

      Layer.First;
      Layer.StartBuffering;
      Try
        While Not Layer.Eof Do
        Begin
          If Layer.RecIsDeleted Then
          Begin
            Layer.Next;
            Continue;
          End;
          //Inc(J);
          //MyDlg.Label3.Caption := inttostr(J)+' Objects Created.';
          //MyDlg.ProgressBar1.Position := J;
          //MyDlg.Update ;
          Entity := Layer.RecLoadEntity;
          If Entity <> Nil Then
          Begin
            AddGEntityToEntityList( dxflayer.entities, Entity );
            Entity.Free;