unit U_DXFEngineSCS;

interface

uses
  Windows,SysUtils,StdCtrls,ComCtrls,Dialogs,Classes,Graphics,math,PCDrawing,
  PCTypesUtils, U_Cad, U_Common, DrawObjects, U_BaseCommon, FastStrings;

const
  message_delay_ms = 15;
  EOL = #13#10;

const
  DXF_start = 0;
  DXF_text_def = 1;
  DXF_name = 2;
  DXF_text_prompt = 3;
  DXF_othername2 = 4;
  DXF_entity_handle = 5;
  DXF_line_type = 6;
  DXF_text_style = 7;
  DXF_layer_name = 8;
  DXF_var_name = 9;
  DXF_primary_X = 10;
  DXF_primary_Y = 20;
  DXF_primary_Z = 30;
  DXF_other_X_1 = 11;
  DXF_other_Y_1 = 21;
  DXF_other_Z_1 = 31;
  DXF_other_X_2 = 12;
  DXF_other_Y_2 = 22;
  DXF_other_Z_2 = 32;
  DXF_other_X_3 = 13;
  DXF_other_Y_3 = 23;
  DXF_other_Z_3 = 33;
  DXF_elevation = 38;
  DXF_thickness = 39;
  DXF_floatval = 40;
  DXF_floatvals1 = 41;
  DXF_floatvals2 = 42;
  DXF_floatvals3 = 43;
  DXF_repeat = 49;
  DXF_angle1 = 50;
  DXF_angle2 = 51;
  DXF_angle3 = 52;
  DXF_angle4 = 53;
  DXF_angle5 = 54;
  DXF_angle6 = 55;
  DXF_angle7 = 56;
  DXF_angle8 = 57;
  DXF_angle9 = 58;
  DXF_visible = 60;
  DXF_colornum = 62;
  DXF_entities_flg = 66;
  DXF_ent_ident = 67;
  DXF_view_state = 69;
  DXF_70Flag = 70;
  DXF_71Flag = 71;
  DXF_72Flag = 72;
  DXF_73Flag = 73;
  DXF_74Flag = 74;
  DXF_extrusionx = 210;
  DXF_extrusiony = 220;
  DXF_extrusionz = 230;
  DXF_comment = 999;
  DXFtoPC = 1;


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;

type
  Point3D = record
    x,y,z : double;
  end;

  Point2D = record
    x,y : Double;
  end;

  PPoint3D   = ^Point3D;
  ppointlist = ^pointlist;
  pointlist  = array[0..0] of Point3D;

const
  origin3D: Point3D = (x:0; y:0; z:0);
  WCS_X: Point3D = (x:1; y:0; z:0);
  WCS_Y: Point3D = (x:0; y:1; z:0);
  WCS_Z: Point3D = (x:0; y:0; z:1);

type
  pMatrix = ^Matrix;
  pM      = pMatrix;
  Matrix = record
    val : array[0..3,0..3] of double;
  end;

const
  identity : Matrix = (val:((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1)));


// note the addition of base and scale factor for drawing blocks
type
  coord_convert = function(P:Point3D; OCS:pMatrix): TPoint of Object;
  PC_convert = function(P:Point3D; OCS:pMatrix): TDoublePoint 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_Layer = class;

  DXF_Entity = class
    fcolor: integer;
    colinx: integer;
    OCS_WCS: pMatrix;
    OCS_axis: Point3D;
    scale: Point3D;
    rotation: double;

    SCS_Layer_Handle: integer;

    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;
    function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure; 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...
///////////////////////////////////////////////////////////////////////////////
  Block_ = class(DXF_Entity)
    BeginPoint: Point3D;
    name: string;
    basepoint: Point3D;
    entities: TList;
    scale: Point3D;
    rotation: double;
    angle: double;
    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;
    function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
  end;
///////////////////////////////////////////////////////////////////////////////
// Point Definition
///////////////////////////////////////////////////////////////////////////////
  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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Text Definition
///////////////////////////////////////////////////////////////////////////////
  Text_ = class(Point_) // always OCS
    h: double;
    textstr: string;
    align_pt: Point3D; // alignment point
    hor_align: integer; // horizontal justification code
    angle: double;
    ScaleX: double;
    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;
    function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): Tfigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// MText Definition
///////////////////////////////////////////////////////////////////////////////
  MText_ = class(Point_) // always OCS
    h: double;
    textstr: string;
    align_pt: Point3D; // alignment point
    hor_align: integer; // horizontal justification code
    AngleRad: Double;
    AlignIndex: Integer;
    constructor create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha, align: 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;
    function GetRichTextByFormat(aStr: string): TRichText;
    function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): TFigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Attrib Definition
///////////////////////////////////////////////////////////////////////////////
  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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
  end;
  patt_array = ^att_array;
  att_array  = array[0..0] of Attrib_;
///////////////////////////////////////////////////////////////////////////////
// Attdef Definition
///////////////////////////////////////////////////////////////////////////////
  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)
///////////////////////////////////////////////////////////////////////////////
  Insert_ = class(Point_) // always OCS
    BeginPoint: Point3D;
    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; aBeginPoint: Point3D);
    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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Line Definition
///////////////////////////////////////////////////////////////////////////////
  Line_ = class(Point_) // always WCS
    p2: Point3D;
    fLineStyle: String;
    LineTypeScale: Double; // Tolik 09/07/2019 --
    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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Circle Definition
///////////////////////////////////////////////////////////////////////////////
  Circle_ = class(Point_) // always OCS
    radius : double;
    fLineStyle: string;
    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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Arc Definition
///////////////////////////////////////////////////////////////////////////////
  Arc_ = class(Circle_)  // always OCS
    angle1, angle2 : double;
    fLineStyle: string;
    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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Polyline Definition
///////////////////////////////////////////////////////////////////////////////
  Polyline_ = class(DXF_Entity) // OCS/WCS depends
    closed: boolean;
    numvertices: integer;
    polypoints: ppointlist;
    numattrs: integer;
    attribs: array[0..max_my_attribs - 1] of double;
    fLineStyle: string;
    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_);
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// LwPolyline Definition
///////////////////////////////////////////////////////////////////////////////
  LWPolyline_ = class(DXF_Entity) // OCS/WCS depends
    closed: boolean;
    numvertices: integer;
    polypoints: ppointlist;
    numattrs: integer;
    attribs: array[0..max_my_attribs - 1] of double;
    fLineStyle: string;
    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_);
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
  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);
    function proper_name: string; override; // save as 3DFACE not Face3D
    procedure write_to_DXF(var IO:textfile; layer:string); override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Solid_ Definition
///////////////////////////////////////////////////////////////////////////////
  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
///////////////////////////////////////////////////////////////////////////////
  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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
  end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh) Definition
///////////////////////////////////////////////////////////////////////////////
  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;
    function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; 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.
///////////////////////////////////////////////////////////////////////////////

  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;
    procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer);
  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;

    SCS_Layer_Handle: integer;

    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;
    procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer);
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Object class definition
// A Collection of DXF_Layers - eg a whole DXF file.
///////////////////////////////////////////////////////////////////////////////
type
  DXF_ObjectSCS = class
    DXF_name: string;
    layer_lists: TList;
    emax: Point3D;
    emin: Point3D;
    PCWh: Double;
    PCWw: Double;
    CadHeight: Double;
    CadWidth: Double;
    // 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_ObjectSCS) : 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);
    procedure ExportToPowerCad(Cad: TPCDrawing;Layered,IncVertex: Boolean);
    function GetPCPoint(P:Point3D; OCS:pMatrix): TDoublePoint;
  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, clRed, clYellow, clLime, clAqua, clBlue, clPurple,
                                                      clBlack, clOlive, clFuchsia, clTeal, clGray, clDkGray);
var
  PCVertexOk: Boolean;


///////////////////////////////////////////////////////////////////////////////
// General point 3D stuff
///////////////////////////////////////////////////////////////////////////////
function aPoint3D(a,b,c:double): Point3D;
function p1_eq_p2_3D(p1,p2:Point3D): boolean;
function p1_eq_p2_2D(p1,p2:Point3D): boolean;
function p1_minus_p2(p1,p2:Point3D): Point3D;
function p1_plus_p2 (p1,p2:Point3D): Point3D;
function normalize(p1:Point3D): Point3D;
function mag(p1:Point3D): double;
function dist3D(p1,p2:Point3D): double;
function dist2D(p1,p2:Point3D): double;
function sq_dist3D(p1,p2:Point3D): double;
function sq_dist2D(p1,p2:Point3D): double;
function sq_mag3D(p1:Point3D): double;
function p1_x_n(p1:Point3D; n:double): Point3D;
function set_accuracy(factor:double; p:Point3D): Point3D;
///////////////////////////////////////////////////////////////////////////////
// Vector 3D stuff
///////////////////////////////////////////////////////////////////////////////
function dot(p1,p2:Point3D): double;
function cross(p1,p2:Point3D): Point3D;
function angle(p1,p2,p3:Point3D; do_3D:boolean): double;
///////////////////////////////////////////////////////////////////////////////
// Rotations for Insert/Block drawing
///////////////////////////////////////////////////////////////////////////////
function XRotateMatrix(cos_a,sin_a:double): Matrix;
function YRotateMatrix(cos_a,sin_a:double): Matrix;
function ZRotateMatrix(cos_a,sin_a:double): Matrix;
function ScaleMatrix(p:Point3D): Matrix;
function TranslateMatrix(p:Point3D): Matrix;
function MatrixMultiply(matrix1,matrix2:Matrix): Matrix;
function CreateTransformation(Ax,Ay,Az:Point3D): Matrix;
function TransformPoint(TM:Matrix; p:Point3D): Point3D;
function update_transformations(OCS_WCS,OCS:pMatrix): pMatrix;
function RotationAxis(A:Point3D; angle:double): Matrix;
///////////////////////////////////////////////////////////////////////////////
// Bounds
///////////////////////////////////////////////////////////////////////////////
procedure max_bound(var bounds:Point3D; point:Point3D);
procedure min_bound(var bounds:Point3D; point:Point3D);
function  dmin(a,b:double) : double;
function  dmax(a,b:double) : double;
function  imin(a,b:integer) : integer;
function  imax(a,b:integer) : integer;
///////////////////////////////////////////////////////////////////////////////
// Memory
///////////////////////////////////////////////////////////////////////////////
function  allocate_points(n:integer) : ppointlist;
procedure deallocate_points(var pts:ppointlist; n:integer);
function  allocate_matrix : pMatrix;
procedure deallocate_matrix(var m:pMatrix);
///////////////////////////////////////////////////////////////////////////////
// String
///////////////////////////////////////////////////////////////////////////////
function float_out(f:double): string;
function Point3DToStr(p:Point3D): string;
function BoolToStr(b:boolean): string;


///////////////////////////////////////////////////////////////////////////////
// DXF_Writer class definition
///////////////////////////////////////////////////////////////////////////////

type
  DXF_Writer = class
  private
    IO_Chan: Text;
  public
    // Extents in (x,y) of the dataset
    min_extents: Point3D;
    max_extents: Point3D;
    DXF_Layers: TList;
    // Constructors and destructors
    Constructor create(aname: string; data_list: TList);
    Destructor destroy; override;
    procedure write_file;
    // 1 - Header section
    function write_header: boolean;
    // 2 - Classes section
    function write_classes: boolean;
    // 3 - Tables section
    function write_tables: boolean;
    function write_layer_information: boolean;
    function write_ltype_information: boolean;
    function write_vport_information: boolean;
    // 4 - Blocks section
    function write_blocks: boolean;
    // 5 - Entities section
    function write_entities: boolean;
    // 6 - Objects section
    function write_objects: boolean;
    // 7 - Thumbnailimage section
    function write_thumbnailimage: boolean;
  end;

// DXF File write exceptions will be this type
type
  DXF_write_exception = class(Exception);

///////////////////////////////////////////////////////////////////////////////
// DXF_Reader class definition
///////////////////////////////////////////////////////////////////////////////
Const
  MaxSizeOfBuf = 4096;

type
  //tCharArray = array [0..MaxSizeOfBuf - 1] of char;
  tCharArray = array [0..MaxSizeOfBuf - 1] of AnsiChar;


type
  abstract_entity = class;

  DXF_Reader = class
  private
    // used when reading data from the file
    IO_chan: file;
    SizeOfBuf: integer;
    num_in_buf: integer;
    ii: integer;
    EC, fCode: integer;
    pBuf: ^tCharArray;
    Line_num: longint;
    fLine: shortstring;
    //progress    : TProgressBar;
    // useful bits to make parsing easier...
    file_pos: integer;
    marked_pos: integer;
    backflag: boolean;
    procedure go_back_to_last(code:integer; str:shortstring);
    procedure mark_position;
    procedure goto_marked_position;
    //
    procedure go_back_to_start;
    function NextGroupCode: integer;
    function ValStr: shortstring;
    function ValDbl: double;
    function ValInt: integer;
    function code_and_string(var group:integer; var s:string): boolean;
    function code_and_double(var group:integer; var d:double): boolean;
    function read_2Dpoint(var p1:Point3D): boolean;
    function skip_upto_section(name:string): boolean;
                // lowest level read function
    function read_entity_data(ent: abstract_entity): boolean;
    function read_generic(var layer:integer): abstract_entity;
                // we can read most entities with this one
    function general_purpose_read(obj_type:TClass; var entity:DXF_Entity; var layer:integer): boolean;
                // inserts/polylines need a little more complexity
    function read_insert(var entity:DXF_Entity; var layer:integer): boolean;
    function read_polyline(var entity:DXF_Entity; var layer:integer): boolean;
    function read_lwpolyline(var entity:DXF_Entity; var layer:integer): boolean;
                // this calls the others above
    function read_entity(s,endstr:string; var entity:DXF_Entity; var layer:integer): boolean;
  public
    // Extents in (x,y) of the dataset
    min_extents: Point3D;
    max_extents: Point3D;
    // We will read the Entities in the layers into this list
    DXF_Layers: TList;
    colour_BYLAYER: boolean;
    skipped: TStrings;
    // Constructors and destructors
    Constructor Create (const aName: shortstring);
    Destructor Destroy; override;
    // 1 - Header section
    function move_to_header_section: boolean;
    function read_header: boolean;
    function get_min_extent: Point3D;
    function get_max_extent: Point3D;
    // 2 -Classes section
    function move_to_classes_section: boolean;
    function read_classes: boolean;
    // 3 - Tables section
    function move_to_tables_section: boolean;
    function read_tables: boolean;
    function read_layer_information: boolean;
    function read_vport_information: boolean;
    function layer_num(layername:string) : integer;
    // 4 - Blocks section
    function move_to_blocks_section: boolean;
    function read_blocks: boolean;
    function read_block: boolean;
    function block_list: Entity_List;
    // 5 - Entities section
    function move_to_entity_section: boolean;
    function read_entities: boolean;
    // 6 - Objects section
    function move_to_objects_section: boolean;
    function read_objects: boolean;
    // 7 - Thumbnailimage section
    function move_to_thumbnailimage_section: boolean;
    function read_thumbnailimage: boolean;

    // These are the main routines to use
    function read_file: boolean;
    function remove_empty_layers: boolean;
    function release_control_of_layers: TList;
    procedure set_skipped_list(s: TStrings);
  end;

///////////////////////////////////////////////////////////////////////////////
// This is a simple class used only during file reads, it should not be used
// as a base for any objects.
// It is to allow all entities to be read using the same basic structure
// even though they all use different group codes
// Add extra group codes if you need to recognize them
///////////////////////////////////////////////////////////////////////////////
  abstract_entity = class
    p1, p2, p3, p4: Point3D;
    rad_hgt: double;
    angle1, angle2: double;
    fv1, fv2, fv3: double;
    thickness: double;
    colour: integer;
    flag_70, flag_71, flag_72, flag_73, flag_74: integer;
    attflag: integer;
    namestr, tagstr, promptstr: string;
    layer: string;
    elev: double;
    OCS_Z: Point3D;
    procedure clear;
  end;
///////////////////////////////////////////////////////////////////////////////
// DXF file read exceptions will be this type
///////////////////////////////////////////////////////////////////////////////
type
  DXF_read_exception = class(Exception)
    line_number: integer;
    constructor create(err_msg:string; line:integer);
  end;


///////////////////////////////////////////////////////////////////////////////
// Memory check variables
///////////////////////////////////////////////////////////////////////////////
var
  entities_in_existence: integer;
  Ent_lists_in_existence: integer;
  layers_in_existence: integer;
  DXF_Obj_in_existence: integer;
  GArcsCount: Integer = 0;
  GRotPoints: TDoublePoint;

implementation
uses U_Constants, U_ExportDXF, U_ImportDXF;


{ --------------------------------------------------------------------------- }
{ -------------------             DXFWriter           ----------------------- }
{ --------------------------------------------------------------------------- }
Constructor DXF_Writer.Create(aname:string; data_list:TList);
begin
  Inherited Create;
  AssignFile(IO_Chan,aName);
  Rewrite(IO_Chan);
  DXF_Layers := data_list;
end;

destructor DXF_Writer.Destroy;
begin
  CloseFile(IO_chan);
  Inherited Destroy;
end;

procedure DXF_Writer.write_file;
begin
  // 1
  write_header;
  // 2
  write_classes;
  // 3
  write_tables;
  // 4
  write_blocks;
  // 5
  write_entities;
  // 6
  write_objects;
  // 7
  write_thumbnailimage; 
  writeln(IO_chan, 0, EOL, 'EOF');
end;

// 1
function DXF_Writer.write_header : boolean;
var
  lp1 : integer;
begin
  min_extents := aPoint3D( 1E10, 1E10, 1E10);
  max_extents := aPoint3D(-1E10,-1E10,-1E10);
  writeln(IO_chan, 0, EOL, 'SECTION');
  writeln(IO_chan, 2, EOL, 'HEADER');
  for lp1 := 0 to DXF_layers.count - 1 do
    DXF_Layer(DXF_Layers[lp1]).max_min_extents(max_extents, min_extents);
  writeln(IO_chan,9 ,EOL,'$EXTMIN');

  writeln(IO_chan,10,EOL,FloatToStr(min_extents.x));
  writeln(IO_chan,20,EOL,FloatToStr(min_extents.y));
  writeln(IO_chan,30,EOL,FloatToStr(min_extents.z));
  {//01.11.2012 test
  writeln(IO_chan,10,EOL,0);
  writeln(IO_chan,20,EOL,0);
  writeln(IO_chan,30,EOL,FloatToStr(min_extents.z));}

  writeln(IO_chan,9 ,EOL,'$EXTMAX');
  writeln(IO_chan,10,EOL,FloatToStr(max_extents.x));
  writeln(IO_chan,20,EOL,FloatToStr(max_extents.y));
  writeln(IO_chan,30,EOL,FloatToStr(max_extents.z));
  writeln(IO_chan,0,EOL,'ENDSEC');
end;

// 2
function DXF_Writer.write_classes: boolean;
begin
  writeln(IO_chan,0,EOL,'SECTION');
  writeln(IO_chan,2,EOL,'CLASSES');
  writeln(IO_chan,0,EOL,'ENDSEC');
end;

// 3
function DXF_Writer.write_tables : boolean;
begin
  writeln(IO_chan,0,EOL,'SECTION');
  writeln(IO_chan,2,EOL,'TABLES');
  write_vport_information;
  write_ltype_information;
  write_layer_information;
  writeln(IO_chan,0,EOL,'ENDSEC');
end;

function DXF_Writer.write_layer_information : boolean;
var
  lp1: integer;
  layer: DXF_Layer;
begin
  writeln(IO_chan, 0, EOL, 'TABLE');
  writeln(IO_chan, 2, EOL, 'LAYER');
  for lp1 := 0 to DXF_layers.count - 1 do
  begin
    layer := DXF_Layer(DXF_Layers[lp1]);
    writeln(IO_chan, 0, EOL, 'LAYER');
    if layer.name = '' then
      layer.name := 'Unknown';
    writeln(IO_chan, 2, EOL, layer.name);
    writeln(IO_chan, 70, EOL, 0);
    if layer.layer_colinx = 0 then
      layer.layer_colinx := 7;
    writeln(IO_chan, 62, EOL, layer.layer_colinx);
    writeln(IO_chan, 6, EOL, 'CONTINUOUS');
  end;
  writeln(IO_chan,0,EOL,'ENDTAB');
