dxf_stru.pas

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

///////////////////////////////////////////////////////////////////////////////
//                                                                           //
//                       DXF Objects/Entities/Layers etc                     //
//                             ㎎ohn Biddiscombe                             //
//                      Rutherford Appleton Laboratory, UK                   //
//                           [e-mail]                          //
//                       DXF code release 3.0 - July 1997                    //
//                                                                           //
///////////////////////////////////////////////////////////////////////////////
unit DXF_structs;

interface

uses
  { Borland }
  Windows,Classes,Graphics,SysUtils,Dialogs,Math,DXF_Utils,
  { Mine }
  Thinkbox;
///////////////////////////////////////////////////////////////////////////////
// Useful definitions
///////////////////////////////////////////////////////////////////////////////
const
  max_vertices_per_polyline = 8192; // AutoCAD places a limit on this, but
  max_attribs               = 16;   // I don't know what it is...
  max_my_attribs            = 16;

type
  file_type = (off,geo,pslg);

type
  polyface = record
    nf : array[0..3] of integer;
  end;

  pfacelist = ^facelist;
  facelist  = array[0..0] of polyface;

  pintlist = ^intlist;
  intlist  = array[0..0] of integer;

  pattrlist = ^attrlist;
  attrlist  = array[0..0] of double;

// note the addition of base and scale factor for drawing blocks
type
  coord_convert = function(P:Point3D; OCS:pMatrix) : TPoint of Object;

type
  planar_eq = record
    a,b,c,d : double;
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Entity - abstract base class - override where neccessary
// All DXF objects will become sub classes of this
///////////////////////////////////////////////////////////////////////////////
type
  DXF_Entity = class
    colour   : TColor;
    colinx   : integer;
    OCS_WCS  : pMatrix;
    OCS_axis : Point3D;
    constructor create;
    destructor  destroy;                                                override;
    procedure   init_OCS_WCS_matrix(OCSaxis:Point3D);                   virtual;
    procedure   update_block_links(blist:TObject);                      virtual; abstract;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);    virtual; abstract;
    procedure   DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);    virtual; abstract;
    procedure   setcolour_index(col:integer);                           virtual;
    procedure   setcolour(col:TColor);                                  virtual;
    procedure   translate(T:Point3D);                                   virtual; abstract;
    procedure   quantize_coords(epsilon:double; mask:byte);             virtual; abstract;
    function    count_points       : integer;                           virtual;
    function    count_lines        : integer;                           virtual;
    function    count_polys_open   : integer;                           virtual;
    function    count_polys_closed : integer;                           virtual;
    function    proper_name        : string;                            virtual;
    procedure   write_DXF_Point(var IO:textfile; n:integer; p:Point3D); virtual;
    procedure   write_to_DXF(var IO:textfile; layer:string);            virtual;
    function    details : string;                                       virtual; abstract;
    procedure   max_min_extents(var emax,emin:Point3D);                 virtual; abstract;
    function    closest_vertex_square_distance_2D(p:Point3D) : double;  virtual; abstract;
    function    closest_vertex(p:Point3D) : Point3D;                    virtual; abstract;
    function    is_point_inside_object2D(p:Point3D) : boolean;          virtual;
    function    Move_point(p,newpoint:Point3D) : boolean;               virtual;
  end;
///////////////////////////////////////////////////////////////////////////////
// Block_ Definition - special case - not to be used like other entities
// Blocks should always appear in layer '0'
// I'm still not quite sure what to do with them - but here goes anyway...
///////////////////////////////////////////////////////////////////////////////
type
  Block_ = class(DXF_Entity)
    name       : string;
    basepoint  : Point3D;
    entities   : TList;
    constructor create(bname:string; refpoint:Point3D);
    destructor  destroy; override;
    procedure   update_block_links(blist:TObject);                      override;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    function    details : string;                                       override;
    procedure   write_to_DXF(var IO:textfile; layer:string);            override;
    procedure   max_min_extents(var emax,emin:Point3D);                 override;
    function    closest_vertex_square_distance_2D(p:Point3D) : double;  override;
    function    closest_vertex(p:Point3D) : Point3D;                    override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Point Definition
