⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezdxfimport.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
          End;

          Layer.Next;
        End;
      Finally
        Layer.EndBuffering;
      End;
    End;
    // write the file
    FDXF_Main.save_to_file( FFileName );
  Finally
    If ( AcadColorPal <> Nil ) Then
      FreeAndNil( AcadColorPal );
    If ( AcadLineStyle <> Nil ) Then
      FreeAndNil( AcadLineStyle );
    SymbolNames.Free;

    ExpSymbolList.Free;

    Screen.Cursor := crDefault;
  End;
End;

{$IFDEF BCB}
function TEzDxfExport.GetLayerNames: TStrings;
begin
  Result := FLayerNames;
end;
{$ENDIF}

Procedure TEzDxfExport.SetLayerNames( Const Value: TStrings );
Begin
  FLayerNames.Assign( Value );
End;

{Procedure ImportVector( DxfImport: TEzDxfImport; Vect: TEzVector );
Var
  cnt: integer;
Begin
  For cnt := 0 To Vect.Count - 1 Do
    Vect[cnt] := DxfImport.Converter.Convert( Vect[cnt] );
End; }

///////////////////////////////////////////////////////////////////////////////
// DXF_Entity - abstract base class - override where neccessary
///////////////////////////////////////////////////////////////////////////////

{Constructor DXF_Entity.Create;
Begin
  inherited Create;
End; }

Destructor DXF_Entity.Destroy;
Begin
  If OCS_WCS <> Nil Then
    deallocate_matrix( OCS_WCS );
  Inherited Destroy;
End;

Procedure DXF_Entity.AddToGIS( DxfImport: TEzDxfImport; OCS: pM );
Begin
End;

Procedure DXF_Entity.update_block_links( blist: TObject );
Begin
End;

Procedure DXF_Entity.translate( T: Point3D );
Begin
End;

Procedure DXF_Entity.quantize_coords( epsilon: Double; mask: byte );
Begin
End;

Procedure DXF_Entity.max_min_extents( Var emax, emin: Point3D );
Begin
End;

Function DXF_Entity.closest_vertex_square_distance_2D( p: Point3D ): Double;
Begin
  result := 0;
End;

Function DXF_Entity.closest_vertex( p: Point3D ): Point3D;
Begin
  result := p;
End;

Procedure DXF_Entity.init_OCS_WCS_matrix( OCSaxis: Point3D );
Var
  Ax, Ay: Point3D;
Begin
  OCS_axis := OCSaxis;
  If Not p1_eq_p2_3D( OCSaxis, WCS_Z ) Then
  Begin
    OCS_WCS := allocate_matrix;
    If ( abs( OCSaxis.x ) < 1 / 64 ) And ( abs( OCSaxis.y ) < 1 / 64 ) Then
      Ax := normalize( cross( WCS_Y, OCSaxis ) )
    Else
      Ax := normalize( cross( WCS_Z, OCSaxis ) );
    Ay := normalize( cross( OCSaxis, Ax ) );
    OCS_WCS^ := CreateTransformation( Ax, Ay, OCSaxis );
  End;
End;

Procedure DXF_Entity.setcolour_index( col: integer );
Begin
  colinx := col;
  //colour:= DXF_Layer_Colours[col mod (def_cols+1)];
  // Added for GIS
  colour := AcadColorPal[col];
  //  colour := Colormap[col mod (256+1)];
  //  colour := colormap[col];
  {  if col>def_cols then
      colour := colormap[col]
    else
    colour := DXF_Layer_Colours[col mod (def_cols+1)];}
End;

Procedure DXF_Entity.setcolour( col: TColor );
Var
  lp1: integer;
Begin
  colinx := 0;
  For lp1 := 0 To 255 Do
    //if Dxf_layer_Colours[lp1]=col then begin
    // Added for GIS
    If AcadColorPal[lp1] = col Then
    Begin
      colinx := lp1;
      break;
    End;
  colour := col;