end;

function DXF_Writer.write_ltype_information: boolean;
begin
  writeln(IO_chan, 0, EOL, 'TABLE');
  writeln(IO_chan, 2, EOL, 'LTYPE');
  // Solid
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'SOLID');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3, EOL, 'SOLID');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 0);
  writeln(IO_chan, 40, EOL, 0);
  // Dash
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'DASH');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3, EOL, 'DASH');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 2);
  writeln(IO_chan, 40, EOL, 0.75);
  writeln(IO_chan, 49, EOL, 0.5);
  writeln(IO_chan, 49, EOL, -0.25);
  // Dot
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'DOT');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3, EOL, 'DOT');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 2);
  writeln(IO_chan, 40, EOL, 0.25);
  writeln(IO_chan, 49, EOL, 0);
  writeln(IO_chan, 49, EOL, -0.25);
  // DashDot
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'DASHDOT');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3,   EOL, 'DASHDOT');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 4);
  writeln(IO_chan, 40, EOL, 1);
  writeln(IO_chan, 49, EOL, 0.5);
  writeln(IO_chan, 49, EOL, -0.25);
  writeln(IO_chan, 49, EOL, 0);
  writeln(IO_chan, 49, EOL, -0.25);
  // DashDotDot
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'DASHDOTDOT');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3,   EOL, 'DASHDOTDOT');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 6);
  writeln(IO_chan, 40, EOL, 1.25);
  writeln(IO_chan, 49, EOL, 0.5);
  writeln(IO_chan, 49, EOL, -0.25);
  writeln(IO_chan, 49, EOL, 0);
  writeln(IO_chan, 49, EOL, -0.25);
  writeln(IO_chan, 49, EOL, 0);
  writeln(IO_chan, 49, EOL, -0.25);
  // Clear
  writeln(IO_chan, 0, EOL, 'LTYPE');
  writeln(IO_chan, 2, EOL, 'CLEAR');
  writeln(IO_chan, 70, EOL, 0);
  writeln(IO_chan, 3, EOL, 'CLEAR');
  writeln(IO_chan, 72, EOL, 65);
  writeln(IO_chan, 73, EOL, 8);
  writeln(IO_chan, 40, EOL, 0);  

  writeln(IO_chan, 0, EOL, 'ENDTAB');
end;

function DXF_Writer.write_vport_information : boolean;
begin
  writeln(IO_chan,0,EOL,'TABLE');
  writeln(IO_chan,2,EOL,'VPORT');
//  writeln(IO_chan,0,EOL,'VPORT');
  writeln(IO_chan,2,EOL,'*ACTIVE');
//  writeln(IO_chan,41,EOL,1.0{aspect}:10:6);
  writeln(IO_chan,0,EOL,'ENDTAB');
end;

// 4
function DXF_Writer.write_blocks : boolean;
var
  i, j, k: integer;
  Layer: DXF_Layer;
  eList: Entity_List;
begin
  writeln(IO_chan, 0, EOL, 'SECTION');
  writeln(IO_chan, 2, EOL, 'BLOCKS');
  layer := nil;
  for i := 0 to DXF_Layers.count - 1 do
  begin
    Layer := DXF_Layer(DXF_Layers[i]);
    for j := 0 to Layer.num_lists - 1 do
    begin
      eList := Entity_List(layer.entity_lists[j]);
      if eList.name = Block_.ClassName then
      begin
        for k := 0 to eList.entities.Count - 1 do
        begin
          DXF_Entity(eList.entities[k]).write_to_DXF(IO_chan, layer.name);
        end;
      end;
    end;
  end;
  writeln(IO_chan, 0, EOL, 'ENDSEC');
end;

// 5
function DXF_Writer.write_entities : boolean;
var
  i, j, k: integer;
  Layer: DXF_Layer;
  eList: Entity_List;
  Entity: DXF_Entity;
  
  insert_name: string;
  p1: point3D;
  a1: double;

begin
  writeln(IO_chan, 0, EOL, 'SECTION');
  writeln(IO_chan, 2, EOL, 'ENTITIES');
  for i := 0 to DXF_layers.count - 1 do
  begin
    layer := DXF_Layer(DXF_Layers[i]);
    for j := 0 to layer.num_lists - 1 do
    begin
      eList := Entity_List(layer.entity_lists[j]);
      // если не блок
      if eList.name <> Block_.ClassName then
      begin
        for k := 0 to eList.entities.Count - 1 do
        begin
          DXF_Entity(eList.entities[k]).write_to_DXF(IO_chan, layer.name);
        end;
      end
      // блок
      else
      begin
        for k := 0 to eList.entities.Count - 1 do
        begin
          Entity := DXF_Entity(eList.entities[k]);
          insert_name := BLOCK_(Entity).name;
          p1.x := BLOCK_(Entity).basepoint.x;
          p1.y := BLOCK_(Entity).basepoint.y;
          p1.z := BLOCK_(Entity).basepoint.z;
          a1 := BLOCK_(Entity).angle; 

          writeln(IO_Chan, 0, EOL, 'INSERT');
          writeln(IO_Chan, 5, EOL, 'E5');
          writeln(IO_Chan, 8, EOL, layer.name);
          writeln(IO_chan, 2, EOL, insert_name);
          writeln(IO_Chan, 10, EOL, float_out(p1.x));
          writeln(IO_Chan, 20, EOL, float_out(p1.y));
          writeln(IO_chan, 30, EOL, float_out(p1.z));
          writeln(IO_chan, 50, EOL, float_out(a1));
        end;
      end;
    end;
  end;
  writeln(IO_chan, 0, EOL, 'ENDSEC');
end;

// 6
function DXF_Writer.write_objects: boolean;
begin
  writeln(IO_chan,0,EOL,'SECTION');
  writeln(IO_chan,2,EOL,'OBJECTS');
  writeln(IO_chan,0,EOL,'ENDSEC');
end;

function DXF_Writer.write_thumbnailimage: boolean;
begin
  writeln(IO_chan,0,EOL,'SECTION');
  writeln(IO_chan,2,EOL,'THUMBNAILIMAGE');
  writeln(IO_chan,0,EOL,'ENDSEC');
end;

///////////////////////////////////////////////////////////////////////////////
// abstract_entity implementation
// used when reading vertexes - just to make sure all flags are reset
// quicker than using create/destroy for each vertex.
///////////////////////////////////////////////////////////////////////////////
procedure abstract_entity.clear;
begin
  InitInstance(self);
end;
///////////////////////////////////////////////////////////////////////////////
// DXFReader implementation
///////////////////////////////////////////////////////////////////////////////
Constructor DXF_Reader.Create (const aName: shortstring);
begin
  Inherited Create;
  AssignFile(IO_chan,aName);
  Reset(IO_chan, 1);
  SizeOfBuf := MaxSizeOfBuf;
  GetMem(pBuf,SizeOfBuf);
  DXF_Layers := TList.Create;
  colour_BYLAYER := false;
  Line_num := 0;
  backflag := false;
  min_extents := origin3D;
  max_extents := origin3D;
end;

destructor DXF_Reader.Destroy;
var
  lp1: integer;
begin
  if (DXF_Layers <> nil) then
    for lp1 := 0 to DXF_Layers.count - 1 do
      DXF_Layer(DXF_Layers[lp1]).Free;
  DXF_Layers.Free;
  CloseFile(IO_chan);
  FreeMem(pBuf,SizeOfBuf);
  Inherited Destroy;
end;
{ --------------------------------------------------------------------------- }
{ Routines for fetching codes and values
{ --------------------------------------------------------------------------- }
procedure DXF_Reader.go_back_to_start;
begin
  Reset(IO_chan,1);
  num_in_buf := 0;
  ii := 0;
end;

procedure DXF_Reader.go_back_to_last(code:integer; str:shortstring);
begin
  fCode := code;
  fLine := str;
  backflag := true;
end;

procedure DXF_Reader.mark_position;
begin
  marked_pos := File_pos + ii;
end;

procedure DXF_Reader.goto_marked_position;
begin
  Seek(IO_chan, marked_pos);
  File_pos := marked_pos;
  num_in_buf := 0;
  ii := 0;
end;

function DXF_Reader.NextGroupCode: integer;

  function GotMore: boolean;
  begin
    file_pos := FilePos(IO_chan);
    BlockRead(IO_chan, pBuf^, SizeOfBuf,num_in_buf);
    ec:=IoResult;
    ii:=0;
    If (ec = 0) and (num_in_buf = 0) then
      ec := -1;
    GotMore := (ec = 0);
  end;

  // Sometimes you get (download) a bad DXF file which has a couple of blank
  // lines in it. The commented retry code, can be used to skip blank lines, but you
  // should only use it as an emergency fix because you'll often find blank lines
  // in TEXT entities and other text strings.
  function GotLine: boolean;
  const
    CR=#13;
    LF=#10;
  var
    //c: char;
    c: Ansichar;
  begin
    byte(fLine[0]) := 0;
    While (ii < num_in_buf) or GotMore do
    begin
      c := pBuf^[ii];
      inc(ii);
      If (c <> CR) and (c <> LF) and (length(fLine) < 255) then
      begin
        inc(fLine[0]);
        fLine[length(fLine)] := c;
      end
      else
      begin
        if (c = CR) then
        begin
          if (ii < num_in_buf) or GotMore then
          begin
            if pBuf^[ii] = LF then
            begin
              inc(ii);
              break;
            end;
          end;
        end
        else
        if (c = LF) then
          break;
      end;
    end;
    GotLine := (ec = 0) and ((c = CR) or (c = LF));
    inc(Line_num);
  end;

begin {NextGroupCode}
  if backflag then
  begin
    result   := fCode;
    backflag := false;
  end
  else
  begin
    repeat
      if not GotLine then
      begin
        fCode := -2;
        Result := fCode;
        exit;
      end;
    until fLine <> '';
    Val(fLine, fCode, ec);
    If ec <> 0 then
      fCode := -2
    else
    if not GotLine then
      fCode := -2;
    Result := fCode;
  end;
end {NextGroupCode};

function DXF_Reader.ValStr: shortstring;
begin
  Result := fLine;
end;

function DXF_Reader.ValDbl: double;
begin
  Val(fLine, Result, ec);
  If ec <> 0 then
    raise DXF_read_exception.Create('Invalid Floating point conversion',line_num);
end;

function DXF_Reader.ValInt: integer;
begin
  Val(fLine, Result, ec);
  If ec <> 0 then
    raise DXF_read_exception.Create('Invalid Integer conversion',line_num);
end;

function DXF_Reader.code_and_string(var group:integer; var s:string) : boolean;
var
  astr: string;
begin
  result := true;
  group  := NextGroupCode;
  if group >= 0 then
    s := ValStr
  else
    result := false;
  // useful in debugging
  //  if (group=0) then begin astr := IntToStr(group)+' '+s; alb.Items.Add(astr); end;
end;

function DXF_Reader.code_and_double(var group:integer; var d:double) : boolean;
begin
  result := true;
  group  := NextGroupCode;
  if group >= 0 then
    d := Valdbl
  else
    result := false;
end;

// This routine is just for the $EXT(max/min) and should be used with care....
function DXF_Reader.read_2Dpoint(var p1:Point3D) : boolean;
var
  Groupcode : integer;
begin
  repeat
    Groupcode := NextGroupCode;
  until (Groupcode=DXF_primary_X) or (Groupcode<0);
  if Groupcode < 0 then
  begin
    result := false;
    exit;
  end;
  p1.x := Valdbl;
  result := code_and_double(Groupcode, p1.y);
end;

function DXF_Reader.skip_upto_section(name: string): boolean;
var
  Group: integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) then
    begin
      if (s = 'SECTION') then
      begin
        if not code_and_string(Group, s) then
          break;
        if (Group = DXF_name) then
        begin
          if (s = name) then
            result := true
          else
            exit;
        end
        else
        if skipped <> nil then
          Skipped.Add(s);
      end
      else
      if skipped <> nil then
        Skipped.Add(s);
    end;
  until (result);
end;
{ --------------------------------------------------------------------------- }
{ 1 - Header section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_header_section : boolean;
begin
  result := false;
  result := skip_upto_section('HEADER');
end;

function DXF_Reader.read_header : boolean;
var
  Group: integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group,s) then
      break;
    if (group=9) and (s='$EXTMAX') then
    begin
      if not read_2Dpoint(max_extents) then
        break;
    end;
    if (group=9) and (s='$EXTMIN') then
    begin
      if not read_2Dpoint(min_extents) then
        break;
    end;
    if (group=9) and (s='$CECOLOR') then
    begin
      if (NextGroupCode=DXF_colornum) and (ValInt=256) then
        colour_BYLAYER := true;
    end;
    result := (Group=0) and (s='ENDSEC');
  until result;
end;

function DXF_Reader.get_min_extent : Point3D;
begin
  result := min_extents;
end;

function DXF_Reader.get_max_extent : Point3D;
begin
  result := max_extents;
end;

{ --------------------------------------------------------------------------- }
{ 2 - Classes section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_classes_section: boolean;
begin
  result := false;
  result := skip_upto_section('CLASSES');
end;

function DXF_Reader.read_classes: boolean;
var
  Group: integer;
  GroupCode: integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) and (s = 'CLASS') then
    begin
      if not code_and_string(Group, s) then
        break;
      if (Group = DXF_name) then
      begin
        if skipped <> nil then
          Skipped.Add(s);
      end;
    end;
    result := (Group = 0) and (s = 'ENDSEC');
  until result;
end;


{ --------------------------------------------------------------------------- }
{ 4 - Blocks section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_blocks_section : boolean;
begin
  result := false;
  result := skip_upto_section('BLOCKS');
end;

function DXF_Reader.read_blocks : boolean;
var
  Group: integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) and (s = 'BLOCK') then
    begin
      if not read_block then
        break;
    end;
    result := (Group=0) and (s = 'ENDSEC');
  until result;
end;

function DXF_Reader.read_block : boolean;
var
  Groupcode: integer;
  s: string;
  ent: abstract_entity;
  block: Block_;
  layer,lp1: integer;
  entity: DXF_Entity;
  base: Point3D;
begin
  result := false;
  ent := read_generic(layer);
  layer := layer_num('0'); // ALL BLOCKS GOING TO LAYER 0 (makes things easier)
  if layer < 0 then
    layer := DXF_Layers.Add(DXF_Layer.create('0'));
  if ent <> nil then
  begin
    if ent.namestr <> '_ArchTick' then
    begin
      block := Block_.create(ent.namestr, ent.p1);
      DXF_Layer(DXF_Layers[layer]).add_entity_to_layer(block);
      repeat
        if not code_and_string(Groupcode,s) then
          break;
        if (Groupcode = 0) then
        begin
          GArcsCount := GArcsCount + 1;
          result := read_entity(s, 'ENDBLK', entity, layer);
          if entity <> nil then
          begin
            block.entities.Add(entity);
          end;
        end;
      until result;
    end
    else
    begin
      s := '';
      while s <> 'ENDBLK' do
        code_and_string(Groupcode, s);
      Result := True;  
    end;

  end;
end;

// we need to know where the blocks are stored for lookup purposes
function DXF_Reader.block_list : Entity_List;
var
  lp1,lp2: integer;
  layer: DXF_Layer;
begin
  for lp1 := 0 to DXF_Layers.count - 1 do
  begin
    layer := DXF_Layers[lp1];
    for lp2 := 0 to layer.entity_lists.count - 1 do
    begin
      if Entity_List(layer.entity_lists[lp2]).name = 'Block_' then
      begin
        result := Entity_List(layer.entity_lists[lp2]);
        exit;
      end;
    end;
  end;
end;
{ --------------------------------------------------------------------------- }
{ 3 - Tables (Layers - VPort) section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_tables_section : boolean;
begin
  result := false;
  result := skip_upto_section('TABLES');
end;

function DXF_Reader.read_tables : boolean;
var
  Group: integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) and (s = 'TABLE') then
    begin
      if not code_and_string(Group, s) then
        break;
      if (Group = DXF_name) then
      begin
        if (s = 'LAYER') then
          read_layer_information
        else
        if (s = 'VPORT') then
          read_vport_information
        else
        if skipped <> nil then
          Skipped.Add(s);
      end;
    end;
    result := (Group=0) and (s='ENDSEC');
  until result;
end;

function DXF_Reader.read_layer_information : boolean;
var
  Group,Lay_num: integer;
  s: string;
begin
  lay_num := -1;
  result  := false;
  repeat
    if not code_and_string(Group,s) then
      break;
    if (Group=0) then
    begin
      if (s='LAYER') then
      begin
        if not code_and_string(Group,s) then
          break;
        if (Group=DXF_name) then
          lay_num := DXF_Layers.Add(DXF_Layer.create(s));
      end
      else
      if (s='ENDTAB') then
        result := true
      else
      if skipped<>nil then
        Skipped.Add(s);
    end
    else
    if (Group=DXF_colornum) and (lay_num<>-1) then
      DXF_Layer(DXF_Layers[lay_num]).Colour := ValInt;
  until result;
end;

// This no longer does anything !
function DXF_Reader.read_vport_information : boolean;
var
  Group : integer;
  s: string;
begin
  result := false;
  result := true;
  exit;
  repeat
    if not code_and_string(Group,s) then
      break;
    if (Group = 0) then
    begin
      if (s='VPORT') then
      begin
        if not code_and_string(Group,s) then
          break;
        if (Group = DXF_name) then
        begin
          if (s='*ACTIVE') then
          repeat
            if not code_and_string(Group, s) then
              break;
            result := (Group=0) and (s = 'ENDTAB');
          until (result)
          else
          if skipped <> nil then
            Skipped.Add(s);
        end;
      end
      else
      if skipped <> nil then
        Skipped.Add(s);
    end
  until (result);
end;

function DXF_Reader.layer_num(layername:string) : integer;
var
  lp1 : integer;
begin
  result := -1;
  for lp1:=0 to DXF_Layers.count-1 do
  begin
    if DXF_Layer(DXF_Layers[lp1]).name=layername then
    begin
      result := lp1;
      exit;
    end;
  end;