///////////////////////////////////////////////////////////////////////////////
type
  Point_ = class(DXF_Entity) // always WCS
    p1 : Point3D;
    constructor create(OCSaxis,p:Point3D; col:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   translate(T:Point3D);                                  override;
    procedure   quantize_coords(epsilon:double; mask:byte);            override;
    function    details : string;                                      override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    procedure   max_min_extents(var emax,emin:Point3D);                override;
    function    closest_vertex_square_distance_2D(p:Point3D) : double; override;
    function    closest_vertex(p:Point3D) : Point3D;                   override;
    function    Move_point(p,newpoint:Point3D) : boolean;              override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Text Definition
///////////////////////////////////////////////////////////////////////////////
type
  Text_ = class(Point_) // always OCS
    h         : double;
    textstr   : string;
    align_pt  : Point3D; // alignment point
    hor_align : integer; // horizontal justification code
    constructor create(OCSaxis,p,ap:Point3D; ss:string; height:double; col,ha:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
    function    details : string;                                override;
    procedure   write_to_DXF(var IO:textfile; layer:string);     override;
    procedure   max_min_extents(var emax,emin:Point3D);          override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Attrib Definition
///////////////////////////////////////////////////////////////////////////////
type
  Attrib_ = class(Text_) // always OCS
    tagstr  : string;
    visible : boolean;
    constructor create(OCSaxis,p,ap:Point3D; ss,tag:string; flag70,flag72:integer; height:double; col:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    function    details : string;                                override;
    procedure   write_to_DXF(var IO:textfile; layer:string);     override;
  end;
type
  patt_array = ^att_array;
  att_array  = array[0..0] of Attrib_;
///////////////////////////////////////////////////////////////////////////////
// Attdef Definition
///////////////////////////////////////////////////////////////////////////////
type
  Attdef_ = class(Attrib_) // always OCS
    promptstr : string;
    constructor create(OCSaxis,p,ap:Point3D; ss,tag,prompt:string; flag70,flag72:integer; height:double; col:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   write_to_DXF(var IO:textfile; layer:string);     override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Insert Definition (optionally contains attribs)
///////////////////////////////////////////////////////////////////////////////
type
  Insert_ = class(Point_) // always OCS
    num_attribs   : integer;
    attribs       : array[0..max_attribs] of Attrib_;
    blockname     : string;
    scale         : Point3D;
    rotation      : double;
    blockptr      : Block_;  // use carefully
    blocklist     : TObject; // to cross reference the blocks
    constructor create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string);
    destructor  destroy;                                     override;
    procedure   init_OCS_WCS_matrix(OCSaxis:Point3D);        override;
    procedure   update_block_links(blist:TObject);           override;
    function    block : Block_;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    function    details : string;                            override;
    procedure   write_to_DXF(var IO:textfile; layer:string); override;
    procedure   max_min_extents(var emax,emin:Point3D);      override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Line Definition
///////////////////////////////////////////////////////////////////////////////
type
  Line_ = class(Point_) // always WCS
    p2 : Point3D;
    constructor create(p_1,p_2:Point3D; col:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   translate(T:Point3D);                                  override;
    procedure   quantize_coords(epsilon:double; mask:byte);            override;
    function    count_points   : integer;                              override;
    function    count_lines    : integer;                              override;
    function    details : string;                                      override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    procedure   max_min_extents(var emax,emin:Point3D);                override;
    function    closest_vertex_square_distance_2D(p:Point3D) : double; override;
    function    closest_vertex(p:Point3D) : Point3D;                   override;
    function    Move_point(p,newpoint:Point3D) : boolean;              override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Circle Definition
///////////////////////////////////////////////////////////////////////////////
type
  Circle_ = class(Point_) // always OCS
    radius : double;
    constructor create(OCSaxis,p_1:Point3D; radius_:double; col:integer);
    constructor create_from_polyline(ent1:DXF_Entity);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    function    details : string;                                override;
    procedure   write_to_DXF(var IO:textfile; layer:string);     override;
    function    is_point_inside_object2D(p:Point3D) : boolean;   override;
    procedure   max_min_extents(var emax,emin:Point3D);          override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Arc Definition
///////////////////////////////////////////////////////////////////////////////
type
  Arc_ = class(Circle_)  // always OCS
    angle1,angle2 : double;
    constructor create(OCSaxis,p_1:Point3D; radius_,sa,ea:double; col:integer);
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    function    details : string;                                override;
    procedure   write_to_DXF(var IO:textfile; layer:string);     override;
    function    is_point_inside_object2D(p:Point3D) : boolean;   override;
    procedure   max_min_extents(var emax,emin:Point3D);          override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Polyline Definition
///////////////////////////////////////////////////////////////////////////////
type
  Polyline_ = class(DXF_Entity) // OCS/WCS depends
    closed      : boolean;
    numvertices : integer;
    polypoints  : ppointlist;
    numattrs    : integer;
    attribs     : array[0..max_my_attribs-1] of double;
    constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
    destructor  destroy;                                               override;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
    procedure   translate(T:Point3D);                                  override;
    procedure   quantize_coords(epsilon:double; mask:byte);            override;
    function    count_points   : integer;                              override;
    function    count_lines    : integer;                              override;
    function    count_polys_open   : integer;                          override;
    function    count_polys_closed : integer;                          override;
    function    details : string;                                      override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    procedure   max_min_extents(var emax,emin:Point3D);                override;
    function    closest_vertex_square_distance_2D(p:Point3D) : double; override;
    function    closest_vertex(p:Point3D) : Point3D;                   override;
    // some functions I use...most removed....
    function    Move_point(p,newpoint:Point3D) : boolean;              override;
    function    is_point_inside_object2D(p:Point3D) : boolean;         override;
    function    triangle_centre : Point3D;
    procedure   set_attrib(i:integer; v:double);
    function    get_attrib(i:integer) : double;
    procedure   copy_attribs(p:Polyline_);
  end;
///////////////////////////////////////////////////////////////////////////////
// Face3D_ Definition - Should be 3DFace but can't name a type starting with 3
///////////////////////////////////////////////////////////////////////////////
type
  Face3D_ = class(Polyline_) // always WCS
    constructor create(numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
    function    proper_name : string; override; // save as 3DFACE not Face3D
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Solid_ Definition
///////////////////////////////////////////////////////////////////////////////
type
  Solid_ = class(Face3D_) // always OCS
    thickness : double;
    constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
    function    proper_name : string;                                  override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    function    details : string;                                      override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh) Definition
///////////////////////////////////////////////////////////////////////////////
type
  Polygon_mesh_ = class(Polyline_) // always WCS ???
    M,N           : integer;
    closeM,closeN : boolean;
    constructor create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
    function    proper_name : string;                                  override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    function    details : string;                                      override;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh) Definition
///////////////////////////////////////////////////////////////////////////////
type
  Polyface_mesh_ = class(Polyline_) // always WCS ???
    numfaces   : integer;
    facelist   : pfacelist;
    constructor create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
    destructor  destroy;                                               override;
    function    proper_name : string;                                  override;
    procedure   write_to_DXF(var IO:textfile; layer:string);           override;
    function    details : string;                                      override;
    procedure   Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class definition
// An entity list is a collection of entities (in this case all the same type)
// I wanted to keep polylines & lines etc in separate lists, so the DXF_Layer
// will automatically handle this.
///////////////////////////////////////////////////////////////////////////////
type
  DXF_Layer   = class;

  Entity_List = class
  private
    function    add_at_end(entity:DXF_Entity) : boolean;
    function    insert(entity:DXF_Entity) : boolean;
  public
    list_name      : string;
    parent_layer   : DXF_Layer;
    Kludge_layer   : DXF_Layer; // see selection.save...
    entities       : TList;
    sorted         : boolean;
    constructor create(l_name:string);
    destructor  destroy; override;
    property    name : string read list_name write list_name;
    function    add_entity_to_list(entity:DXF_Entity) : boolean;
    function    remove_entity(ent:DXF_Entity) : boolean;
    procedure   draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
    procedure   draw_vertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
    function    num_entities : integer;
    function    count_points   : integer;
    function    count_lines    : integer;
    function    count_polys_open   : integer;
    function    count_polys_closed : integer;
    procedure   max_min_extents(var emax,emin:Point3D);
    procedure   setcolour(col:integer);
    function    closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
    function    find_bounding_object(p:Point3D) : DXF_Entity;
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF_layer class definition
// A collection of entity lists. One for each type.
///////////////////////////////////////////////////////////////////////////////
  DXF_Layer  = class
    layer_name   : string;
    layer_colinx : integer;
    entity_names : TStringList;
    entity_lists : TList;