End;

Function DXF_Entity.count_points: integer;
Begin
  result := 1;
End;

Function DXF_Entity.count_lines: integer;
Begin
  result := 0;
End;

Function DXF_Entity.count_polys_open: integer;
Begin
  result := 0;
End;

Function DXF_Entity.count_polys_closed: integer;
Begin
  result := 0;
End;

Function DXF_Entity.proper_name: String;
Var
  temp: String;
Begin
  temp := AnsiUpperCase( ClassName );
  result := Copy( temp, 1, Length( temp ) - 1 );
End;

Procedure DXF_Entity.write_DXF_Point( Var IO: textfile; n: integer; p: Point3D );
Begin
  writeln( IO, n, EOL, float_out( p.x ) );
  writeln( IO, n + 10, EOL, float_out( p.y ) );
  writeln( IO, n + 20, EOL, float_out( p.z ) );
End;

Procedure DXF_Entity.write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: integer );
Begin
  writeln( IO, 0, EOL, proper_name );
  // AcadrR14
  // Write_handle(io);

  writeln( IO, 8, EOL, layer );
  // Check Entity's Color
  // if not defined Bylayer's color, uses entity color
  If Lcolor <> colinx Then
    writeln( IO, 62, EOL, colinx );
  If OCS_WCS <> Nil Then
    write_DXF_Point( IO, 210, OCS_axis );
End;

Function DXF_Entity.is_point_inside_object2D( p: Point3D ): boolean;
Begin
  result := false;
End;

Function DXF_Entity.Move_point( const p, newpoint: Point3D ): boolean;
Begin
  result := false;
End;

///////////////////////////////////////////////////////////////////////////////
// Block_ class implementation
///////////////////////////////////////////////////////////////////////////////

Constructor Block_.Create( Const bname: String; refpoint: Point3D );
Begin
  entities := TList.Create;
  basepoint := refpoint;
  If Not p1_eq_p2_3D( basepoint, origin3D ) Then
  Begin
    OCS_WCS := allocate_matrix;
    OCS_WCS^ := TranslateMatrix( p1_minus_p2( origin3D, basepoint ) );
  End;
  name := bname;
End;

Destructor Block_.Destroy;
Var
  lp1: integer;
Begin
  For lp1 := 0 To entities.count - 1 Do
    DXF_Entity( entities[lp1] ).free;
  entities.Free;
End;

Procedure Block_.update_block_links( blist: TObject );
Var
  lp1: integer;
Begin
  For lp1 := 0 To entities.count - 1 Do
    If ( TObject( entities[lp1] ) Is Insert_ ) Then
      Insert_( entities[lp1] ).update_block_links( blist );
End;

// Added for GIS

Procedure Block_.AddToGIS( DxfImport: TEzDxfImport; OCS: pM );
Var
  lp1: integer;
  t_matrix: pMatrix;
  TempMatrix: Matrix;
Begin
  If OCS = Nil Then
    t_matrix := OCS_WCS
  Else If OCS_WCS = Nil Then
    t_matrix := OCS
  Else
  Begin
    TempMatrix := MatrixMultiply( OCS_WCS^, OCS^ );
    t_matrix := @TempMatrix;
  End;
  For lp1 := 0 To entities.count - 1 Do
  Begin
    Try
      DXF_Entity( entities[lp1] ).AddToGIS( DxfImport, t_matrix );
    Except
    End;
  End;
End;

Procedure Block_.setcolour( col: TColor );
(*var lp1        : integer;
   TempMatrix : Matrix; *)
Begin
  (*for lp1:=0 to entities.count-1 do
     DXF_Entity(entities[lp1]).Setcolour(col); *)
End;

Procedure Block_.write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: Integer );
Var
  lp1: integer;
