dxf_stru.pas

一个比较完整的读写dxf文件的DELPHI程序

    constructor create(l_name:string);
    destructor  destroy; override;
    procedure   delete(aname:string; releasemem:boolean);
    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;
    // Add a pre filled list (save selected to file... see selected lists)
    procedure   add_entity_list(elist:Entity_List);
    // utilities
    function    num_lists : integer;
    procedure   max_min_extents(var emax,emin:Point3D);
    function    create_or_find_list_type(aname:string) : Entity_List;
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Object class definition
// A Collection of DXF_Layers - eg a whole DXF file.
///////////////////////////////////////////////////////////////////////////////
type
  DXF_Object  = class
    DXF_name     : string;
    layer_lists  : TList;
    emax         : Point3D;
    emin         : Point3D;
    // Create an empty object
    constructor create(aname:string);
    // Create an object and load from file
    constructor create_from_file(aname:string; skipped:Tstrings);
    destructor  destroy; override;
    procedure   save_to_file(aname:string);
    property    name : string read DXF_name write DXF_name;
    function    num_layers : integer;
    // add an empty layer
    function    new_layer(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(aname:string) : DXF_Layer;
    // add an entity to a named layer
    function    add_entity_to_layer(entity:DXF_Entity; aname:string) : boolean;
    // return layer and create if neccessary
    function    create_or_find_layer(aname:string) : DXF_Layer;
    // Add a second DXF file to this one
    function    merge_files(DXF_:DXF_Object) : boolean;
    // Useful ones
    procedure   remove_empty_layers_and_lists;
    procedure   copy_to_strings(ts:TStrings);
    function    get_min_extent         : Point3D;
    function    get_max_extent         : Point3D;
    // update the extents (not really needed)
    procedure   max_min_extents(var emax,emin:Point3D);
  end;
///////////////////////////////////////////////////////////////////////////////
// Selection_lists class definition
// A collection of entity lists. Used by mouse selection routines
///////////////////////////////////////////////////////////////////////////////
type
  selection_lists = class
    entity_lists : TList;
    constructor create;
    destructor  destroy; override;
    procedure   save_to_DXF_file(aname:string);
    function    find_closest_2D_point(p:Point3D; var ent:DXF_Entity) : Point3D;
    function    is_inside_object(p:Point3D; var ent:DXF_Entity) : Point3D;
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF exceptions will be this type
///////////////////////////////////////////////////////////////////////////////
type
  DXF_exception = class(Exception);
///////////////////////////////////////////////////////////////////////////////
// Default AutoCad layer colours (1..7) - (8..user defined)
///////////////////////////////////////////////////////////////////////////////
const
  BYLAYER = 256;
const
  def_cols = 12;
  DXF_Layer_Colours : array[0..def_cols] of TColor = (clBlack, // zero - not used
    clRed,    clYellow, clLime,   clAqua,   clBlue,   clPurple, {clWhite}clBlack,
    clOlive,  clFuchsia,clTeal,   clGray,   clDkGray);
///////////////////////////////////////////////////////////////////////////////
// Memory check variables
///////////////////////////////////////////////////////////////////////////////
var
  entities_in_existence  : integer;
  Ent_lists_in_existence : integer;
  layers_in_existence    : integer;
  DXF_Obj_in_existence   : integer;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// implementation
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
implementation

uses
  DXF_read, DXF_write;

procedure draw_cross(acanvas:TCanvas; p1:TPoint);
var pa,pb : TPoint;
begin
  pa.x := p1.x-2; pa.y := p1.y-2;
  pb.x := p1.x+3; pb.y := p1.y+3;
  acanvas.Moveto(pa.x,pa.y);
  acanvas.Lineto(pb.x,pb.y);
  pa.x := p1.x-2; pa.y := p1.y+2;
  pb.x := p1.x+3; pb.y := p1.y-3;
  acanvas.Moveto(pa.x,pa.y);
  acanvas.Lineto(pb.x,pb.y);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Entity - abstract base class - override where neccessary
///////////////////////////////////////////////////////////////////////////////
constructor DXF_Entity.create;
begin
  inc(entities_in_existence);
end;

destructor DXF_Entity.destroy;
begin
  if OCS_WCS<>nil then deallocate_matrix(OCS_WCS);
  dec(entities_in_existence);
  inherited destroy;
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)];
end;

procedure DXF_Entity.setcolour(col:TColor);
var lp1 : integer;
begin
  colinx := 0;
  for lp1:=0 to def_cols do if DXF_Layer_Colours[lp1]=col then colinx := lp1;
  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 := UpperCase(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; layer:string);
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  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(p,newpoint:Point3D) : boolean;
begin
  result := false;
end;

///////////////////////////////////////////////////////////////////////////////
// Block_ class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Block_.create(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;

procedure Block_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1        : integer;
    t_matrix   : pMatrix;
    TempMatrix : Matrix;
begin
  // we mustn't use the update_transformations call because blocks may be
  // nested inside blocks inside other blocks, and update_transformations uses
  // a temp fixed matrix which will be overwritten.
  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
    DXF_Entity(entities[lp1]).draw(acanvas,map_fn,t_matrix);
end;

procedure Block_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1 : integer;
begin
  for lp1:=0 to entities.count-1 do
    DXF_Entity(entities[lp1]).drawvertices(acanvas,map_fn,OCS);
end;

function Block_.details : string;
var lp1 : integer;
begin
  result := 'Name :'#9 + name + EOL +
            'Base :'#9 + Point3DToStr(basepoint);
  for lp1:=0 to entities.count-1 do result := result + EOL + EOL + DXF_Entity(entities[lp1]).details;
end;

procedure Block_.write_to_DXF(var IO:textfile; layer:string);
var lp1 : integer;
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  writeln(IO,2 ,EOL,name);
  write_DXF_Point(IO,10,basepoint);
  for lp1:=0 to entities.count-1 do DXF_Entity(entities[lp1]).write_to_DXF(IO,layer);
  writeln(IO,0 ,EOL,'ENDBLK');
end;

procedure Block_.max_min_extents(var emax,emin:Point3D);
begin 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_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po       : TPoint;
    t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  po := map_fn(p1,t_matrix);
  draw_cross(acanvas,po);
end;

procedure Point_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po       : TPoint;
    t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  po := map_fn(p1,t_matrix);
  draw_cross(acanvas,po);
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;

function Point_.details : string;
var t : string;
begin
  if OCS_WCS<>nil then t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else t := 'WCS';
  result := ClassName + EOL + t + EOL + Point3DToStr(p1);
end;

procedure Point_.write_to_DXF(var IO:textfile; layer:string);
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(p,newpoint:Point3D) : boolean;
begin
  if p1_eq_p2_3D(p1,p) then begin
    p1 := newpoint;
    result := true;
  end else result := false;
end;

///////////////////////////////////////////////////////////////////////////////
// Text
///////////////////////////////////////////////////////////////////////////////
constructor Text_.create(OCSaxis,p,ap:Point3D; ss:string; height:double; col,ha:integer);
begin