end;
{ --------------------------------------------------------------------------- }
{ 5 - Entities section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_entity_section : boolean;
begin
  result := false;
  result := skip_upto_section('ENTITIES');
end;

function DXF_Reader.read_entities : boolean;
var
  Groupcode,layer: integer;
  s: string;
  entity: DXF_Entity;
begin
  result := false;
  repeat
    try
      if not code_and_string(Groupcode,s) then
        break;
      if (Groupcode = 0) then
      begin
        result := read_entity(s, 'ENDSEC', entity, layer);
        // put the entity in the layer...
        if (entity <> nil) then
          DXF_Layer(DXF_Layers[layer]).add_entity_to_layer(entity);
      end;
    except
      on E:DXF_read_exception do
      begin
        if MessageBox(0,@E.message[1], 'DXF read error warning', MB_OKCANCEL) = IDCANCEL then
          raise DXF_read_exception.Create('User aborted', -1);
      end;
      on E:Exception do Showmessage(E.Message);
    end;
  until result;
end;
{ --------------------------------------------------------------------------- }
{ 6 - Objects section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_objects_section: boolean;
begin
  result := false;
  result := skip_upto_section('OBJECTS');
end;

function DXF_Reader.read_objects: boolean;
var
  Group: Integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) and (s = 'OBJECTS') then
    begin
      if not code_and_string(Group, s) then
        break;
      if (Group = DXF_name) then
      begin
        if skipped <> nil then
          Skipped.Add(s);
      end;
    end;
    result := (Group = 0) and (s = 'ENDSEC');
  until result;
end;

{ --------------------------------------------------------------------------- }
{ 7 - Thumbnailimage section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_thumbnailimage_section: boolean;
begin
  result := false;
  result := skip_upto_section('THUMBNAILIMAGE');
end;

function DXF_Reader.read_thumbnailimage: boolean;
var
  Group: Integer;
  s: string;
begin
  result := false;
  repeat
    if not code_and_string(Group, s) then
      break;
    if (Group = 0) and (s = 'THUMBNAILIMAGE') then
    begin
      if not code_and_string(Group, s) then
        break;
      if (Group = DXF_name) then
      begin
        if skipped <> nil then
          Skipped.Add(s);
      end;
    end;
    result := (Group = 0) and (s = 'ENDSEC');
  until result;
end;


{ --------------------------------------------------------------------------- }
{ Entity reading code
{ --------------------------------------------------------------------------- }
function DXF_Reader.read_entity_data(ent: abstract_entity) : boolean;
var
  Groupcode : integer;
  str: string;
begin
  ent.OCS_Z := WCS_Z;
  repeat
    Groupcode := NextGroupCode;
    str := ValStr;
    case Groupcode of
      DXF_primary_X:
        ent.p1.x := Valdbl;
      DXF_primary_Y:
        ent.p1.y := Valdbl;
      DXF_primary_Z:
        ent.p1.z := Valdbl;
      DXF_other_X_1:
        ent.p2.x := Valdbl;
      DXF_other_Y_1:
        ent.p2.y := Valdbl;
      DXF_other_Z_1:
        ent.p2.z := Valdbl;
      DXF_other_X_2:
        ent.p3.x := Valdbl;
      DXF_other_Y_2:
        ent.p3.y := Valdbl;
      DXF_other_Z_2:
        ent.p3.z := Valdbl;
      DXF_other_X_3:
        ent.p4.x := Valdbl;
      DXF_other_Y_3:
        ent.p4.y := Valdbl;
      DXF_other_Z_3:
        ent.p4.z := Valdbl;
      DXF_floatval:
        ent.rad_hgt := Valdbl;
      DXF_floatvals1:
        ent.fv1 := Valdbl;
      DXF_floatvals2:
        ent.fv2 := Valdbl;
      DXF_floatvals3:
        ent.fv3 := Valdbl;
      DXF_angle1:
        ent.angle1 := Valdbl;
      DXF_angle2:
        ent.angle2 := Valdbl;
      DXF_thickness:
        ent.thickness := Valdbl;
      DXF_elevation:
        ent.elev := Valdbl;
      DXF_70Flag:
        ent.flag_70 := ValInt;
      DXF_71Flag:
        ent.flag_71 := ValInt;
      DXF_72Flag:
        ent.flag_72 := ValInt;
      DXF_73Flag:
        ent.flag_73 := ValInt;
      DXF_74Flag:
        ent.flag_74 := ValInt;
      DXF_colornum:
        ent.colour := ValInt;
      DXF_entities_flg:
        ent.attflag := ValInt;
      DXF_layer_name:
        ent.layer := ValStr;
      DXF_name:
        ent.namestr := ValStr;
      DXF_text_def:
        ent.tagstr := ValStr;
      DXF_text_prompt:
        ent.promptstr := ValStr;
      DXF_extrusionx:
        ent.OCS_Z.x := Valdbl;
      DXF_extrusiony:
        ent.OCS_Z.y := Valdbl;
      DXF_extrusionz:
        ent.OCS_Z.z := Valdbl;
    end;
  until (Groupcode <= 0); // end or fault;
  if Groupcode < 0 then
  begin
    result := false;
    exit;
  end;
  // we need to put the code=0, and valstr back, so the next entity starts
  // with the zero when neccessary
  go_back_to_last(Groupcode,fline);
  ent.OCS_Z := normalize(ent.OCS_Z); // for safety
  result := true;
end;

function DXF_Reader.read_generic(var layer:integer) : abstract_entity;
var
  ent: abstract_entity;
  s: string;
begin
  result := nil;
  ent:= abstract_entity.create; // set everything to zero EVERY time
  if read_entity_data(ent) then
  begin
    layer := layer_num(ent.layer);
    if layer < 0 then
      layer := DXF_Layers.Add(DXF_Layer.create(ent.layer));
    result := ent;
  end
  else
    ent.free;
end;

{ These ones are straightforward, so we'll use a crafty TClass parameter }
function DXF_Reader.general_purpose_read(obj_type: TClass; var entity: DXF_Entity; var layer: integer): boolean;
var
  ent: abstract_entity;
begin
  try
    entity := nil;
    ent := read_generic(layer);
    if ent <> nil then
    begin
      with ent do
      begin
        if obj_type = Point_ then
          entity := Point_.create(OCS_Z,p1,colour)
        else
        if obj_type = Text_ then
          entity := Text_.create(OCS_Z, p1, p2, tagstr, rad_hgt, colour, flag_72)
        else
        if obj_type = MText_ then
          entity := MText_.create(OCS_Z, p1, p2, tagstr, rad_hgt, colour, flag_72, flag_71)
        else
        if obj_type = Line_ then
          entity := Line_.create(p1, p2, colour)
        else
        if obj_type = Circle_ then
          entity := Circle_.create(OCS_Z, p1, rad_hgt, colour)
        else
        if obj_type = Arc_ then
          entity := Arc_.create(OCS_Z, p1, rad_hgt, angle1, angle2, colour)
        // face3ds and solids can have 3 or 4 points, if 4=3, then 3 used
        else
        if obj_type = Face3D_ then
        begin
          if p1_eq_p2_3d(p3,p4) then
            entity := Face3D_.create(3, @p1, colour,true)
          else
            entity := Face3D_.create(4, @p1, colour,true);
        end
        else
        if obj_type = Solid_ then
        begin
          if p1_eq_p2_3d(p3,p4) then
            entity := Solid_.create(OCS_Z,3, @p1, colour,thickness)
          else
            entity := Solid_.create(OCS_Z,4, @p1, colour,thickness);
        end
        else
        if obj_type = Attdef_ then
          entity := Attdef_.create(OCS_Z,p1,p2,namestr,tagstr,promptstr,flag_70,flag_72,rad_hgt,colour)
        else
        if obj_type = Attrib_ then
          entity := Attrib_.create(OCS_Z,p1,p2,namestr,tagstr,flag_70,flag_72,rad_hgt,colour);
      end;
      ent.Free;
      result := true;
    end;
  except
    ShowMessage('general_purpose_read');
  end;
end;

{ INSERTs may have ATTRIBs + BLOCKs which makes it a little more complicated }
function DXF_Reader.read_insert(var entity: DXF_Entity; var layer: integer) : boolean;
var
  ent, ent2: abstract_entity;
  code,num: integer;
  atts: array[0..255] of Attrib_;
  //
  Groupcode: integer;
  s: string;
begin
  result := true;
  entity := nil;
  num := 0;
  ent := read_generic(layer);
  if ent <> nil then
  begin
    if ent.attflag = 1 then
    begin
      repeat
        result := (Nextgroupcode = 0);
        if result and (ValStr = 'ATTRIB') then
        begin
          ent2 := read_generic(layer);
          if ent2 <> nil then
          with ent2 do
          begin
            atts[num] := Attrib_.create(OCS_Z,p1,p2,namestr,tagstr,flag_70,flag_72,rad_hgt,colour);
            ent2.Free;
            inc(num);
          end
          else
            result := false;
        end;
      until (not result) or (ValStr='SEQEND');
      if result then
        Nextgroupcode; // remove the SEQEND put back
    end;

    with ent do
    begin
      if fv1 = 0 then
        fv1 := 1;
      if fv2 = 0 then
        fv2 := 1;
      if fv3 = 0 then
        fv3 := 1;

      entity := Insert_.create(OCS_Z,p1,aPoint3D(fv1,fv2,fv3),angle1,colour,num,@atts[0],namestr, p1);
      try
        Insert_(entity).update_block_links(block_list);
      except
        entity.Free;
        entity := nil;
//        raise
//          DXF_read_exception.Create('Cannot reference an undefined BLOCK'+EOL+EOL+ '(File may not have been saved with BLOCKs)'+EOL,line_num);
      end;
    end;
    ent.Free;
  end
  else
    result := false;
end;

// POLYLINEs have variable number of points...
// Modified to accept polyface mesh variety of polyline ...
//   I've ignored the invisible flag for edges
// Modified to accept polygon MxN grid mesh ...
// It's a bit messy - you could simplify it a bit - but hey - what do you
// expect from free code.
function DXF_Reader.read_polyline(var entity: DXF_Entity; var layer: integer) : boolean;
var
  ent1,ent2: abstract_entity;
  vertices,lp1: integer;
  faces: integer;
  tempvert: array[0..max_vertices_per_polyline-1] of Point3D;
  tempface: array[0..4095] of polyface;
  closed_poly: boolean;
  M,N,mn: integer;
  // my
  NextGroupCode_flag: integer;
  ValStr_flag: string;

label
  vertex_overflow;
begin
  result := false;
  closed_poly := false;
  entity := nil;
  ent1 := abstract_entity.create;
  // read initial polyline data
  if not read_entity_data(ent1) then
  begin
    ent1.Free;
    exit;
  end;
  layer := layer_num(ent1.layer);
  if (layer = -1) then
    layer := DXF_Layers.Add(DXF_Layer.create(ent1.layer));
  vertices := 0;
  faces := 0;
  ent2 := abstract_entity.create;
  //////////////////////////////////////////
  if (ent1.flag_70 and (64 + 16)) = 0 then
  begin
    // THIS IS A NORMAL POLYLINE
    repeat
      NextGroupCode_flag := NextGroupCode;
      ValStr_flag := ValStr;
      if (NextGroupCode_flag = 0) and (ValStr_flag = 'VERTEX') then
      begin
        ent2.clear;
        if read_entity_data(ent2) then
        begin
          tempvert[vertices] := ent2.p1;
          inc(vertices);
          if vertices >= max_vertices_per_polyline then
            goto vertex_overflow;
        end
        else
        begin
          ent1.Free;
          ent2.Free;
          exit;
        end; // error
      end;
    until fLine = 'SEQEND';
    result := NextGroupCode = 0;
    if ((ent1.flag_70) and 1) = 1 then
      closed_poly := true;
    entity := Polyline_.create(ent1.OCS_Z, vertices, @tempvert[0], ent1.colour, closed_poly);
  end
  //////////////////////////////////////////
  else
  if (ent1.flag_70 and 16) = 16 then
  begin
    // THIS IS A POLYGON MESH - a grid of vertices joined along M & N
    M := ent1.flag_71;
    N := ent1.flag_72;
    mn := 0;
    repeat
      if (NextGroupCode = 0) and (ValStr = 'VERTEX') then
      begin
        if read_entity_data(ent2) then
        begin
          inc(mn);
          if (ent2.Flag_70 and 64) = 64 then
          begin
            tempvert[vertices] := ent2.p1;
            inc(vertices);
            if vertices >= max_vertices_per_polyline then
              goto vertex_overflow;
          end
          else
          begin
            ent1.Free;
            ent2.Free;
            exit;
          end; // error
        end
        else
        begin
          ent1.Free;
          ent2.Free;
          exit;
        end; // error
      end;
    until fLine = 'SEQEND';
    result := NextGroupCode = 0;
    if mn <> M * N then
    begin
      ent1.Free;
      ent2.Free;
      exit;
    end; // error
    entity := Polygon_mesh_.create(vertices, M, N, @tempvert[0], ent1.flag_70, ent1.colour);
  end
  //////////////////////////////////////////
  //////////////////////////////////////////
  else
  if (ent1.flag_70 and 64) = 64 then
  begin
    // THIS IS A POLYFACE MESH - a vertex array with facets
    repeat
      if (NextGroupCode = 0) and (ValStr = 'VERTEX') then
      begin
        if read_entity_data(ent2) then
        begin
          if (ent2.Flag_70 and (128 + 64)) = (128 + 64) then
          begin
            // this is a normal coordinate vertex
            tempvert[vertices] := ent2.p1;
            inc(vertices);
            if vertices >= max_vertices_per_polyline then
              goto vertex_overflow;
          end
          else
          if (ent2.Flag_70 and (128)) = (128) then
          begin
            // this is a face definition vertex
            // negative indices indicate invisible edges (ignored for now)
            tempface[faces].nf[0] := Abs(ent2.flag_71) - 1; // index 1..n -> 0..n-1
            tempface[faces].nf[1] := Abs(ent2.flag_72) - 1;
            tempface[faces].nf[2] := Abs(ent2.flag_73) - 1;
            tempface[faces].nf[3] := Abs(ent2.flag_74) - 1;
            inc(faces);
          end
          else
          begin
            ent1.Free;
            ent2.Free;
            exit;
          end; // error
        end
        else
        begin
          ent1.Free;
          ent2.Free;
          exit;
        end; // error
      end;
    until fLine='SEQEND';
    result := NextGroupCode=0;
    entity := Polyface_mesh_.create(vertices, faces, @tempvert[0], @tempface[0], ent1.colour);
  end;
  //////////////////////////////////////////
  ent1.Free;
  ent2.Free;
  exit; // next bit only when vertices overflow
vertex_overflow:
  ent1.Free;
  ent2.Free;
  raise DXF_read_exception.Create('Polyline contained more than '+ IntToStr(max_vertices_per_polyline)+' vertices', line_num);
end;

function DXF_Reader.read_lwpolyline(var entity: DXF_Entity; var layer: integer): boolean;
var
  ent1: abstract_entity;
  vertices,lp1: integer;
  faces: integer;
  tempvert: array[0..max_vertices_per_polyline-1] of Point3D;
  tempface: array[0..4095] of polyface;
  closed_poly: boolean;
  M,N,mn: integer;
  // my
  NextGroupCode_flag: integer;
  ValStr_flag: string;
  ValDbl_flag: Double;
  ValInt_flag: Integer;
  VertCount: Integer;
label
  vertex_overflow;

begin
  result := false;
  closed_poly := false;
  entity := nil;
  ent1 := abstract_entity.create;
  layer := layer_num(ent1.layer);
  if (layer = -1) then
    layer := DXF_Layers.Add(DXF_Layer.create(ent1.layer));
  vertices := 0;
  faces := 0;

  begin
    // THIS IS A NORMAL POLYLINE
    repeat
      NextGroupCode_flag := NextGroupCode;
      ValStr_flag := ValStr;

      if (NextGroupCode_flag = 90) then
      begin
        ValInt_flag := ValInt;
        VertCount := ValInt_flag;
      end;

      if (NextGroupCode_flag = 70) then
      begin
        ValInt_flag := ValInt;
        if ValInt_flag = 1 then
          closed_poly := true
        else
          closed_poly := false;
      end;

      if (NextGroupCode_flag = 10) then
      begin
        ent1.clear;
        while vertices < VertCount do
        begin
          // коды - 10, 20 точки
          ent1.p1.x := ValDbl;
          NextGroupCode_flag := NextGroupCode;
          ent1.p1.y := ValDbl;
          tempvert[vertices] := ent1.p1;
          inc(vertices);
          if vertices >= max_vertices_per_polyline then
            goto vertex_overflow;
          // если не последний в списке - получить новый код для след. точки  
          if vertices < VertCount then
            NextGroupCode_flag := NextGroupCode;
        end;
        result := true;
      end;
//      result := (NextGroupCode_flag = 0);
    until result;

    ent1.OCS_Z.z := 1;
    ent1.colour := 0;
    entity := LWPolyline_.create(ent1.OCS_Z, vertices, @tempvert[0], ent1.colour, closed_poly);
  end;
  ent1.Free;
  exit; // next bit only when vertices overflow

vertex_overflow:
  ent1.Free;
  raise DXF_read_exception.Create('LwPolyline contained more than '+ IntToStr(max_vertices_per_polyline)+' vertices', line_num);
end;

function DXF_Reader.read_entity(s, endstr: string; var entity: DXF_Entity; var layer: integer): boolean;
begin
  entity := nil;
  result := false;
  if (s = 'POINT') then
  begin
    if not general_purpose_read(Point_, entity,layer) then
      raise DXF_read_exception.Create('Error reading POINT entity',line_num);
  end
  else
  if (s = 'INSERT') then
  begin
    if not read_insert(entity,layer) then
      raise DXF_read_exception.Create('Error reading INSERT entity',line_num);
  end
  else
  if (s = 'TEXT') then
  begin
    if not general_purpose_read(Text_,entity,layer) then
      raise DXF_read_exception.Create('Error reading TEXT entity',line_num);
  end
  else
  if (s = 'MTEXT') then
  begin
    if not general_purpose_read(MText_,entity,layer) then
      raise DXF_read_exception.Create('Error reading TEXT entity',line_num);
  end
  else
  if (s = 'LINE') then begin
    if not general_purpose_read(Line_,entity,layer) then
      raise DXF_read_exception.Create('Error reading LINE entity',line_num);
  end
  else
  if (s = 'POLYLINE') then
  begin
    if not read_polyline(entity, layer) then
      raise DXF_read_exception.Create('Error reading POLYLINE entity', line_num);
  end
  // LWPOLYLINE
  else
  if (s = 'LWPOLYLINE') then
  begin
    if not read_lwpolyline(entity, layer) then
      raise DXF_read_exception.Create('Error reading POLYLINE entity', line_num);
  end
  //
  else
  if (s = '3DFACE') then
  begin
    if not general_purpose_read(Face3D_,entity,layer) then
      raise DXF_read_exception.Create('Error reading 3DFACE entity',line_num);
  end
  else
  if (s = 'SOLID') then begin
    if not general_purpose_read(Solid_,entity,layer) then
      raise DXF_read_exception.Create('Error reading SOLID entity',line_num);
  end
  else
  if (s = 'CIRCLE') then begin
    if not general_purpose_read(Circle_,entity,layer) then
      raise DXF_read_exception.Create('Error reading CIRCLE entity',line_num);
  end
  else
  if (s = 'ARC') then
  begin
    if not general_purpose_read(Arc_,entity,layer) then
      raise DXF_read_exception.Create('Error reading ARC entity',line_num);
  end
  else
  if (s = 'ATTDEF') then
  begin
    if not general_purpose_read(AttDef_,entity,layer) then
      raise DXF_read_exception.Create('Error reading ATTDEF entity',line_num);
  end
  else
  if (s = 'ATTRIB') then
  begin
    if not general_purpose_read(Attrib_,entity,layer) then
      raise DXF_read_exception.Create('Error reading ATTRIB entity',line_num);
  end
  else
  if (s = endstr) then
    result := true
  else
  if skipped <> nil then
    Skipped.Add(s);
end;
///////////////////////////////////////////////////////////////////////////////
// Main routines to use
///////////////////////////////////////////////////////////////////////////////
function DXF_Reader.read_file : boolean;
var
  lp1: integer;
  move_to_header_section_flag: Boolean;
  read_header_flag: Boolean;
  move_to_classes_section_flag: Boolean;
  read_classes_flag: Boolean;
  move_to_tables_section_flag: Boolean;
  read_tables_flag: Boolean;
  move_to_blocks_section_flag: Boolean;
  read_blocks_flag: Boolean;
  move_to_entity_section_flag: Boolean;
  read_entities_flag: Boolean;
  move_to_objects_section_flag: Boolean;
  read_objects_flag: Boolean;
  move_to_thumbnailimage_section_flag: Boolean;
  read_thumbnailimage_flag: Boolean;
  LogStr: string;

begin
  result := true;
  try
    LogStr := '';
    // 1 - HEADER
    try
      mark_position;
      move_to_header_section_flag := move_to_header_section;
      read_header_flag := read_header;
      if not (move_to_header_section_flag and read_header_flag) then
      begin
        LogStr := LogStr + cImport_Mes6;
        sleep(message_delay_ms);
        goto_marked_position;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section1', E.Message);
    end;
    // 2 - CLASSES
    try
      mark_position;
      move_to_classes_section_flag := move_to_classes_section;
      read_classes_flag := read_classes;
      if not (move_to_classes_section_flag and read_classes_flag) then
      begin
        LogStr := LogStr + #13#10 + cImport_Mes7;
        sleep(message_delay_ms);
        goto_marked_position;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section2', E.Message);
    end;
    // 3 - TABLES
    try
      mark_position;
      move_to_tables_section_flag := move_to_tables_section;
      read_tables_flag := read_tables;
      if not (move_to_tables_section_flag and read_tables_flag) then
      begin
        LogStr := LogStr + #13#10 + cImport_Mes8;
        sleep(message_delay_ms);
        goto_marked_position;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section3', E.Message);
    end;
    // 4 - BLOCKS
    try
      mark_position;
      move_to_blocks_section_flag := move_to_blocks_section;
      read_blocks_flag := read_blocks;
      if not (move_to_blocks_section_flag and read_blocks_flag) then
      begin
        LogStr := LogStr + #13#10 + cImport_Mes9;
        sleep(message_delay_ms);
        goto_marked_position;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section4', E.Message);
    end;
    // 5 - ENTITIES
    try
      mark_position;
      move_to_entity_section_flag := move_to_entity_section;
      read_entities_flag := read_entities;
      if not (move_to_entity_section_flag and read_entities_flag) then
      begin
        LogStr := LogStr + #13#10 + cImport_Mes10;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section5', E.Message);
    end;
    // 6 - OBJECTS
    try
      mark_position;
      move_to_objects_section_flag := move_to_objects_section;
      read_objects_flag := read_objects;
      if not (move_to_objects_section_flag and read_objects_flag) then
      begin
        LogStr := LogStr + #13#10 + cImport_Mes11;
        sleep(message_delay_ms);
        goto_marked_position;
      end;
    except
      on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section6', E.Message);
    end;
    // 7 - THUMBNAILIMAGE
//    mark_position;
//    move_to_thumbnailimage_section_flag := move_to_thumbnailimage_section;
//    read_thumbnailimage_flag := read_thumbnailimage;
//    if not (move_to_thumbnailimage_section_flag and read_thumbnailimage_flag) then
//    begin
//      sleep(message_delay_ms);
//      goto_marked_position;
//    end;

//    if not (move_to_objects_section_flag and read_objects_flag) then
//      raise DXF_read_exception.Create('No Entities or invalid Entities section in DXF file', -1);
  except
    on E: DXF_read_exception do
    begin
      MessageBox(0,@E.message[1],'DXF Read Error',MB_ICONWARNING);
      AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
    end;
    on E: EAccessViolation do
    begin
      MessageDlg(E.message, mtWarning, [mbOK], 0);
      AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
    end;
    on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
  end;
  try
    if p1_eq_p2_3D(min_extents,origin3D) or p1_eq_p2_3D(max_extents,origin3D) then
    begin
      sleep(message_delay_ms);
      for lp1 := 0 to DXF_layers.count - 1 do
        DXF_Layer(DXF_Layers[lp1]).max_min_extents(max_extents,min_extents);
    end;
  except
    on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
  end;
//  if LogStr <> '' then
//    ShowMessage(LogStr);
end;

function DXF_Reader.remove_empty_layers : boolean;
var
  lp1: integer;
  layer: DXF_layer;
begin
   for lp1 := DXF_Layers.count - 1 downto 0 do
   begin
     layer := DXF_Layers[lp1];
     if layer.num_lists = 0 then
     begin
       DXF_Layers.Remove(layer);
       layer.Free;
     end;
  end;
  result := (DXF_Layers.count > 0);
end;

// Hand over ownership of the layers, the owner of the entity lists
// is now responsible for their destruction
function DXF_Reader.release_control_of_layers : TList;
begin
  result := DXF_Layers;
  DXF_Layers := nil;
end;

// Since we're not reading all groupcodes, we offer the chance
// to dump the main titles into a list so we can see what
// we've missed
procedure DXF_Reader.set_skipped_list(s:TStrings);
begin
  skipped := s;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF File exception
///////////////////////////////////////////////////////////////////////////////
constructor DXF_read_exception.create(err_msg:string; line:integer);
begin
  if line>-1 then
    message := err_msg + #13#10 + 'Error occured at or near line number ' + IntToStr(line)
  else
    message := err_msg;
end;

///////////////////////////////////////////////////////////////////////////////
// DXF UTils
///////////////////////////////////////////////////////////////////////////////


function aPoint3D(a,b,c:double) : Point3D;
begin
  result.x := a; result.y := b; result.z := c;
end;

function p1_eq_p2_3D(p1,p2:Point3D) : boolean;
begin
  result := (p1.x=p2.x) and (p1.y=p2.y) and (p1.z=p2.z);
end;

function p1_eq_p2_2D(p1,p2:Point3D) : boolean;
begin
  result := (p1.x=p2.x) and (p1.y=p2.y);
end;

function p1_minus_p2(p1,p2:Point3D) : Point3D;
begin
  result.x := p1.x-p2.x;
  result.y := p1.y-p2.y;
  result.z := p1.z-p2.z;
end;

function p1_plus_p2(p1,p2:Point3D) : Point3D;
begin
  result.x := p1.x+p2.x;
  result.y := p1.y+p2.y;
  result.z := p1.z+p2.z;
end;

function normalize(p1:Point3D) : Point3D;
var mag : double;
begin
  mag := Sqrt( sqr(p1.x) + sqr(p1.y) + sqr(p1.z) );
  result.x := p1.x/mag;
  result.y := p1.y/mag;
  result.z := p1.z/mag;
end;

function mag(p1:Point3D) : double;
begin
  with p1 do
    result := Sqrt( sqr(x) + sqr(y) + sqr(z) );
end;

function dist3D(p1,p2:Point3D) : double;
begin
  with p1_minus_p2(p2,p1) do
    result := Sqrt( sqr(x) + sqr(y) + sqr(z) );
end;

function dist2D(p1,p2:Point3D) : double;
begin
  with p1_minus_p2(p2,p1) do
    result := Sqrt( sqr(x) + sqr(y) );
end;

function sq_dist3D(p1,p2:Point3D) : double;
begin
  with p1_minus_p2(p2,p1) do
    result := sqr(x) + sqr(y) + sqr(z);
end;

function sq_dist2D(p1,p2:Point3D) : double;
begin
  with p1_minus_p2(p2,p1) do
    result := sqr(x) + sqr(y);
end;

function sq_mag3D(p1:Point3D) : double;
begin
  with p1 do
    result := sqr(x) + sqr(y) + sqr(z);
end;

function p1_x_n(p1:Point3D; n:double) : Point3D;
begin
  result.x := p1.x*n;
  result.y := p1.y*n;
  result.z := p1.z*n;
end;

function set_accuracy(factor:double; p:Point3D) : Point3D;
begin
  result.x := round(p.x*factor)/factor;
  result.y := round(p.y*factor)/factor;
  result.z := round(p.z*factor)/factor;
end;
///////////////////////////////////////////////////////////////////////////////
// Vector 3D stuff
///////////////////////////////////////////////////////////////////////////////
function dot(p1,p2:Point3D) : double;
begin
  result := p1.x*p2.x + p1.y*p2.y + p1.z*p2.z;
end;

function cross(p1,p2:Point3D) : Point3D;
begin
  result.x := p1.y*p2.z - p1.z*p2.y;
  result.y := p1.z*p2.x - p1.x*p2.z;
  result.z := p1.x*p2.y - p1.y*p2.x;
end;

function angle(p1,p2,p3:Point3D; do_3D:boolean) : double;
var
  v1,v2 : Point3D;
  d1,d2 : double;
begin
  v1 := p1_minus_p2(p2,p1);
  v2 := p1_minus_p2(p3,p2);
  if not do_3D then
  begin
    v1.z := 0;
    v2.z := 0;
  end;
  d1 := Mag(v1);
  d2 := Mag(v2);
  if ((d1=0) or (d2=0)) then
    result := 0
  else
  begin
    d1 := dot(v1,v2)/(d1*d2);
    if abs(d1)<=1 then
      result := ArcCos(d1)
    else
      result := 0;
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Rotations for Insert/Block drawing
///////////////////////////////////////////////////////////////////////////////
function XRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
  result := identity;
  result.val[1,1]:= cos_a;
  result.val[1,2]:=-sin_a;
  result.val[2,1]:= sin_a;
  result.val[2,2]:= cos_a;
end;

function YRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
  result := identity;
  result.val[0,0]:= cos_a;
  result.val[0,2]:= sin_a;
  result.val[2,0]:=-sin_a;
  result.val[2,2]:= cos_a;
end;

function ZRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
  result := identity;
  result.val[0,0]:= cos_a;
  result.val[0,1]:=-sin_a;
  result.val[1,0]:= sin_a;
  result.val[1,1]:= cos_a;
end;

function ScaleMatrix(p:Point3D) : Matrix;
begin
  result := identity;
  result.val[0,0] := p.x;
  result.val[1,1] := p.y;
  result.val[2,2] := p.z;
end;

function TranslateMatrix(p:Point3D) : Matrix;
begin
  result := identity;
  result.val[3,0] := p.x;
  result.val[3,1] := p.y;
  result.val[3,2] := p.z;
end;

function MatrixMultiply(matrix1,matrix2:matrix) : Matrix;
var row,column : integer;
begin
  for row:=0 to 3 do
  begin
    for column:=0 to 3 do
      result.val[row,column]:= matrix1.val[row,0]*matrix2.val[0,column] + matrix1.val[row,1]*matrix2.val[1,column] +
                               matrix1.val[row,2]*matrix2.val[2,column] + matrix1.val[row,3]*matrix2.val[3,column];
  end;
end;

var
  GlobalTempMatrix : Matrix;

function update_transformations(OCS_WCS,OCS:pMatrix) : pMatrix;
begin
  if OCS = nil then
    result := OCS_WCS
  else
  if OCS_WCS = nil then
    result := OCS
  else
  begin
    GlobalTempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
    result := @GlobalTempMatrix;
  end;
end;

{ Matrix order : For reference

  start with a point at ( cos(30),sin(30),0 )
  rotate by 30 degrees - shifts point to (1,0,0)
  then translate by (10,0,0) shifts to (11,0,0)
  then rotate by -45 degrees goes to (7.77, 7.77 ,0) 7.77 = Sqrt(11^2 /2 )
  NOTE THE ORDER OF MATRIX OPERATIONS !

    test := aPoint3D( cos(degtorad(30)) , sin(degtorad(30)) , 0);
    mat  := ZRotateMatrix( cos(degtorad(30)) , sin(degtorad(30)) );
    mat  := MatrixMultiply( mat , TranslateMatrix(aPoint3D(10,0,0)) );
    mat  := MatrixMultiply( mat , ZRotateMatrix( cos(degtorad(-45)) , sin(degtorad(-45)) ) );
    test := TransformPoint(mat,test);
}

function CreateTransformation(Ax,Ay,Az:Point3D) : Matrix;
begin
  result := Identity;
  result.val[0,0] :=Ax.x;
  result.val[1,0] :=Ay.x;
  result.val[2,0] :=Az.x;
  result.val[0,1] :=Ax.y;
  result.val[1,1] :=Ay.y;
  result.val[2,1] :=Az.y;
  result.val[0,2] :=Ax.z;
  result.val[1,2] :=Ay.z;
  result.val[2,2] :=Az.z;
end;

function TransformPoint(TM:Matrix; p:Point3D) : Point3D;
begin
  with TM do begin
    result.x := p.x*val[0,0] + p.y*val[1,0] + p.z*val[2,0] + val[3,0];
    result.y := p.x*val[0,1] + p.y*val[1,1] + p.z*val[2,1] + val[3,1];
    result.z := p.x*val[0,2] + p.y*val[1,2] + p.z*val[2,2] + val[3,2];
  end;
end;

function RotationAxis(A:Point3D; angle:double) : Matrix;
var
  sin_a,cos_a : double;
begin
  result := Identity;
  sin_a := sin(angle);
  cos_a := cos(angle);
  result.val[0][0] := (A.x*A.x + (1. - A.x*A.x)*cos_a);
  result.val[1][0] := (A.x*A.y*(1. - cos_a) + A.z*sin_a);
  result.val[2][0] := (A.x*A.z*(1. - cos_a) - A.y*sin_a);

  result.val[0][1] := (A.x*A.y*(1. - cos_a) - A.z*sin_a);
  result.val[1][1] := (A.y*A.y + (1. - A.y*A.y)*cos_a);
  result.val[2][1] := (A.y*A.z*(1. - cos_a) + A.x*sin_a);

  result.val[0][2] := (A.x*A.z*(1. - cos_a) + A.y*sin_a);
  result.val[1][2] := (A.y*A.z*(1. - cos_a) - A.x*sin_a);
  result.val[2][2] := (A.z*A.z + (1. - A.z*A.z)*cos_a);
end;
///////////////////////////////////////////////////////////////////////////////
// Bounds
///////////////////////////////////////////////////////////////////////////////
procedure max_bound(var bounds:Point3D; point:Point3D);
begin
  if point.x>bounds.x then
    bounds.x := point.x;
  if point.y>bounds.y then
    bounds.y := point.y;
  if point.z>bounds.z then
    bounds.z := point.z;
end;

procedure min_bound(var bounds:Point3D; point:Point3D);
begin
  if point.x<bounds.x then
    bounds.x := point.x;
  if point.y<bounds.y then
    bounds.y := point.y;
  if point.z<bounds.z then
    bounds.z := point.z;
end;

function dmin(a,b:double) : double;
begin
  if a < b then
    result := a
  else
    result := b;
end;

function dmax(a,b:double) : double;
begin
  if a>b then
    result := a
  else
    result := b;
end;

function imax(a,b:integer) : integer;
begin
  if a>b then
    result :=a
  else
    result:=b;
end;

function imin(a,b:integer) : integer;
begin
  if a>b then
    result :=b
  else
    result:=a;
end;

///////////////////////////////////////////////////////////////////////////////
// Memory
///////////////////////////////////////////////////////////////////////////////
function allocate_points(n:integer) : ppointlist;
begin
  Getmem(result,n*SizeOf(Point3D));
end;

procedure deallocate_points(var pts:ppointlist; n:integer);
begin
  Freemem(pts,n*SizeOf(Point3D));
  pts := nil;
end;

function allocate_matrix : pMatrix;
begin
  Getmem(result,SizeOf(Matrix));
end;

procedure deallocate_matrix(var m:pMatrix);
begin
  Freemem(m,SizeOf(Matrix));
  m := nil;
end;
///////////////////////////////////////////////////////////////////////////////
// String
///////////////////////////////////////////////////////////////////////////////
function float_out(f:double) : string;
var
  SavedSeparator: Char;
begin
//  result := FloatToStrF(f, ffFixed, 7, 3);
  SavedSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  result := FloatToStrF(f, ffFixed, 7, 3);
  DecimalSeparator := SavedSeparator;
//  result := FloatToStr(f);
end;

function Point3DToStr(p:Point3D) : string;
var
  SavedSeparator: Char;
begin
  SavedSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  result := '(' + FloatToStrF(p.x, ffFixed, 7, 3) + ', ' +
                  FloatToStrF(p.y, ffFixed, 7, 3) + ', ' +
                  FloatToStrF(p.z, ffFixed, 7, 3) + ')';
  DecimalSeparator := SavedSeparator;
end;

function BoolToStr(b:boolean) : string;
begin
  if b then
    result := 'TRUE'
  else
    result := 'FALSE';
end;


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
  // Tolik -- 10/02/20107 --
  OCS_WCS := nil;
  //
  SCS_Layer_Handle := 0;
  scale.x := -10000;
  scale.y := -10000;
  scale.z := -10000;
  rotation := -10000;
  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;
  fcolor := col; //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;
//  fcolor := 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);
var
  DxfColor: Integer;
begin
  writeln(IO, 0, EOL, proper_name);
  writeln(IO, 8, EOL, layer);
  DxfColor := ColorToDxfColor(fColor);
  writeln(IO, 62, EOL, Dxfcolor);
  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;
  scale.x := -10000;
  scale.y := -10000;
  scale.z := -10000;
  rotation := -10000;
  BeginPoint.x := -10000;
  BeginPoint.y := -10000;
  BeginPoint.z := -10000;
  angle := 0;
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
  lp2 : integer;
begin
  for lp2:=0 to entities.count-1 do
  begin
    if (TObject(entities[lp2]) is Insert_) then
      Insert_(entities[lp2]).update_block_links(blist);
  end;
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);
  writeln(IO, 70, EOL, 0);
  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);
var
  i: integer;
begin
  for i := 0 to entities.Count - 1 do
  begin
    DXF_Entity(entities[i]).max_min_extents(emax, emin);
  end;
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;
  fcolor := 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 <> fcolor then
      Color:=fcolor;
  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 <> fcolor then
      Color:=fcolor;
  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);
//var f: TextFile;
begin
  // Tolik -- временно, чтобы  посмотреть цвета
 { AssignFile(f, 'd:\Color.txt');
  Append(f);
  Writeln(f,ss + ' Color  ==  ' + Inttostr(Col));
  CloseFile(f);}
  //
  inherited create(OCSaxis, p, col);
  h := height;
  if ss <> '' then
    textstr := ss;
  if p1_eq_p2_3D(ap, origin3D) then
    ap := p;
  align_pt  := ap;
  hor_align := ha;
  angle := 0;
  ScaleX := 1;
  fcolor := col;
end;

procedure Text_.calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
var
  pa,dummy1,dummy2: TPoint;
  Fheight: integer;
begin
  with acanvas.Pen do
  if Color <> fcolor then
    Color:=fcolor;
  // kludgy method for scaling text heights
  dummy1  := map_fn(origin3D,nil);
  dummy2  := map_fn(aPoint3D(0,h,0),nil);
  Fheight := 2+(dummy1.y-dummy2.y);
  if FHeight=2 then
    exit;
  with acanvas.Font do
  begin
    if Height<>Fheight then
      Height := Fheight;
    if color<>fcolor then
      color := fcolor;
  end;
  case hor_align of
    0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
    1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
    2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
  end;
  pa := map_fn(align_pt,OCS_WCS);
  acanvas.TextOut(pa.x,pa.y,t);
end;

procedure Text_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  calcText(acanvas,map_fn,t_matrix,textstr);
end;

function Text_.details : string;
begin
  result := inherited details + EOL + 'Text '#9 + textstr + EOL + 'TextHeight = ' + float_out(h);
end;

procedure Text_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO, 40, EOL, float_out(h));
  writeln(IO, 1, EOL, textstr);
  if hor_align <> 0 then
  begin
    write_DXF_Point(IO, 11, align_pt);
    writeln(IO, 72, EOL, hor_align);
  end;
  writeln(IO, 50, EOL, float_out(angle));
  writeln(IO, 41, EOL, float_out(ScaleX));
end;

procedure Text_.max_min_extents(var emax,emin:Point3D);
begin
  max_bound(emax,p1); min_bound(emin,p1);
end;
///////////////////////////////////////////////////////////////////////////////
// Attrib
///////////////////////////////////////////////////////////////////////////////
constructor Attrib_.create(OCSaxis,p,ap:Point3D; ss,tag:string; flag70,flag72:integer; height:double; col:integer);
begin
  inherited create(OCSaxis,p,ap,ss,height,col,flag72);
  tagstr := tag;
  if (flag70 and 1) = 1 then
    visible := false
  else
    visible := true;
  fcolor := col;  
end;

procedure Attrib_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  if not visible then
    exit;
  calcText(acanvas,map_fn,t_matrix,tagstr);
end;

function Attrib_.details : string;
var
  t : string;
begin
  if visible then
    t:='Visible'
  else
    t:='Invisible';
  result := inherited details + EOL + 'Tag '#9 + TagStr + EOL + t;
end;

procedure Attrib_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO,2 ,EOL,tagstr);
  if visible then
    writeln(IO,70 ,EOL,0)
  else
    writeln(IO,70 ,EOL,1);
end;
///////////////////////////////////////////////////////////////////////////////
// Attdef
///////////////////////////////////////////////////////////////////////////////
constructor Attdef_.create(OCSaxis,p,ap:Point3D; ss,tag,prompt:string; flag70,flag72:integer; height:double; col:integer);
begin
  inherited create(OCSaxis,p,ap,ss,tag,flag70,flag72,height,col);
  promptstr := prompt;
  fcolor := col;
end;

procedure Attdef_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
begin
  // Attdefs are used in the blocks section to act as templates for Attribs
  // so no need to draw them as there will be an Attrib in its place
end;

procedure Attdef_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO,DXF_text_prompt ,EOL,promptstr);
end;
///////////////////////////////////////////////////////////////////////////////
// Insert
///////////////////////////////////////////////////////////////////////////////
constructor Insert_.create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string; aBeginPoint: Point3D);
var
  lp1 : integer;
begin
  inherited create(OCSaxis,p,col);
  blockname := block;
  blockptr := nil;

  scale := s_f;
  rotation := DegToRad(rot);
  BeginPoint := aBeginPoint;

  init_OCS_WCS_matrix(OCSaxis);
  num_attribs := numatts;
  if num_attribs>max_attribs then
    raise Exception.Create('This version only handles '+IntToStr(max_attribs)+' ATTRIBs');
  for lp1:=0 to num_attribs - 1 do
    attribs[lp1] := atts^[lp1];
  fcolor := col;  
end;

destructor Insert_.destroy;
var
  lp1 : integer;
begin
  for lp1:=0 to num_attribs-1 do
    attribs[lp1].Free;
  inherited destroy;
end;

procedure Insert_.init_OCS_WCS_matrix(OCSaxis:Point3D);
var
  Ax,Ay : Point3D;
  sc1: Point3D;
begin
  // inserts always have a transformation matrix - to allow the translation
  // even when the other parameters are defauls
  OCS_axis := OCSaxis;
  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^ := Identity;
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, ZRotateMatrix(cos(-rotation),sin(-rotation)));

  sc1.x := 1;
  if scale.x < 0 then
    sc1.x := -1;
  sc1.y := 1;
  if scale.y < 0 then
    sc1.y := -1;
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, ScaleMatrix(sc1) );
//  OCS_WCS^ := MatrixMultiply(OCS_WCS^, ScaleMatrix(scale) );

  OCS_WCS^ := MatrixMultiply(OCS_WCS^, TranslateMatrix(p1) );
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, CreateTransformation(Ax,Ay,OCSaxis) );
end;

procedure Insert_.update_block_links(blist:TObject);
var
  Blk: Block_;
begin
  blocklist := blist;
  if (blockname <> '') then { and (blockname <> '_ArchTick') then}
  begin
    Blk := block;
    Blk.update_block_links(blist);
  end;
end;

// instead of searching for the block every time it's needed, we'll store
// the object pointer after the first time it's used, and return it
// when needed. Only use this function to access it - for safety.
function Insert_.block : Block_;
var
  lp1 : integer;
begin
  result := nil;
  if blockptr = nil then
  begin // this bit called once
    for lp1:=0 to Entity_List(blocklist).entities.count-1 do
    begin
      if Block_(Entity_List(blocklist).entities[lp1]).name=blockname then
      begin
        blockptr := Block_(Entity_List(blocklist).entities[lp1]);
        result   := blockptr;
        exit;
      end;
    end;
  end // this bit every subsequent time
  else
    result := blockptr;
  if result=nil then
    raise Exception.Create('Block reference '+blockname+' not found');
end;

procedure Insert_.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 inserts 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 num_attribs-1 do
    attribs[lp1].Draw(acanvas,map_fn,t_matrix);
  if blockname<>'' then
    block.Draw(acanvas,map_fn,t_matrix);
end;

function Insert_.details : string;
var
  lp1 : integer;
begin
  result := inherited details + EOL +
            'Block '#9 + blockname + EOL +
            'Scaling'#9 + Point3DToStr(scale) + EOL +
            'Rotation'#9 + float_out(RadToDeg(rotation)) + EOL +
            'Attribs '#9 + IntToStr(num_attribs);
  for lp1:=0 to num_attribs-1 do
  begin
    result := result + EOL + EOL;
    result := result + IntToStr(lp1+1) + ' : ' + attribs[lp1].details;
  end;
  result := result  + EOL + EOL +
            '----BLOCK-----' + EOL +
            block.details + EOL +
            '---ENDBLOCK---';
end;

procedure Insert_.write_to_DXF(var IO:textfile; layer:string);
var
  lp1 : integer;
begin
  inherited;
  if blockname <> '' then
    writeln(IO,2,EOL,blockname);
  if (scale.x <> 1) or (scale.y <> 1) or (scale.z <> 1) then
  begin
    writeln(IO, 41, EOL, float_out(scale.x));
    writeln(IO, 42, EOL, float_out(scale.y));
    writeln(IO, 43, EOL, float_out(scale.z));
  end;
  if rotation <> 0 then
    writeln(IO, 50, EOL, float_out(RadToDeg(rotation)));
  if num_attribs > 0 then
  begin
    writeln(IO, 66, EOL, 1);
    for lp1 := 0 to num_attribs - 1 do
      attribs[lp1].write_to_DXF(IO, layer);
    writeln(IO, 0, EOL, 'SEQEND');
  end
  else
    writeln(IO,66,EOL,0);
end;

procedure Insert_.max_min_extents(var emax,emin:Point3D);
begin
  inherited;
end;
///////////////////////////////////////////////////////////////////////////////
// Line
///////////////////////////////////////////////////////////////////////////////
constructor Line_.create(p_1,p_2:Point3D; col:integer);
begin
  inherited create(WCS_Z,p_1,col);
  p2 := p_2;
  fcolor := col;
  fLineStyle := 'SOLID';
  LineTypeScale := 1;// Tolik 09/047/2019 -- 
end;

procedure Line_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  pa,pb: TPoint;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  pa := map_fn(p1,t_matrix);
  pb := map_fn(p2,t_matrix);
  acanvas.Moveto(pa.x,pa.y);
  acanvas.Lineto(pb.x,pb.y);
end;

procedure Line_.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<>fcolor then
      Color:=fcolor;
  po := map_fn(p1,t_matrix);
  draw_cross(acanvas,po);
  po := map_fn(p2,t_matrix);
  draw_cross(acanvas,po);
end;

procedure Line_.translate(T:Point3D);
begin
  p1 := p1_plus_p2(p1,T);
  p2 := p1_plus_p2(p2,T);
end;

procedure Line_.quantize_coords(epsilon:double; mask:byte);
begin
  if (mask and 1)=1 then
  begin
    p1.x := round(p1.x*epsilon)/epsilon;
    p2.x := round(p2.x*epsilon)/epsilon;
  end;
  if (mask and 2)=2 then
  begin
    p1.y := round(p1.y*epsilon)/epsilon;
    p2.y := round(p2.y*epsilon)/epsilon;
  end;
  if (mask and 4)=4 then
  begin
    p1.z := round(p1.z*epsilon)/epsilon;
    p2.z := round(p2.z*epsilon)/epsilon;
  end;
end;

function Line_.count_points : integer;
begin
  result := 2;
end;

function Line_.count_lines : integer;
begin
  result := 1;
end;

function Line_.details : string;
begin
  result := inherited details + EOL + Point3DToStr(p2);
end;

procedure Line_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  write_DXF_Point(IO, 11, p2);
  writeln(IO, 6, EOL, fLineStyle);
  writeln(IO, 48, EOL, FloatTostr(LineTypeScale));
end;

procedure Line_.max_min_extents(var emax, emin: Point3D);
begin
  max_bound(emax, p1);
  min_bound(emin, p1);
  max_bound(emax, p2);
  min_bound(emin, p2);
end;

function Line_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin
  result := dmin(sq_dist2D(p1,p),sq_dist2D(p2,p));
end;

function Line_.closest_vertex(p:Point3D) : Point3D;
begin
  if sq_dist2D(p1,p)<sq_dist2D(p2,p) then
    result := p1
  else
    result := p2;
end;

function Line_.Move_point(p,newpoint:Point3D) : boolean;
begin
  if p1_eq_p2_3D(p1,p) then
  begin
    p1 := newpoint;
    result := true;
  end
  else
  if p1_eq_p2_3D(p2,p) then
  begin
    p2 := newpoint;
    result := true;
  end
  else
    result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Circle
///////////////////////////////////////////////////////////////////////////////
constructor Circle_.create(OCSaxis,p_1:Point3D; radius_:double; col:integer);
begin
  inherited create(OCSaxis,p_1,col);
  radius := radius_;
  fcolor := col;
  fLineStyle := 'SOLID';  
end;

constructor Circle_.create_from_polyline(ent1:DXF_Entity);
var
  p_1: Point3D;
  d: double;
  lp1: integer;
begin
  p_1 := origin3D;
  d := 0;
  with Polyline_(ent1) do
  begin
    for lp1:=0 to numvertices - 1 do
      p_1 := p1_plus_p2(polypoints^[lp1],p_1);
    p_1.x := p_1.x/numvertices;
    p_1.y := p_1.y/numvertices;
    p_1.z := p_1.z/numvertices;
    for lp1:=0 to numvertices-1 do
      d := d + dist3D(polypoints^[lp1],p_1);
    d := d/numvertices;
  end;
  inherited create(ent1.OCS_axis,p_1,ent1.colinx);
  radius := d;
end;


procedure Circle_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  pa,pb: TPoint;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
  pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
  // bug in Ellipse routine causes crash if extents are too small
  if (pb.x>pa.x+1) and (pa.y>pb.y+1) then
    acanvas.Ellipse(pa.x,pa.y,pb.x,pb.y)
  else
    acanvas.pixels[pa.x,pa.y] := acanvas.Pen.Color;
end;

function Circle_.details : string;
begin
  result := inherited details + EOL + 'Radius = ' + float_out(radius);
end;

procedure Circle_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO,40,EOL,float_out(radius));
  writeln(IO, 6, EOL, fLineStyle);  
end;

function Circle_.is_point_inside_object2D(p:Point3D) : boolean;
begin
  result := dist2D(p,p1)<=radius;
end;

procedure Circle_.max_min_extents(var emax,emin:Point3D);
var
  lp1 : integer;
begin
  max_bound(emax, p1_plus_p2 (p1, aPoint3D(radius,radius,0)));
  min_bound(emin, p1_minus_p2(p1, aPoint3D(radius,radius,0)));
end;
///////////////////////////////////////////////////////////////////////////////
// Arc
///////////////////////////////////////////////////////////////////////////////
constructor Arc_.create(OCSaxis,p_1:Point3D; radius_,sa,ea:double; col:integer);
begin
  inherited create(OCSaxis,p_1, radius_, col);
  angle1 := DegToRad(sa);
  angle2 := DegToRad(ea);
  fcolor := col;
  fLineStyle := 'SOLID';
end;


procedure Arc_.Draw(acanvas: TCanvas; map_fn:coord_convert; OCS: pM);
var
  pu,pv,pw,px : TPoint;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color <> fcolor then
      Color := fcolor;
  pu := map_fn(aPoint3D(p1.x - radius, p1.y - radius, p1.z - radius), t_matrix);
  pv := map_fn(aPoint3D(p1.x + radius, p1.y + radius, p1.z + radius), t_matrix);
  pw := map_fn(aPoint3D(p1.x + cos(angle1) * radius, p1.y + sin(angle1) * radius, p1.z + radius), t_matrix);
  px := map_fn(aPoint3D(p1.x + cos(angle2) * radius,p1.y + sin(angle2) * radius, p1.z + radius), t_matrix);
  if (pv.x > pu.x + 1) and (pu.y > pv.y + 1) then
    acanvas.Arc(pu.x, pu.y, pv.x, pv.y, pw.x, pw.y, px.x, px.y)
  else
    acanvas.pixels[pu.x, pu.y] := acanvas.Pen.Color;
end;

function Arc_.details : string;
begin
  result := inherited details + EOL + 'Angle 1 = ' + float_out(angle1) + EOL +
                                      'Angle 2 = ' + float_out(angle2);
end;

procedure Arc_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO, 50, EOL, float_out(RadToDeg(angle1)));
  writeln(IO, 51, EOL, float_out(RadToDeg(angle2)));
  writeln(IO, 6, EOL, fLineStyle);  
end;

function Arc_.is_point_inside_object2D(p:Point3D) : boolean;
begin
  result := false;
end;

procedure Arc_.max_min_extents(var emax,emin:Point3D);
var
  lp1: integer;
  ax,ay,bx,by: double;
  thisboundary: integer;
  lastboundary: integer;
begin
  // the end points of the arc
  ax := p1.x + radius * cos(angle1);
  ay := p1.y + radius * sin(angle1);
  bx := p1.x + radius * cos(angle2);
  by := p1.y + radius * sin(angle2);
  max_bound(emax, aPoint3D(ax, ay, 0));
  min_bound(emin, aPoint3D(ax, ay, 0));
  max_bound(emax, aPoint3D(bx, by, 0));
  min_bound(emin, aPoint3D(bx, by, 0));
  // test

  if angle1 < 0 then
  begin
    while abs(angle1) > 2*Pi do
      angle1 := angle1 + 2*Pi;
    angle1 := angle1 + 2 * pi;
  end;
  if angle2 < 0 then
  begin
    while abs(angle2) > 2*Pi do
      angle2 := angle2 + 2*Pi;
    angle2 := angle2 + 2 * pi;
  end;
  //

  // long arcs may extend along the axes (quadrants) (eg 1 to 359 ->90,180,270)
  lastboundary := 90 * ((trunc(RadToDeg(angle2)) + 89) div 90);
  if lastboundary = 360 then
    lastboundary := 0;
  thisboundary := 90 * ((trunc(RadToDeg(angle1)) + 90) div 90);
  if thisboundary = 360 then
    thisboundary := 0;
  while thisboundary <> lastboundary do
  begin
    ax := p1.x + radius * cos(DegToRad(thisboundary));
    ay := p1.y + radius * sin(DegToRad(thisboundary));
    max_bound(emax, aPoint3D(ax, ay, 0));
    min_bound(emin, aPoint3D(ax, ay, 0));
    thisboundary := thisboundary + 90;
    if thisboundary = 360 then
      thisboundary := 0;
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline
///////////////////////////////////////////////////////////////////////////////
constructor Polyline_.create(OCSaxis: Point3D; numpoints: integer; points: ppointlist; col: integer; closed_: boolean);
var
  lp1 : integer;
begin
  inherited create;
  init_OCS_WCS_matrix(OCSaxis);
  numvertices := numpoints;
  if closed_ then
    closed := true
  else
  if p1_eq_p2_3D(points[0], points[numvertices - 1]) then
  begin
    closed := true;
    dec(numvertices);
  end
  else
    closed := false;
  polypoints := allocate_points(numvertices);
  for lp1:=0 to numvertices - 1 do
    polypoints^[lp1] := points^[lp1];

  fcolor := col;

  fLineStyle := 'SOLID';
end;

destructor Polyline_.destroy;
begin
  deallocate_points(polypoints,numvertices);
  inherited destroy;
end;


procedure Polyline_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  PointArray: array[0..max_vertices_per_polyline-1] of TPoint;
  lp1,tn: integer;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  if not closed then
    acanvas.Polyline(Slice(PointArray,numvertices))
  else
    acanvas.Polygon(Slice(PointArray,numvertices));
end;

procedure Polyline_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  po: TPoint;
  lp1: integer;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numvertices-1 do
  begin
    po := map_fn(polypoints^[lp1],t_matrix);
    draw_cross(acanvas,po);
  end;
end;

procedure Polyline_.translate(T:Point3D);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices-1 do
    polypoints^[lp1] := p1_plus_p2(polypoints^[lp1],T);
end;

procedure Polyline_.quantize_coords(epsilon:double; mask:byte);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices-1 do
  begin
    if (mask and 1)=1 then
      polypoints^[lp1].x := round(polypoints^[lp1].x*epsilon)/epsilon;
    if (mask and 2)=2 then
      polypoints^[lp1].y := round(polypoints^[lp1].y*epsilon)/epsilon;
    if (mask and 4)=4 then
      polypoints^[lp1].z := round(polypoints^[lp1].z*epsilon)/epsilon;
  end;
end;

function Polyline_.count_points   : integer;
begin
  result := numvertices;
end;

function Polyline_.count_lines : integer;
begin
  result := numvertices;
end;

function Polyline_.count_polys_open : integer;
begin
  if not closed then
    result := 1
  else
    result := 0;
end;

function Polyline_.count_polys_closed : integer;
begin
  if closed then
    result := 1
  else
    result := 0;
end;

function Polyline_.details : string;
var
  lp1 : integer;
  t   : string;
begin
  if OCS_WCS <> nil then
    t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else
    t := 'WCS';
  result := classname + EOL + t;
  if closed then
    result := result + EOL + 'Closed'
  else
    result := result + EOL + 'Open';
  for lp1:=0 to numvertices-1 do
    result := result + EOL + Point3DToStr(polypoints^[lp1]);
end;

procedure Polyline_.write_to_DXF(var IO:textfile; layer:string);
var
  lp1 : integer;
begin
  inherited;
  if closed then
    writeln(IO, 70, EOL, 1 + 8) // 1+8 = closed+3D
  else
    writeln(IO, 70, EOL, 8);
  writeln(IO, 66, EOL, 1);
  writeln(IO, 6, EOL, fLineStyle);
  for lp1 := 0 to numvertices - 1 do
  begin
    writeln(IO, 0, EOL, 'VERTEX');
    writeln(IO, 8, EOL, layer);
    writeln(IO, 70, EOL, 32);    // 3D polyline mesh vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  writeln(IO, 0, EOL, 'SEQEND');
end;

procedure Polyline_.max_min_extents(var emax,emin:Point3D);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices - 1 do
  begin
    max_bound(emax,polypoints^[lp1]); min_bound(emin,polypoints^[lp1]);
  end;
end;

function Polyline_.closest_vertex_square_distance_2D(p:Point3D) : double;
var
  lp1 : integer;
begin
  result := 1E10;
  for lp1:=0 to numvertices-1 do
    result := dmin(result,sq_dist2D(polypoints^[lp1],p));
end;

function Polyline_.closest_vertex(p:Point3D) : Point3D;
var
  lp1,c : integer;
  d1,d2 : double;
begin
  d1 := 1E10;
  for lp1:=0 to numvertices-1 do
  begin
    d2 := sq_dist2D(polypoints^[lp1],p);
    if d2<d1 then
    begin
      result := polypoints^[lp1];
      d1 := d2;
    end;
  end;
end;

function Polyline_.Move_point(p,newpoint:Point3D) : boolean;
var
  lp1  : integer;
begin
  for lp1:=0 to numvertices-1 do
  begin
    if p1_eq_p2_3D(polypoints^[lp1],p) then
    begin
      polypoints^[lp1] := newpoint;
      result := true;
      exit;
    end;
  end;
  result := false;
end;

function Polyline_.triangle_centre : Point3D;
var
  s,t : integer;
begin
  if numvertices<>3 then
    raise Exception.Create('Shouldn''t call this for non triangular facets');
  s := 1;
  t := 2;
  result := p1_plus_p2(polypoints^[0],p1_plus_p2(polypoints^[s],polypoints^[t]));
  result := p1_x_n(result,1/3);
end;

procedure Polyline_.set_attrib(i:integer; v:double);
begin
  if (i+1)>numattrs then
    numattrs:=(i+1);
  attribs[i] := v;
end;

function Polyline_.get_attrib(i:integer) : double;
begin
  if i>=numattrs then
    result := 0
  else
    result := attribs[i];
end;

procedure Polyline_.copy_attribs(p:Polyline_);
var
  lp1 : integer;
begin
  p.numattrs := numattrs;
  for lp1:=0 to numattrs-1 do
    p.attribs[lp1] := attribs[lp1];
end;

function Polyline_.is_point_inside_object2D(p:Point3D) : boolean;
var
  i,j: integer;
  p1_i,p1_j: Point3D;
begin
  result := false;
  if not closed then
    exit;
  j := numvertices-1;
  for i:=0 to numvertices-1 do with p do
  begin
    p1_i := polypoints^[i];
    p1_j := polypoints^[j];
    if ((((p1_i.y<=y) and (y<p1_j.y)) or ((p1_j.y<=y) and (y<p1_i.y))) and
       (x<(p1_j.x - p1_i.x)*(y-p1_i.y) / (p1_j.y - p1_i.y) + p1_i.x)) then
        result:= not result;
    j:=i;
  end;
end;

///////////////////////////////////////////////////////////////////////////////
// Face3D
///////////////////////////////////////////////////////////////////////////////
constructor Face3D_.create(numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
begin
  inherited create(WCS_Z,numpoints,points,col,closed_);
  fcolor := col;
end;

function Face3D_.proper_name : string;
begin
  result := '3DFACE';
end;

procedure Face3D_.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,62,EOL,colinx);
  for lp1:=0 to numvertices-1 do
    write_DXF_Point(IO, 10 + lp1, polypoints^[lp1]);
  if numvertices=3 then
  begin // 4th point is same as third
    lp1 := 3;
    write_DXF_Point(IO, 10 + lp1, polypoints^[lp1-1]);
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Solid_
///////////////////////////////////////////////////////////////////////////////
constructor Solid_.create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
begin
  inherited create(numpoints,points,col,true);
  thickness := t;
  init_OCS_WCS_matrix(OCSaxis);
  fcolor := col;
end;

function Solid_.proper_name : string;
begin
  result := 'SOLID';
end;

procedure Solid_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO, 39, EOL, float_out(thickness));
end;

function Solid_.details : string;
begin
  result := inherited details + EOL +
            'Thickness'#9 + float_out(thickness);
end;

///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polygon_mesh_.create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
begin
  inherited create(WCS_Z,numpoints,points,col,false);
  M := Mc; N := Nc;
  closeM := (closebits and 1 )=1;
  closeN := (closebits and 32)=32;
  fcolor := col;
end;

function Polygon_mesh_.proper_name : string;
begin
  result := 'POLYLINE';
end;

procedure Polygon_mesh_.write_to_DXF(var IO:textfile; layer:string);
var
  lp1,flag : integer;
begin
  writeln(IO, 0, EOL,proper_name);
  writeln(IO, 8, EOL,layer);
  writeln(IO, 62, EOL, colinx);
  writeln(IO, 66, EOL, 1);
  flag := 16;
  if closeM then
    flag := flag+1;
  if closeN then
    flag := flag+32;
  writeln(IO,70 ,EOL,flag);
  writeln(IO,71 ,EOL,M);
  writeln(IO,72 ,EOL,N);
  for lp1:=0 to numvertices-1 do
  begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,64);    // polygon mesh vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  writeln(IO,0 ,EOL,'SEQEND');
end;

function Polygon_mesh_.details : string;
var
  t : string;
begin
  if OCS_WCS<>nil then
    t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else
    t := 'WCS';
  result := 'Polyline_ (polygon mesh)' + EOL + t + EOL +
            'Vertices'#9 + IntToStr(numvertices) + EOL +
            'M'#9 + IntToStr(M) + EOL +
            'N'#9 + IntToStr(N) + EOL +
            'Closed M'#9 + BoolToStr(closeM) + EOL +
            'Closed N'#9 + BoolToStr(closeN);
end;

type
  ptarray = array[0..max_vertices_per_polyline-1] of TPoint;
  pptarray = ^ptarray;


procedure Polygon_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  PointArray : array[0..max_vertices_per_polyline-1] of TPoint;
  tp : TPoint;
  lp1,lp2,inx : integer;
  t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  // draw the M N-length polylines - we can use the array directly
  if closeN then
    for lp1:=0 to M-1 do
      acanvas.Polygon( Slice(pptarray(@PointArray[N*lp1])^,N))
  else
  for lp1:=0 to M-1 do
    acanvas.Polyline(Slice(pptarray(@PointArray[N*lp1])^,N));
  // draw the N M-length polylines - we need to hop along the array in M steps
  for lp1:=0 to N-1 do
  begin
    acanvas.MoveTo(PointArray[lp1].x,PointArray[lp1].y);
    for lp2:=1 to M-1 do
    begin
      tp := PointArray[lp2*N+lp1];
      acanvas.LineTo(tp.x,tp.y);
    end;
    if closeM then
      acanvas.LineTo(PointArray[lp1].x,PointArray[lp1].y);
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polyface_mesh_.create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
var
  lp1 : integer;
begin
  DXF_Entity.create; // don't call polyline_constructor
  numvertices := numpoints;
  numfaces    := nfaces;
  polypoints  := allocate_points(numvertices);
  for lp1:=0 to numvertices-1 do
    polypoints^[lp1] := points^[lp1];
  Getmem(facelist,numfaces*SizeOf(polyface));
  for lp1:=0 to numfaces-1 do
    facelist^[lp1] := faces^[lp1];
  fcolor := col;
end;

destructor Polyface_mesh_.destroy;
begin
  Freemem(facelist,numfaces*SizeOf(polyface));
  inherited destroy;
end;

function Polyface_mesh_.proper_name : string;
begin
  result := 'POLYLINE';
end;

procedure Polyface_mesh_.write_to_DXF(var IO:textfile; layer:string);
var
  lp1,lp2,inx : integer;
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  writeln(IO,62,EOL,colinx);
  writeln(IO,66,EOL,1);
  writeln(IO,70,EOL,64);
  writeln(IO,71,EOL,numvertices);
  writeln(IO,72,EOL,numfaces);
  for lp1:=0 to numvertices-1 do
  begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,64+128);    // polyface mesh coordinate vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  for lp1:=0 to numfaces-1 do
  begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,128);    // polyface mesh face vertex
    for lp2:=0 to 3 do writeln(IO,71+lp2 ,EOL,facelist^[lp1].nf[lp2]+1);
  end;
  writeln(IO,0 ,EOL,'SEQEND');
end;

function Polyface_mesh_.details : string;
var
  t : string;
begin
  if OCS_WCS<>nil then
    t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else
    t := 'WCS';
  result := 'Polyline_ (polyface mesh)' + EOL + t + EOL +
            'Vertices'#9 + IntToStr(numvertices) + EOL +
            'Faces'#9 + IntToStr(numfaces);
end;


procedure Polyface_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  PointArray  : array[0..3] of TPoint;
  lp1,lp2,inx : integer;
  t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numfaces-1 do
  begin
    for lp2:=0 to 3 do
    begin
      inx := facelist^[lp1].nf[lp2];
      if inx<0 then
        break; // index -> -1 = end of vertices
      PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
    end;
    acanvas.Polygon(Slice(PointArray,lp2));
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Entity_List.create(l_name:string);
begin
  list_name := l_name;
  entities := TList.Create;
  inc(Ent_lists_in_existence);
end;

destructor Entity_List.destroy;
var
  lp1 : integer;
  // Tolik
  ent: DXF_Entity;
  //
begin
  for lp1:=0 to (entities.Count-1) do
  begin
    // DXF_Entity(entities[lp1]).Free;
    ent := DXF_Entity(entities[lp1]);
    try
      ent.free;
    except
      on E: Exception do AddExceptionToLogEx('U_DXFEngineSCS.Entity_List.Destroy', E.Message);
    end;
  end;
  entities.Free;
  dec(Ent_lists_in_existence);
  inherited destroy;
end;

function Entity_List.add_entity_to_list(entity:DXF_Entity) : boolean;
begin
  if sorted then
    result := insert(entity)
  else
    result := add_at_end(entity);
end;

function Entity_List.remove_entity(ent:DXF_Entity) : boolean;
var
  lp1 : integer;
begin
  result := false;
  for lp1:=0 to (entities.Count-1) do
  begin
    if entities[lp1]=ent then
    begin
      entities.remove(ent);
      ent.free;
      result := true;
      exit;
    end;
  end;
end;

function Entity_List.add_at_end(entity:DXF_Entity) : boolean;
begin
  entities.Add(entity);
end;

function Entity_List.insert(entity:DXF_Entity) : boolean;
begin
  entities.Add(entity);
end;

procedure Entity_List.draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
  lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do
  begin
    DXF_Entity(entities[lp1]).Draw(acanvas, map_fn,OCS);
  end;
end;

procedure Entity_List.draw_vertices(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 Entity_List.num_entities : integer;
begin
  result := entities.Count;
end;

function Entity_List.count_points : integer;
var
  lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_points;
end;

function Entity_List.count_lines : integer;
var
  lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_lines;
end;

function Entity_List.count_polys_open : integer;
var
  lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_polys_open;
end;

function Entity_List.count_polys_closed : integer;
var
  lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_polys_closed;
end;

procedure Entity_List.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;

procedure Entity_List.setcolour(col:integer);
var
  lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do
    DXF_Entity(entities[lp1]).fcolor := col;
end;

function Entity_List.closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
var
  lp1 : integer;
  cl_ : DXF_Entity;
  t : double;
begin
  result := 1E10;
  for lp1:=0 to (entities.Count-1) do
  begin
    cl_ := DXF_Entity(entities[lp1]);
    t   := cl_.closest_vertex_square_distance_2D(p);
    if t<result then
    begin
      cl := cl_;
      result := t;
    end;
  end;
end;

function Entity_List.find_bounding_object(p:Point3D) : DXF_Entity;
var
  lp1 : integer;
  ent : DXF_Entity;
begin
  result := nil;
  for lp1:=0 to (entities.Count-1) do
  begin
    ent := DXF_Entity(entities[lp1]);
    if ent.is_point_inside_object2D(p) then
    begin
      result := ent;
      exit;
    end;
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_layer class implementation
///////////////////////////////////////////////////////////////////////////////
constructor DXF_Layer.create(l_name:string);
begin
  SCS_Layer_Handle := 0;
  layer_name   := l_name;
  entity_names := TStringList.Create;
  entity_lists := TList.Create;
  inc(layers_in_existence);
end;
// Tolik -- 10/02/2017 -- старый деструктор смотри ниже
destructor DXF_Layer.destroy;
var
  lp1 : integer;
  el : Entity_List;
begin
  for lp1 := entity_lists.Count -1 downto 0 do
  begin
    el := Entity_List(entity_lists[lp1]);
    el.Free;
  end;

  entity_names.Free;
  entity_lists.Free;
  dec(layers_in_existence);
  inherited destroy;
end;
{
destructor DXF_Layer.destroy;
var
  lp1 : integer;
  el : Entity_List;
begin
  if num_lists>0 then
  begin
    for lp1:=num_lists-1 downto 0 do
    begin
      el := Entity_List(entity_lists[lp1]);
      el.Free;
    end;
  end;
  entity_names.Free;
  entity_lists.Free;
  dec(layers_in_existence);
  inherited destroy;
end;
}

procedure DXF_Layer.delete(aname:string; releasemem:boolean);
var
  lp1 : integer;
  el  : Entity_List;
begin
  for lp1:=num_lists-1 downto 0 do
  begin
    el := Entity_List(entity_lists[lp1]);
    if el.name=aname then
    begin
      entity_lists.remove(el);
      if releasemem then
        el.Free;
      entity_names.delete(lp1);
    end;
  end;
end;

function DXF_Layer.add_entity_to_layer(entity:DXF_Entity) : boolean;
var
  i: integer;
  el: Entity_List;
begin
  i := entity_names.IndexOf(entity.ClassName);
  if i= - 1 then
  begin
    el := Entity_List.create(entity.ClassName);
    el.parent_layer := self;
    i  := entity_lists.Add(el);
    if i <> entity_names.Add(entity.ClassName) then
      raise Exception.Create('Entity list ID mismatch');
    // This has never been raised yet, but might as well be sure.
  end;
  Entity_List(entity_lists[i]).add_entity_to_list(entity);
  if ((entity.fcolor = 0) or (entity.fcolor = BYLAYER)) then
    entity.setcolour_index(layer_colinx);
  result := true;
end;

procedure DXF_Layer.add_entity_list(elist:Entity_List);
var
  i : integer;
begin
  i := entity_names.IndexOf(elist.name);
  if i<>-1 then
    raise Exception.create('Attempted to add two lists with same name');
  elist.parent_layer := self;
  i  := entity_lists.Add(elist);
  if i<>entity_names.Add(elist.Name) then
    raise Exception.Create('Entity list ID mismatch');
end;

function DXF_Layer.num_lists : integer;
begin
  result := entity_names.Count;
end;

procedure DXF_Layer.max_min_extents(var emax, emin: Point3D);
var
  lp1 : integer;
begin
  for lp1 := 0 to num_lists - 1 do
    Entity_List(entity_lists[lp1]).max_min_extents(emax, emin);
end;

function DXF_Layer.create_or_find_list_type(aname:string) : Entity_List;
var
  inx : integer;
begin
  inx := entity_names.IndexOf(aname);
  if inx=-1 then
  begin
    result := Entity_List.create(aname);
    result.parent_layer := self;
    inx    := entity_lists.Add(result);
    if inx<>entity_names.Add(aname) then
      raise Exception.Create('Entity list ID mismatch');
  end
  else
    result := Entity_List(entity_lists[inx]);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Object class implementation
///////////////////////////////////////////////////////////////////////////////
constructor DXF_ObjectSCS.create(aname:string);
begin
  layer_lists := TList.create;
  if aname<>'' then
    DXF_name := aname
  else
    DXF_name := 'Untitled';
  emax := origin3D;
  emin := origin3D;
  inc(DXF_Obj_in_existence);
end;

constructor DXF_ObjectSCS.create_from_file(aname:string; skipped:Tstrings);
var
  reader : DXF_Reader;
begin
  try
    Reader := DXF_Reader.Create(aname);
    Reader.set_skipped_list(skipped);
    With Reader do
    if (read_file) then
    begin
      name := ExtractFileName(aname);
      emax := get_max_extent;
      emin := get_min_extent;
      layer_lists := release_control_of_layers;
    end
    else
    begin
      layer_lists := TList.create;
      DXF_name := aname;
      emax := origin3D;
      emin := origin3D;
    end;
    Reader.Free;
    inc(DXF_Obj_in_existence);
  except
    on E: Exception do AddExceptionToLogEx('DXF_ObjectSCS.create_from_file', E.Message);
  end;
end;

// Tolik -- 10/02/2017 -- старый смотри ниже, этот полностью переписан,
// чтобы можно было нормально удалить объект и освободить занятую память

destructor DXF_ObjectSCS.destroy;
var
  i : integer;
  EntList: TList;

  procedure AddEntitiesToDelList(aLayer: DXF_Layer);
  var i: Integer;
      Entity: DXF_Entity;

      procedure AddEntityToList(aEnt: DXF_Entity);
      var i: Integer;
          Ent: DXF_Entity;
      begin

        if aEnt.ClassName = Block_.ClassName then
        begin
          for i := 0 to Block_(aEnt).entities.Count - 1 do
          begin
            AddEntityToList(DXF_Entity(Block_(aEnt).entities[i]));
          end;
          Block_(aEnt).entities.Clear;
          {if EntList.IndexOf(aEnt) = -1 then
            EntList.Add(aEnt);}
        end
        else
          if aEnt.ClassName = Entity_List.ClassName then
          begin
            for i := 0 to Entity_List(aEnt).entities.Count - 1 do
            begin
              AddEntityToList(DXF_Entity(Entity_List(aEnt).entities[i]));
            end;
            Entity_List(aEnt).entities.Clear;
            {if EntList.IndexOf(aEnt) = -1 then
              EntList.Add(aEnt);}
          end;
          //  else
        if EntList.IndexOf(aEnt) = -1 then
          EntList.Add(aEnt);

      end;
  begin
    for i := 0 to aLayer.entity_lists.Count - 1 do
    begin
      Entity := DXF_Entity(aLayer.entity_lists[i]);
      AddEntityToList(Entity);
    end;
  end;

begin
  EntList := TList.Create;

  for i := 0 to layer_lists.Count - 1 do
  begin

    AddEntitiesToDelList(DXF_Layer(layer_lists.Items[i]));

    DXF_Layer(layer_lists.Items[i]).entity_lists.Clear;
    DXF_Layer(layer_lists.Items[i]).entity_lists.Clear;
    DXF_Layer(layer_lists.Items[i]).Free;
  end;
  for i := 0 to EntList.Count - 1 do
    DXF_Entity(EntList[i]).destroy;

  EntList.Clear;
  layer_lists.Free;
  dec(DXF_Obj_in_existence);
  inherited destroy;
end;
{
destructor DXF_ObjectSCS.destroy;
var
  lp1 : integer;
begin
  for lp1:=0 to layer_lists.Count-1 do
    DXF_Layer(layer_lists.Items[lp1]).Free;
  layer_lists.Free;
  dec(DXF_Obj_in_existence);
  inherited destroy;
end;
}
//


procedure DXF_ObjectSCS.save_to_file(aname:string);
var
  Writer : DXF_Writer;
begin
  writer := DXF_writer.create(aname,layer_lists);
  writer.write_file;
  writer.free;
end;

function DXF_ObjectSCS.num_layers : integer;
begin
  result := layer_lists.Count
end;

function DXF_ObjectSCS.new_layer(aname:string; DUPs_OK:boolean) : DXF_Layer;
var
  lp1 : integer;
begin
  for lp1:=0 to layer_lists.Count-1 do
  begin
    if DXF_Layer(layer_lists[lp1]).name = aname then
    begin
      if not DUPs_OK then
        raise DXF_Exception.Create('Attempted to create layer with existing name');
      result := DXF_Layer(layer_lists[lp1]);
      exit;
    end;
  end;
  result := DXF_Layer.Create(aname);
  layer_lists.Add(result);
end;

function DXF_ObjectSCS.add_layer(layer:DXF_Layer) : boolean;

var
  lp1  : integer;
  LayExist: Boolean;
  // Tolik -- 16/02/2017 -- слои с одинаковыми именами не допускаются, поэтому будем делать так...
  // это нужно только тогда, когда сохраняем проект с уже существующими DXF - слоями
  Procedure CheckRenameLayer;
  var i: Integer;
      LayerNameExists: Boolean;
  begin
    LayerNameExists := false;

    for i := 0 to layer_lists.Count - 1 do
    begin
      if DXF_Layer(layer_lists[i]).name = layer.name then
      begin
        LayerNameExists := True;
        layer.name := layer.name + '1';
      end;
      if LayerNameExists then
        CheckRenameLayer;
    end;
  end;
  //
begin
  LayExist := False;
  // Tolik -- 16/02/2017 --
  CheckRenameLayer;

  (*
  for lp1:=0 to layer_lists.Count - 1 do
    if DXF_Layer(layer_lists[lp1]).name = layer.name then
      LayExist := True;
//      raise DXF_Exception.Create('Attempted to add layer with existing name');
  if not LayExist then
  *)
  //
    layer_lists.Add(layer);
end;

function DXF_ObjectSCS.layer(aname:string) : DXF_Layer;
var
  lp1 : integer;
begin
  result := nil;
  for lp1:=0 to layer_lists.Count-1 do
    if DXF_Layer(layer_lists[lp1]).name=aname then
    begin
      result := DXF_Layer(layer_lists[lp1]);
      exit;
    end;
end;

// Avoid using this if possible because we have to search for layer name every time
function DXF_ObjectSCS.add_entity_to_layer(entity:DXF_Entity; aname:string) : boolean;
var
  lp1 : integer;
begin
  for lp1:=0 to layer_lists.Count-1 do
    if DXF_Layer(layer_lists[lp1]).name=aname then
    begin
      DXF_Layer(layer_lists[lp1]).add_entity_to_layer(entity);
      result := true;
      exit;
    end;
  raise DXF_Exception.Create('Attempted to add to unnamed layer');
end;

function DXF_ObjectSCS.create_or_find_layer(aname:string) : DXF_Layer;
var
  lp1  : integer;
begin
  for lp1:=0 to layer_lists.Count-1 do
    if DXF_Layer(layer_lists[lp1]).name=aname then
    begin
      result := DXF_Layer(layer_lists[lp1]);
      exit;
    end;
  result := new_layer(aname, true);
end;

function DXF_ObjectSCS.merge_files(DXF_:DXF_ObjectSCS) : boolean;
var
  lp1,lp2,lp3,lp4 : integer;
  layer1,layer2 : DXF_Layer;
  elist1,elist2,blist : Entity_List;
  ent : DXF_Entity;
begin
  // rather annoyingly we have to keep track of insert/block lookups
  layer2 := create_or_find_layer('0');
  blist := layer2.create_or_find_list_type('Block_');
  //
  for lp1:=0 to DXF_.layer_lists.Count-1 do
  begin
    layer1 := DXF_.layer_lists[lp1];
    layer2 := create_or_find_layer(layer1.name);
    for lp2:=0 to layer1.entity_lists.count-1 do
    begin
      elist1 := layer1.entity_lists[lp2];
      elist2 := layer2.create_or_find_list_type(elist1.name);
      for lp3:=elist1.entities.count-1 downto 0 do
      begin
        ent := elist1.entities[lp3];
        elist2.Add_entity_to_list(ent);
        elist1.entities.remove(ent);
        if ent is Insert_ then
          ent.update_block_links(blist);
      end;
    end;
  end;
end;

procedure DXF_ObjectSCS.remove_empty_layers_and_lists;
var
  lp1,lp2 : integer;
  layer: DXF_Layer;
  el: Entity_List;
begin
  for lp1:=layer_lists.Count-1 downto 0 do
  begin
    layer := DXF_Layer(layer_lists[lp1]);
    for lp2:=layer.num_lists-1 downto 0 do
    begin
      el := Entity_List(layer.entity_lists[lp2]);
      if el.num_entities=0 then
      begin
        layer.entity_lists.remove(el);
        layer.entity_names.delete(lp2);
        el.Free;
        if layer.entity_lists.count<>layer.entity_names.count then
          showmessage('Internal error : Layer lists and names mismatch');
      end;
    end;
    if layer.num_lists=0 then
    begin
      layer_lists.remove(layer);
      layer.Free;
    end;
  end;
end;

procedure DXF_ObjectSCS.copy_to_strings(ts:TStrings);
var
  lp1,lp2,pos : integer;
  layer : DXF_Layer;
begin
  ts.Add(DXF_name);
  for lp1:=0 to layer_lists.count-1 do
  begin
    layer := layer_lists[lp1];
    pos := ts.Add('  '+layer.name);
    ts.Objects[pos] := layer;
    for lp2:=0 to layer.num_lists-1 do
    begin
      pos := ts.Add('    '+Entity_List(layer.entity_lists[lp2]).name);
      ts.Objects[pos] := layer.entity_lists[lp2];
    end;
  end;
end;

function DXF_ObjectSCS.get_min_extent : Point3D;
begin
  result := emin;
end;

function DXF_ObjectSCS.get_max_extent : Point3D;
begin
  result := emax;
end;

procedure DXF_ObjectSCS.max_min_extents(var emax,emin:Point3D);
var
  lp1 : integer;
begin
  for lp1:=0 to layer_lists.Count-1 do
    DXF_Layer(layer_lists[lp1]).max_min_extents(emax,emin);
end;
///////////////////////////////////////////////////////////////////////////////
// Selection_lists class implementation
///////////////////////////////////////////////////////////////////////////////
constructor selection_lists.create;
begin
  entity_lists := TList.Create;;
end;

destructor selection_lists.destroy;
begin
  entity_lists.Free;
  inherited destroy;
end;

procedure selection_lists.save_to_DXF_file(aname:string);
var
  lp1,lp2 : integer;
  DXF : DXF_ObjectSCS;
  layer: DXF_layer;
  el : Entity_List;
begin
  DXF := DXF_ObjectSCS.create('');
  for lp1:=0 to entity_lists.count-1 do
  begin
    el := Entity_List(entity_lists[lp1]);
    el.Kludge_layer := el.parent_layer; // we need to keep track of where they came from
    layer := DXF.new_layer(el.parent_layer.name,true);
    layer.add_entity_list(el);
  end;
  DXF.save_to_file(aname);
  // now get the lists back from the temporary DXF object (without it deleting them)
  for lp1:=DXF.layer_lists.count-1 downto 0 do
  begin
    layer := DXF_Layer(DXF.layer_lists[lp1]);
    for lp2:=layer.entity_lists.count-1 downto 0 do
      layer.delete(Entity_List(layer.entity_lists[lp2]).name,FALSE);
  end;
  DXF.Free;
  // reset the parent layer of the entity_lists
  for lp1:=0 to entity_lists.count-1 do
  begin
    el := Entity_List(entity_lists[lp1]);
    el.parent_layer := el.Kludge_layer; // we stored them temporarily
  end;
end;

function selection_lists.find_closest_2D_point(p:Point3D; var ent:DXF_Entity) : Point3D;
var
  lp1: integer;
  dist,mind : double;
  entx : DXF_Entity;
begin
  mind := 1E10;
  for lp1:=0 to entity_lists.count-1 do
  begin
    dist := Entity_List(entity_lists[lp1]).closest_vertex_square_distance_2D(p,entx);
    if dist<mind then
    begin
      result := entx.closest_vertex(p);
      ent    := entx;
      mind   := dist;
    end;
  end;
end;

function selection_lists.is_inside_object(p:Point3D; var ent:DXF_Entity) : Point3D;
var
  lp1: integer;
  entx: DXF_Entity;
begin
  result := origin3D;
  for lp1:=0 to entity_lists.count-1 do
  begin
    entx := Entity_List(entity_lists[lp1]).find_bounding_object(p);
    if entx<>nil then
    begin
      result := entx.closest_vertex(p);
      ent := entx;
      exit;
    end;
  end;
end;



// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// Generating PowerCAD source
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


function DXF_ObjectSCS.GetPCPoint(P:Point3D; OCS:pMatrix): TDoublePoint;
var
  tc : Point3D;
begin
  try
    if OCS=nil then
    begin
      result.x := P.x - pcww;
      result.y := P.y - pcwh;
    end
    else
    begin
      tc := TransformPoint(OCS^,P);
      result.x := tc.x - pcww;
      result.y := tc.y - pcwh;
    end;
    if CadHeight > 0 then
      result.y := CadHeight - result.y;
    if CadWidth > 0 then
      result.x := CadWidth - result.x;
  except

 end;
end;


function DXF_Entity.ExportToPowerCad(Cad: TPCDrawing;
  map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
begin

end;


procedure Entity_List.ExportToPowerCad(Cad: TPCDrawing;
  map_fn: PC_convert;LayerNum:integer);
var
  lp1 : integer;
begin
  if name = 'Block_' then
    exit;
  for lp1 := 0 to (entities.Count - 1) do
    DXF_Entity(entities[lp1]).exportToPowerCAD(cad, map_fn, layerNum, nil);
end;

procedure DXF_Layer.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer);
var
  lp2: integer;
  data_list : Entity_List;
begin
  for lp2 := 0 to num_lists - 1 do
  begin
    data_list := entity_lists[lp2];
    data_list.ExportToPowerCad(cad, map_fn, LayerNum);
  end;
end;

procedure DXF_ObjectSCS.ExportToPowerCad(Cad: TPCDrawing; Layered, incVertex: Boolean);
var
  Layer:DXF_Layer;
  DXFLayer : Integer;
  i: integer;
  emax,emin : Point3d;
  Test: point3d;
  NewLayer: TLayer;
  LName: string;
  BegLNbr, LNbr: Integer;
begin
  try
    emax := get_max_extent;
    emin := get_min_extent;

    PCWh := ((emax.y-emin.y) / 2) - (Cad.WorkHeight / 2);
    PCWw := ((emax.x-emin.x) / 2) - (Cad.WorkWidth / 2);
    PCVertexOk := incVertex;

    CadHeight := 0;
    CadWidth := 0;
    if ord(Cad.VerticalZero) = 1 then
      CadHeight := Cad.WorkHeight;
    if ord(Cad.HorizontalZero) = 1 then
      CadWidth := Cad.WorkWidth;

    LName := cDXFEngineSCS_Msg1; // 'Без названия';
    BegLNbr := -1;
    for i := 0 to layer_lists.count - 1 do
    begin
      layer := layer_lists[i];
      if Layer.layer_name <> '' then
        NewLayer := TLayer.create(Layer.layer_name)
      else
        NewLayer := TLayer.create(LName);
      NewLayer.IsDxf := True;
      Cad.Layers.Add(NewLayer);
      LNbr := Cad.Layers.Count - 1;
      if i = 0 then
        BegLNbr := LNbr;
      layer.ExportToPowerCad(Cad, GetPCPoint, lNbr);
    end;

  except
    on E: Exception do AddExceptionToLogEx('DXF_ObjectSCS.ExportToPowerCad', E.Message);
  end;
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 Line_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pa,pb    : TPoint;
    t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  pa := map_fn(p1,t_matrix);
  pb := map_fn(p2,t_matrix);
  acanvas.Moveto(pa.x,pa.y);
  acanvas.Lineto(pb.x,pb.y);
end;


procedure Text_.calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
var pa,dummy1,dummy2 : TPoint;
    Fheight          : integer;
begin
  with acanvas.Pen do if Color<>colour then Color:=colour;
  // kludgy method for scaling text heights
  dummy1  := map_fn(origin3D,nil);
  dummy2  := map_fn(aPoint3D(0,h,0),nil);
  Fheight := 2+(dummy1.y-dummy2.y);
  if FHeight=2 then exit;
  with acanvas.Font do begin
    if Height<>Fheight then Height := Fheight;
    if color<>colour then color := colour;
  end;
  case hor_align of
    0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
    1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
    2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
  end;
  pa := map_fn(align_pt,OCS_WCS);
  acanvas.TextOut(pa.x,pa.y,t);
end;


procedure Text_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  calcText(acanvas,map_fn,t_matrix,textstr);
end;

procedure Circle_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pa,pb    : TPoint;
    t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
  pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
  // bug in Ellipse routine causes crash if extents are too small
  if (pb.x>pa.x+1) and (pa.y>pb.y+1) then
    acanvas.Ellipse(pa.x,pa.y,pb.x,pb.y)
  else acanvas.pixels[pa.x,pa.y] := acanvas.Pen.Color;
end;

procedure Arc_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pu,pv,pw,px : TPoint;
    t_matrix    : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  pu := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
  pv := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
  pw := map_fn(aPoint3D(p1.x+cos(angle1)*radius,p1.y+sin(angle1)*radius,p1.z+radius),t_matrix);
  px := map_fn(aPoint3D(p1.x+cos(angle2)*radius,p1.y+sin(angle2)*radius,p1.z+radius),t_matrix);
  if (pv.x>pu.x+1) and (pu.y>pv.y+1) then
    acanvas.Arc(pu.x,pu.y,pv.x,pv.y,pw.x,pw.y,px.x,px.y)
  else
  acanvas.pixels[pu.x,pu.y] := acanvas.Pen.Color;
end;


procedure Polyline_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray : array[0..max_vertices_per_polyline-1] of TPoint;
    lp1,tn     : integer;
    t_matrix   : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  if not closed then acanvas.Polyline(Slice(PointArray,numvertices))
  else acanvas.Polygon(Slice(PointArray,numvertices));
end;


procedure Polygon_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray  : array[0..max_vertices_per_polyline-1] of TPoint;
    tp          : TPoint;
    lp1,lp2,inx : integer;
    t_matrix    : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  // draw the M N-length polylines - we can use the array directly
  if closeN then for lp1:=0 to M-1 do acanvas.Polygon( Slice(pptarray(@PointArray[N*lp1])^,N))
  else           for lp1:=0 to M-1 do acanvas.Polyline(Slice(pptarray(@PointArray[N*lp1])^,N));
  // draw the N M-length polylines - we need to hop along the array in M steps
  for lp1:=0 to N-1 do begin
    acanvas.MoveTo(PointArray[lp1].x,PointArray[lp1].y);
    for lp2:=1 to M-1 do begin
      tp := PointArray[lp2*N+lp1];
      acanvas.LineTo(tp.x,tp.y);
    end;
    if closeM then acanvas.LineTo(PointArray[lp1].x,PointArray[lp1].y);
  end;
end;

procedure Polyface_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray  : array[0..3] of TPoint;
    lp1,lp2,inx : integer;
    t_matrix    : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  for lp1:=0 to numfaces-1 do begin
    for lp2:=0 to 3 do begin
      inx := facelist^[lp1].nf[lp2];
      if inx<0 then break; // index -> -1 = end of vertices
      PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
    end;
    acanvas.Polygon(Slice(PointArray,lp2));
  end;
end;
*)

function Point_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
  po: TDoublePoint;
  t_matrix : pMatrix;
begin
  Result := nil;
  //inherited;
  t_matrix := update_transformations(OCS_WCS,OCS);
  po := map_fn(p1,t_matrix);
  if PCVertexOk then
    Result := TFigure(Cad.Vertex(LayerNum,po.x,po.y,False));
end;


function Line_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
  po1,po2: TDoublePoint;
  t_matrix : pMatrix;
begin
  Result := nil;
  //inherited;
  t_matrix := update_transformations(OCS_WCS,OCS);
  po1 := map_fn(p1,t_matrix);
  po2 := map_fn(p2,t_matrix);
  fcolor := DxfColorToColor(fcolor);
  Result := Tfigure(Cad.Line(LayerNum, po1.x, po1.y, po2.x, po2.y, 1, 0, fcolor, 0, False));
end;



function Text_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  pa : TDoublePoint;
  Fheight: Double;
  t_matrix : pMatrix;
  ratio: double;
begin
  Result := nil;
  t_matrix := update_transformations(OCS_WCS,OCS);
  Fheight := h;
  ratio := 0;
  //case hor_align of
  //  0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
  //  1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
  //  2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
  //end;
  pa := map_fn(align_pt, {t_matrix}OCS_WCS);
  fcolor := DxfColorToColor(fcolor);  
  Result := TFigure(cad.TextOut(layernum, pa.x, pa.y, 0, fHeight, ratio, textstr, GCadForm.FFontName, RUSSIAN_CHARSET, fcolor, False));
end;


function Attrib_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  pa : TDoublePoint;
  Fheight : Double;
  t_matrix : pMatrix;
  ratio: double;
begin
  Result := nil;
  t_matrix := update_transformations(OCS_WCS,OCS);
  if not visible then
    exit;
  Fheight := h;
  ratio := 0;
  //case hor_align of
  //  0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
  //  1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
  //  2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
  //end;
  if Gt_matrix then
    pa := map_fn(align_pt, OCS)
  else
    pa := map_fn(align_pt, {t_matrix}OCS_WCS);
  fcolor := DxfColorToColor(fcolor);
  Result := TFigure(cad.TextOut(layernum, pa.x, pa.y, 0, fHeight, ratio, tagstr, GCadForm.FFontName, RUSSIAN_CHARSET, fcolor, False));
end;


function Arc_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS:pM): Tfigure;
var
  pu,pv,pw,px : TDoublePoint;
  po,pa,pb : TDoublePoint;
  t_matrix: pMatrix;
  rad : Double;
  cx,cy: Double;
  ta,a1,a2: Double;
  blk_ang: double;
  blk_scale: Point3D;
  Arc: TArc;
  rPoints: TDoublePoint;
  b1, b2: double;
  modscalex, modscaley: double;
  z: double;
begin
  Result := nil;
//  inherited;
  t_matrix := update_transformations(OCS_WCS, OCS);
  pu := map_fn(aPoint3D(p1.x - radius, p1.y - radius, p1.z - radius), t_matrix);
  pv := map_fn(aPoint3D(p1.x + radius, p1.y + radius, p1.z + radius), t_matrix);

  pw := map_fn(aPoint3D(p1.x + cos(angle1) * radius, p1.y + sin(angle1) * radius, p1.z + radius), t_matrix);
  px := map_fn(aPoint3D(p1.x + cos(angle2) * radius, p1.y + sin(angle2) * radius, p1.z + radius), t_matrix);
  rad := radius;

  cx := (pu.x + pv.x) / 2;
  cy := (pu.y + pv.y) / 2;

  a1 := angle1;
  a2 := angle2;
  z := OCS_axis.z;

  // корректировать с учетом системы PowerCad
  if ord(Cad.VerticalZero) = 1 then
  begin
    if ord(Cad.HorizontalZero) = 0 then
    begin
      a1 := 2 * pi - a1;
      a2 := 2 * pi - a2;
      ta := a1;
      a1 := a2;
      a2 := ta;
    end;
  end;

  if z < 0 then
  begin
    a1 := pi - a1;
    a2 := pi - a2;
    ta := a1;
    a1 := a2;
    a2 := ta;
  end;


  // корректировать с учетом угла поворота блока
  blk_ang := rotation;
  blk_scale := scale;

  // ЕСЛИ АРКА ПРИШЛА С БЛОКА !!!
  if (blk_scale.x <> - 10000) and (blk_scale.y <> - 10000) then
  begin
    // SCALE ОБЫЧНЫЕ !!!
    modscalex := abs(scale.x);
    modscaley := abs(scale.y);
    if (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then
    begin
      // получить углы !!!!
      a1 := a1 + (pi * 2 - blk_ang);
      a2 := a2 + (pi * 2 - blk_ang);
      if (scale.x < 0) and (scale.y < 0) then
      begin
        a1 := a1 - pi;
        a2 := a2 - pi;
      end
      else
      begin
        if scale.x < 0 then
        begin
          a1 := a1 + 2 * (pi / 2 - a1);
          a2 := a2 + 2 * (pi / 2 - a2);
          ta := a2;
          a2 := a1;
          a1 := ta;
        end;
        if scale.y < 0 then
        begin
          a1 := a1 + 2 * (pi - a1);
          a2 := a2 + 2 * (pi - a2);
          ta := a2;
          a2 := a1;
          a1 := ta;
        end;
      end;
      // создать
      Result := TFigure(Cad.Arc(LayerNum, cx, cy, rad, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, 0, false));
      Result.Draw(Cad.DEngine, False);
    end
    else
    // SCALE НЕ ОБЫЧНЫЕ !!!
    begin
      // получить углы !!!!
      a1 := a1 + (pi * 2 - blk_ang);
      a2 := a2 + (pi * 2 - blk_ang);
      if (scale.x < 0) and (scale.y < 0) then
      begin
        a1 := a1 - pi;
        a2 := a2 - pi;
      end
      else
      begin
        if scale.x < 0 then
        begin
          a1 := a1 + 2 * (pi / 2 - a1);
          a2 := a2 + 2 * (pi / 2 - a2);
          ta := a2;
          a2 := a1;
          a1 := ta;
        end;
        if scale.y < 0 then
        begin
          a1 := a1 + 2 * (pi - a1);
          a2 := a2 + 2 * (pi - a2);
          ta := a2;
          a2 := a1;
          a1 := ta;
        end;
      end;
      // создать
      fcolor := DxfColorToColor(fcolor);
      Result :=  TFigure(Cad.ElpArc(LayerNum, cx, cy, rad, rad, 0, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, ord(asOpen), false));
      Result.Draw(Cad.DEngine, False);
    end;
  end
  else
  begin
    fcolor := DxfColorToColor(fcolor);
    Result := TFigure(Cad.Arc(LayerNum, cx, cy, rad, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, 0, false));
  end;
end;


function Polyline_.ExportToPowerCad(Cad: TPCDrawing;map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  PointArray : TDoublePointArr;
  lp1,tn : integer;
  t_matrix : pMatrix;
begin
  Result := nil;
  //inherited;
  SetLength(PointArray, numvertices);
  t_matrix := update_transformations(OCS_WCS, OCS);
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1], t_matrix);
  fcolor := DxfColorToColor(fcolor);    
  Result := TFigure(cad.PolyLine(layernum, PointArray, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, closed, false));
end;


function Insert_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
  lp1 : integer;
  t_matrix : pMatrix;
  TempMatrix : Matrix;
  Blk: Block_;
begin
  Result := nil;
  //inherited;
  // we mustn't use the update_transformations call because inserts 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 num_attribs-1 do attribs[lp1].Draw(acanvas,map_fn,t_matrix);
  //if blockname<>'' then block.Draw(acanvas,map_fn,t_matrix);
  for lp1 := 0 to num_attribs - 1 do
    attribs[lp1].ExportToPowerCad(cad, map_fn, LayerNum, t_matrix);
  if blockname <> '' then
  begin
    Blk := Block;
    Blk.scale := scale;
    Blk.rotation := rotation;
    Blk.BeginPoint := BeginPoint;
    Blk.ExportToPowerCad(cad, map_fn, LayerNum, t_matrix);
  end;
end;


function Circle_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  po,pa,pb: TDoublePoint;
  rad:Double;
  t_matrix : pMatrix;
  cx,cy: Double;
begin
  Result := nil;
  //inherited;
  t_matrix := update_transformations(OCS_WCS,OCS);
  pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
  pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);

  po := map_fn(p1,t_matrix);
  rad := radius;
  fcolor := DxfColorToColor(fcolor);    
  Result := TFigure(cad.Circle(layernum, po.x, po.y, rad, 1, ord(psSolid), fcolor, ord(bsClear), 0, false));
end;


function Block_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
  i, lp1 : integer;
  t_matrix : pMatrix;
  TempMatrix : Matrix;
  vFigure: TFigure;
  vBlock: TBlock;
  InFiguresList: TList;
  LHandle: Integer;
  Bnd: TDoubleRect;
  deltax, deltay: double;
  RotPoints: TDoublePoint;
  Angle_rad: double;
  Angle_deg: double;
  modscalex, modscaley: double;
  str: string;
begin
  Result := nil;
  // 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;

  LHandle := Cad.GetLayerHandle(LayerNum);
  InFiguresList := TList.create;

  GRotPoints := map_fn(BeginPoint, nil);

  for lp1 := 0 to entities.count - 1 do
  begin
    DXF_Entity(entities[lp1]).scale := scale;
    DXF_Entity(entities[lp1]).rotation := rotation;
    DXF_Entity(entities[lp1]).fcolor := fcolor;
    Gt_matrix := true;
    DXF_Entity(entities[lp1]).OCS_axis.z := scale.z;
    vFigure := DXF_Entity(entities[lp1]).ExportToPowerCAd(cad, map_fn, LayerNum, t_matrix);
    Gt_matrix := false;
    if vFigure <> nil then
      InFiguresList.Add(vFigure);
  end;

  if InFiguresList.Count > 0 then
  begin
    vBlock := TBlock.Create(LHandle, Cad);
    for i := 0 to InFiguresList.Count - 1 do
    begin
      vFigure := TFigure(InFiguresList[i]);
      if vFigure <> nil then
      begin
        vBlock.AddFigure(vFigure);
        GCadForm.PCad.Figures.Remove(vFigure);
      end;
    end;
    Cad.AddCustomFigure(LayerNum, vBlock, False);

    RotPoints := map_fn(BeginPoint, nil);
    Angle_deg := rotation * 180 / pi;
    Angle_rad := rotation;

    modscalex := abs(scale.x);
    modscaley := abs(scale.y);
    // НЕ ОБЫЧНЫЙ SCALE
    if not (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then
    begin
      // ЗАТЫКАЮ ЖОПУ!!!
      if not CheckTTextExistForDXF(vBlock) then
      begin
        if (scale.x > 0) and (scale.y > 0) then
        begin
          vBlock.Rotate(- (2 * pi - Angle_rad), vBlock.ap1{RotPoints});
          vBlock.Scale(scale.x, scale.y, vBlock.ap1{RotPoints});
          vBlock.Rotate((2 * pi - Angle_rad), vBlock.ap1{RotPoints});
        end
        else
        if ((scale.x < 0) and (scale.y > 0)) or ((scale.x > 0) and (scale.y < 0)) then
        begin
          vBlock.Rotate(- Angle_rad, {vBlock.ap1}RotPoints);
          vBlock.Scale(abs(scale.x), abs(scale.y), {vBlock.ap1}RotPoints);
          vBlock.Rotate(Angle_rad, {vBlock.ap1}RotPoints);
        end
        else
        if (scale.x < 0) and (scale.y < 0) then
        begin
          vBlock.Rotate(- (2 * pi - Angle_rad), vBlock.ap1{RotPoints});
          vBlock.Scale(scale.x, scale.y, vBlock.ap1{RotPoints});
          vBlock.Rotate((2 * pi - Angle_rad + pi), vBlock.ap1{RotPoints});
        end;
      end;
    end;

    if ((scale.x < 0) and (scale.y > 0)) or ((scale.x  > 0) and (scale.y < 0)) then
    begin
      Angle_rad := (2 * pi  - 2 * Rotation);
      vBlock.Rotate(Angle_rad, RotPoints);
    end;

    FreeAndNil(InFiguresList);
    Result := vBlock;
  end;
  
  GRotPoints := DoublePoint(-10000, -10000);
end;



function Polygon_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  PointArray : TDoublePointArr;
  tPointS : TDoublePointArr;
  tp : TPoint;
  lp1,lp2,inx,i : integer;
  t_matrix : pMatrix;
begin
  Result := nil;
  t_matrix := update_transformations(OCS_WCS,OCS);
  SetLength(PointArray,numvertices);
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);

  // draw the M N-length polylines - we can use the array directly

  SetLength(tPoints,N);
  for lp1:=0 to M-1 do
  begin
    for i := 0 to n-1 do
      tPoints[i] := PointArray[n*lp1+i];
    Result := TFigure(cad.PolyLine(layernum,tPoints,1,ord(psSolid),fcolor,0,ord(bsClear),0,CloseN,false));
  end;

  Setlength(tPoints,M);
  for lp1:=0 to N-1 do
  begin
    tPoints[0] := PointArray[lp1];
    for lp2:=1 to M-1 do
    begin
      tPoints[lp2] := PointArray[lp2 * N + lp1];
    end;
    fcolor := DxfColorToColor(fcolor);    
    Result := Tfigure(cad.PolyLine(layernum, tPoints, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, CLoseM,false));
  end;
end;


function Polyface_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
  PointArray: TDoublePointArr;
  lp1,lp2,inx: integer;
  t_matrix: pMatrix;
begin
  Result := nil;
  t_matrix := update_transformations(OCS_WCS,OCS);

  for lp1:=0 to numfaces-1 do
  begin
    for lp2 := 0 to 3 do
    begin
      inx := facelist^[lp1].nf[lp2];
      if inx<0 then
        break;
      SetLength(PointArray,lp2+1);
      PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
    end;
    fcolor := DxfColorToColor(fcolor);    
    Result := Tfigure(cad.Polygon(layernum, PointArray, 1, ord(psSolid), fcolor, ord(bsClear), 0, false));
  end;
end;


{ MText_ }
procedure MText_.calcText(acanvas: TCanvas; map_fn: coord_convert; OCS: pM; t: string);
var
  pa,dummy1,dummy2: TPoint;
  Fheight: integer;
begin
  with acanvas.Pen do
  if Color <> fcolor then
    Color:=fcolor;
  // kludgy method for scaling text heights
  dummy1  := map_fn(origin3D,nil);
  dummy2  := map_fn(aPoint3D(0,h,0),nil);
  Fheight := 2+(dummy1.y-dummy2.y);
  if FHeight=2 then
    exit;
  with acanvas.Font do
  begin
    if Height<>Fheight then
      Height := Fheight;
    if color<>fcolor then
      color := fcolor;
  end;
  case hor_align of
    0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
    1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
    2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
  end;
  pa := map_fn(align_pt,OCS_WCS);
  acanvas.TextOut(pa.x,pa.y,t);
end;

constructor MText_.create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha, align: integer);
var
  rotx, roty: double;
begin
  inherited create(OCSaxis, p, col);
  h := height;
  if ss <> '' then
    textstr := ss;
  // **************************
  rotx := ArcCos(ap.x);
  roty := ArcSin(ap.y);
  AngleRad := roty;
  AngleRad := 2 * pi - AngleRad;
//  if p1_eq_p2_3D(ap, origin3D) then
    ap := p;
  align_pt  := ap;
  hor_align := ha;
  AlignIndex := align;
  fcolor := col;
end;

function MText_.details: string;
begin
  result := inherited details + EOL + 'Text '#9 + textstr + EOL + 'TextHeight = ' + float_out(h);
end;

procedure MText_.Draw(acanvas: TCanvas; map_fn: coord_convert; OCS: pM);
var
  t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  calcText(acanvas,map_fn,t_matrix,textstr);
end;

function MText_.GetRichTextByFormat(aStr: string): TRichText;
var
  MText: TRichText;
  StrList: TStringList;
  i: Integer;
  TM: TTextMetric;
  xCanvas: TMetafileCanvas;
  h, w: double;
  Ch: Char;
  ResStr: string;
  LHandle: Integer;
begin
  try
    Result := nil; 
    LHandle := GCadForm.PCad.GetLayerHandle(1);
    fcolor := DxfColorToColor(fcolor);    
    MText := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(psClear), clBlack, LHandle, mydsNormal, GCadForm.PCad);
    StrList := TStringList.Create;
    // ВЫЧИТАТЬ ФОРМАТ *********************************************************
    ResStr := '';
    i := 1;
    Ch := aStr[i];
    if Ch = '{' then
    begin
      i := i + 1;
      Ch := aStr[i];
      while Ch <> '}' do
      begin
        if Ch = '\' then
        begin
          // одна позиция формата
          // считывать коды
          while Ch <> ';' do
          begin
            i := i + 1;
            Ch := aStr[i];
          end;
          // считывать сам текст
          while ((Ch <> '\') and (Ch <> '}')) do
          begin
            i := i + 1;
            Ch := aStr[i];
            if ((Ch <> '\') and (Ch <> '}')) then
              ResStr := ResStr + Ch;
          end;
        end;
      end;
    end;
    // *************************************************************************  
    StrList.Add(ResStr);
    MText.re.WordWrap := False;
    MText.re.Font.Name := GCadForm.FFontName;
    MText.re.Font.Charset := RUSSIAN_CHARSET;    
    MText.re.Font.Size := 12;
    MText.re.Font.Style := [];
    MText.re.Font.Color := fcolor;
    MText.re.Lines.Clear;
    for i := 0 to StrList.Count - 1 do
    begin
      StrList.Strings[i] := FastReplace(StrList.Strings[i],#13#10,' ');
      MText.re.Lines.Add(StrList.Strings[i]);
    end;
    // Tolik
    MText.ttMetaFile:= TMetaFile.Create;
    MText.ttMetafile.Enhanced := True;

    // получить свойства
    xCanvas := TMetafileCanvas.Create(MText.ttMetafile, 0);
    xCanvas.Font.Name := MText.re.Font.Name;
    xCanvas.Font.Size := MText.re.Font.Size;
    xCanvas.Font.Style := MText.re.Font.Style;
    GetTextMetrics(xCanvas.Handle, TM);
    if MText.re.Lines.Count > 1 then
      h := TM.tmHeight / 4 * MText.re.Lines.Count + 1
    else
      h := TM.tmHeight / 4 * MText.re.Lines.Count;
    w := 0;
    for i := 0 to MText.re.Lines.Count - 1 do
    begin
      if w < xCanvas.TextWidth(MText.Re.Lines[i]) then
        w := xCanvas.TextWidth(MText.Re.Lines[i]);
    end;
    w := (w + 3) / 4 ;
    FreeAndNil(xCanvas);
    // пересоздать с новыми свойствами
    if MText <> nil then
    begin
      MText.ttMetaFile.Free;
      FreeAndNil(MText);
    end;
    MText := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
                              LHandle, mydsNormal, GCadForm.PCad);
    MText.re.WordWrap := False;
    MText.re.Font.Name := GCadForm.FFontName;
    MText.re.Font.Charset := RUSSIAN_CHARSET;
    MText.re.Font.Size := 12;
    MText.re.Font.Style := [];
    MText.re.Font.Color := fcolor;

    MText.re.Lines.Clear;
    for i := 0 to StrList.Count - 1 do
    begin
      StrList.Strings[i] := FastReplace(StrList.Strings[i],#13#10,' ');
      MText.re.Lines.Add(StrList.Strings[i]);
    end;

    MText.rotate(AngleRad, MText.ap1);

    Result := MText;
  except
    on E: Exception do AddExceptionToLogEx('U_DXFEngineSCS.GetRichTextByFormat', E.Message);
  end;
end;

function MText_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): TFigure;
var
  pa : TDoublePoint;
  Fheight: Double;
  t_matrix : pMatrix;
  ratio: double;
  RichText: TRichText;

begin
  Result := nil;
  t_matrix := update_transformations(OCS_WCS, OCS);
  Fheight := h;
  ratio := 0;
//  case hor_align of
//    0 : SetTextAlign(acanvas.handle,TA_LEFT   + TA_BASELINE);
//    1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
//    2 : SetTextAlign(acanvas.handle,TA_RIGHT  + TA_BASELINE);
//  end;
  pa := map_fn(align_pt, OCS_WCS);
  if textstr <> '' then
  begin
    RichText := GetRichTextByFormat(textstr);

    // по левому краю
    if (AlignIndex = 1) then
    begin
      RichText.Move(pa.x - RichText.ap1.x, pa.y - RichText.ap1.y);
    end;
    if (AlignIndex = 2) then
    begin
      RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.ap1.y);
    end;
    if (AlignIndex = 3) then
    begin
      RichText.Move(pa.x - RichText.ap2.x, pa.y - RichText.ap2.y);
    end;
    if (AlignIndex = 4) then
    begin
      RichText.Move(pa.x - RichText.ap1.x, pa.y - RichText.CenterPoint.y);
    end;
    if (AlignIndex = 5) then
    begin
      RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.CenterPoint.y);
    end;
    if (AlignIndex = 6) then
    begin
      RichText.Move(pa.x - RichText.ap2.x, pa.y - RichText.CenterPoint.y);
    end;
    if (AlignIndex = 7) then
    begin
      RichText.Move(pa.x - RichText.ap4.x, pa.y - RichText.ap4.y);
    end;
    if (AlignIndex = 8) then
    begin
      RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.ap4.y);
    end;
    if (AlignIndex = 9) then
    begin
      RichText.Move(pa.x - RichText.ap3.x, pa.y - RichText.ap3.y);
    end;
    Result := TFigure(Cad.AddCustomFigure(LayerNum, RichText, false));
  end;
end;

procedure MText_.max_min_extents(var emax, emin: Point3D);
begin
  max_bound(emax,p1); min_bound(emin,p1);
end;

procedure MText_.write_to_DXF(var IO: textfile; layer: string);
begin
  inherited;
  writeln(IO,40 ,EOL,float_out(h));
  writeln(IO,1  ,EOL,textstr);
  if hor_align<>0 then
  begin
    write_DXF_Point(IO,11,align_pt);
    writeln(IO,72 ,EOL,hor_align);
  end;
end;

{ LWPolyline_ }

function LWPolyline_.closest_vertex(p: Point3D): Point3D;
var
  lp1,c : integer;
  d1,d2 : double;
begin
  d1 := 1E10;
  for lp1:=0 to numvertices-1 do
  begin
    d2 := sq_dist2D(polypoints^[lp1],p);
    if d2<d1 then
    begin
      result := polypoints^[lp1];
      d1 := d2;
    end;
  end;
end;

function LWPolyline_.closest_vertex_square_distance_2D(p: Point3D): double;
var
  lp1 : integer;
begin
  result := 1E10;
  for lp1:=0 to numvertices-1 do
    result := dmin(result,sq_dist2D(polypoints^[lp1],p));
end;

procedure LWPolyline_.copy_attribs(p: Polyline_);
var
  lp1 : integer;
begin
  p.numattrs := numattrs;
  for lp1:=0 to numattrs-1 do
    p.attribs[lp1] := attribs[lp1];
end;

function LWPolyline_.count_lines: integer;
begin
  result := numvertices;
end;

function LWPolyline_.count_points: integer;
begin
  result := numvertices;
end;

function LWPolyline_.count_polys_closed: integer;
begin
  if closed then
    result := 1
  else
    result := 0;
end;

function LWPolyline_.count_polys_open: integer;
begin
  if not closed then
    result := 1
  else
    result := 0;
end;

constructor LWPolyline_.create(OCSaxis: Point3D; numpoints: integer;
  points: ppointlist; col: integer; closed_: boolean);
var
  lp1 : integer;
begin
  inherited create;
  init_OCS_WCS_matrix(OCSaxis);
  numvertices := numpoints;
  if closed_ then
    closed := true
  else
  if p1_eq_p2_3D(points[0], points[numvertices - 1]) then
  begin
    closed := true;
    dec(numvertices);
  end
  else
    closed := false;
  polypoints := allocate_points(numvertices);
  for lp1:=0 to numvertices-1 do
    polypoints^[lp1] := points^[lp1];
  fcolor := col;
  fLineStyle := 'SOLID';
end;

destructor LWPolyline_.destroy;
begin
  deallocate_points(polypoints,numvertices);
  inherited destroy;
end;

function LWPolyline_.details: string;
var
  lp1 : integer;
  t   : string;
begin
  if OCS_WCS<>nil then
    t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else
    t := 'WCS';
  result := classname + EOL + t;
  if closed then
    result := result + EOL + 'Closed'
  else
    result := result + EOL + 'Open';
  for lp1:=0 to numvertices-1 do
    result := result + EOL + Point3DToStr(polypoints^[lp1]);
end;

procedure LWPolyline_.Draw(acanvas: TCanvas; map_fn: coord_convert;
  OCS: pM);
var
  PointArray: array[0..max_vertices_per_polyline-1] of TPoint;
  lp1,tn: integer;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  if not closed then
    acanvas.Polyline(Slice(PointArray,numvertices))
  else
    acanvas.Polygon(Slice(PointArray,numvertices));
end;

procedure LWPolyline_.DrawVertices(acanvas: TCanvas; map_fn: coord_convert;
  OCS: pM);
var
  po: TPoint;
  lp1: integer;
  t_matrix: pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do
    if Color<>fcolor then
      Color:=fcolor;
  for lp1:=0 to numvertices-1 do
  begin
    po := map_fn(polypoints^[lp1],t_matrix);
    draw_cross(acanvas,po);
  end;
end;

function LWPolyline_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): Tfigure;
var
  PointArray : TDoublePointArr;
  lp1,tn : integer;
  t_matrix : pMatrix;
begin
  Result := nil;
  //inherited;
  SetLength(PointArray, numvertices);
  t_matrix := update_transformations(OCS_WCS, OCS);
  for lp1 := 0 to numvertices - 1 do
    PointArray[lp1] := map_fn(polypoints^[lp1], t_matrix);
//  closed := True;
  fcolor := DxfColorToColor(fcolor);    
  Result := Tfigure(cad.PolyLine(layernum, PointArray, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, closed, false));
end;

function LWPolyline_.get_attrib(i: integer): double;
begin
  if i>=numattrs then
    result := 0
  else
    result := attribs[i];
end;

function LWPolyline_.is_point_inside_object2D(p: Point3D): boolean;
var
  i,j: integer;
  p1_i,p1_j: Point3D;
begin
  result := false;
  if not closed then
    exit;
  j := numvertices-1;
  for i:=0 to numvertices-1 do with p do
  begin
    p1_i := polypoints^[i];
    p1_j := polypoints^[j];
    if ((((p1_i.y<=y) and (y<p1_j.y)) or ((p1_j.y<=y) and (y<p1_i.y))) and
       (x<(p1_j.x - p1_i.x)*(y-p1_i.y) / (p1_j.y - p1_i.y) + p1_i.x)) then
        result:= not result;
    j:=i;
  end;
end;

procedure LWPolyline_.max_min_extents(var emax, emin: Point3D);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices-1 do
  begin
    max_bound(emax,polypoints^[lp1]); min_bound(emin,polypoints^[lp1]);
  end;
end;

function LWPolyline_.Move_point(p, newpoint: Point3D): boolean;
var
  lp1  : integer;
begin
  for lp1:=0 to numvertices-1 do
  begin
    if p1_eq_p2_3D(polypoints^[lp1],p) then
    begin
      polypoints^[lp1] := newpoint;
      result := true;
      exit;
    end;
  end;
  result := false;
end;

procedure LWPolyline_.quantize_coords(epsilon: double; mask: byte);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices-1 do
  begin
    if (mask and 1)=1 then
      polypoints^[lp1].x := round(polypoints^[lp1].x*epsilon)/epsilon;
    if (mask and 2)=2 then
      polypoints^[lp1].y := round(polypoints^[lp1].y*epsilon)/epsilon;
    if (mask and 4)=4 then
      polypoints^[lp1].z := round(polypoints^[lp1].z*epsilon)/epsilon;
  end;
end;

procedure LWPolyline_.set_attrib(i: integer; v: double);
begin
  if (i+1)>numattrs then
    numattrs:=(i+1);
  attribs[i] := v;
end;

procedure LWPolyline_.translate(T: Point3D);
var
  lp1 : integer;
begin
  for lp1:=0 to numvertices-1 do
    polypoints^[lp1] := p1_plus_p2(polypoints^[lp1],T);
end;

function LWPolyline_.triangle_centre: Point3D;
var
  s,t : integer;
begin
  if numvertices<>3 then
    raise Exception.Create('Shouldn''t call this for non triangular facets');
  s := 1;
  t := 2;
  result := p1_plus_p2(polypoints^[0],p1_plus_p2(polypoints^[s],polypoints^[t]));
  result := p1_x_n(result,1/3);
end;

procedure LWPolyline_.write_to_DXF(var IO: textfile; layer: string);
var
  lp1 : integer;
begin
  inherited;
  if closed then
    writeln(IO,70 ,EOL,1+8) // 1+8 = closed+3D
  else
    writeln(IO,70 ,EOL,8);
  writeln(IO, 66, EOL, 1);
  writeln(IO, 6, EOL, fLineStyle);
  for lp1:=0 to numvertices-1 do
  begin
//    writeln(IO,0 ,EOL,'VERTEX');
//    writeln(IO,70 ,EOL,32);    // 3D polyline mesh vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  writeln(IO,0 ,EOL,'SEQEND');
end;

initialization
  entities_in_existence := 0;
  Ent_lists_in_existence := 0;
  layers_in_existence := 0;
  DXF_Obj_in_existence := 0;

end.