Begin
  writeln( IO, 0, EOL, proper_name );
  writeln( IO, 8, EOL, layer );
  writeln( IO, 2, EOL, name );
  writeln( IO, 70, EOL, 0 );
  write_DXF_Point( IO, 10, basepoint );
  //  writeln(IO,3 ,EOL,name);
  For lp1 := 0 To entities.count - 1 Do
    DXF_Entity( entities[lp1] ).write_to_DXF( IO, layer, lcolor );
  writeln( IO, 0, EOL, 'ENDBLK' );

  // AcadR14
  //  Write_handle(io);
  //  writeln(IO,8 ,EOL,layer);
End;

Procedure Block_.max_min_extents( Var emax, emin: Point3D );
Var
  lp1: integer;
Begin
  For lp1 := 0 To ( entities.Count - 1 ) Do
    DXF_Entity( entities[lp1] ).max_min_extents( emax, emin );
End;

Function Block_.closest_vertex_square_distance_2D( p: Point3D ): Double;
Begin
  result := 1E9;
End;

Function Block_.closest_vertex( p: Point3D ): Point3D;
Begin
  result := aPoint3D( 1E9, 1E9, 1E9 );
End;

///////////////////////////////////////////////////////////////////////////////
// Point
///////////////////////////////////////////////////////////////////////////////

Constructor Point_.Create( OCSaxis, p: Point3D; col: integer );
Begin
  Inherited Create;
  p1 := p;
  setcolour_index( col );
  init_OCS_WCS_matrix( OCSaxis );
End;

Procedure Point_.translate( T: Point3D );
Begin
  p1 := p1_plus_p2( p1, T );
End;

Procedure Point_.quantize_coords( epsilon: Double; mask: byte );
Begin
  If ( mask And 1 ) = 1 Then
    p1.x := round( p1.x * epsilon ) / epsilon;
  If ( mask And 2 ) = 2 Then
    p1.y := round( p1.y * epsilon ) / epsilon;
  If ( mask And 4 ) = 4 Then
    p1.z := round( p1.z * epsilon ) / epsilon;
End;

// Added for GIS
{transform the point}

Function original_transformed2D( P: Point3D; OCS: pMatrix ): TEzPoint;
Var
  p1: Point3D;
Begin
  If OCS = Nil Then
  Begin
    result.x := P.x;
    result.y := P.y;
  End
  Else
  Begin
    p1 := TransformPoint( OCS^, P );
    result.x := p1.x;
    result.y := p1.y;
  End;
End;

// Added for GIS

Procedure Point_.AddToGIS( DxfImport: TEzDxfImport; OCS: pM );
Var
  t_matrix: pMatrix;
  Entity2D: TEzEntity;
Begin
  //t_matrix := update_transformations(OCS_WCS,OCS);
  // this is not imported (for now)

  t_matrix := update_transformations( OCS_WCS, OCS );
  Entity2D := TEzPointEntity.CreateEntity( original_transformed2D( p1, t_matrix ), colour );
  //ImportVector( DxfImport, Entity2D.Points );

  DxfImport.FCad.CurrentLayer.AddEntity( Entity2D );
  FreeAndNil( Entity2D );
End;

Procedure Point_.write_to_DXF( Var IO: textfile; Const layer: String; Lcolor: Integer );
Begin
  Inherited;
  write_DXF_Point( IO, 10, p1 );
End;

Procedure Point_.max_min_extents( Var emax, emin: Point3D );
Begin
  max_bound( emax, p1 );
  min_bound( emin, p1 );
End;

Function Point_.closest_vertex_square_distance_2D( p: Point3D ): Double;
Begin
  result := sq_dist2D( p1, p );
End;

Function Point_.closest_vertex( p: Point3D ): Point3D;
Begin
  result := p1;
End;

Function Point_.Move_point( const p, newpoint: Point3D ): boolean;
Begin
  If p1_eq_p2_3D( p1, p ) Then
  Begin
    p1 := newpoint;
    result := True;
  End
  Else
    result := false;
End;

//////////////////////////////

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -