admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 17:25:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/UNITS/DXFEngine.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

4092 lines
140 KiB
ObjectPascal
Raw Permalink Blame History

unit DXFEngine;
interface
uses
Windows,SysUtils,StdCtrls,ComCtrls,Dialogs,Classes,Graphics,math,PCDrawing,
PCTypesUtils;
const
message_delay_ms = 1500;
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_Entity = class
colour : TColor;
colinx : integer;
OCS_WCS : pMatrix;
OCS_axis : Point3D;
constructor create;
destructor destroy; override;
procedure init_OCS_WCS_matrix(OCSaxis:Point3D); virtual;
procedure update_block_links(blist:TObject); virtual; abstract;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); virtual; abstract;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); virtual; abstract;
procedure setcolour_index(col:integer); virtual;
procedure setcolour(col:TColor); virtual;
procedure translate(T:Point3D); virtual; abstract;
procedure quantize_coords(epsilon:double; mask:byte); virtual; abstract;
function count_points : integer; virtual;
function count_lines : integer; virtual;
function count_polys_open : integer; virtual;
function count_polys_closed : integer; virtual;
function proper_name : string; virtual;
procedure write_DXF_Point(var IO:textfile; n:integer; p:Point3D); virtual;
procedure write_to_DXF(var IO:textfile; layer:string); virtual;
function details : string; virtual; abstract;
procedure max_min_extents(var emax,emin:Point3D); virtual; abstract;
function closest_vertex_square_distance_2D(p:Point3D) : double; virtual; abstract;
function closest_vertex(p:Point3D) : Point3D; virtual; abstract;
function is_point_inside_object2D(p:Point3D) : boolean; virtual;
function Move_point(p,newpoint:Point3D) : boolean; virtual;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);virtual;
end;
///////////////////////////////////////////////////////////////////////////////
// Block_ Definition - special case - not to be used like other entities
// Blocks should always appear in layer '0'
// I'm still not quite sure what to do with them - but here goes anyway...
///////////////////////////////////////////////////////////////////////////////
type
Block_ = class(DXF_Entity)
name : string;
basepoint : Point3D;
entities : TList;
constructor create(bname:string; refpoint:Point3D);
destructor destroy; override;
procedure update_block_links(blist:TObject); override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D) : double; override;
function closest_vertex(p:Point3D) : Point3D; override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Point Definition
///////////////////////////////////////////////////////////////////////////////
type
Point_ = class(DXF_Entity) // always WCS
p1 : Point3D;
constructor create(OCSaxis,p:Point3D; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D) : double; override;
function closest_vertex(p:Point3D) : Point3D; override;
function Move_point(p,newpoint:Point3D) : boolean; override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Text Definition
///////////////////////////////////////////////////////////////////////////////
type
Text_ = class(Point_) // always OCS
h : double;
textstr : string;
align_pt : Point3D; // alignment point
hor_align : integer; // horizontal justification code
constructor create(OCSaxis,p,ap:Point3D; ss:string; height:double; col,ha:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Attrib Definition
///////////////////////////////////////////////////////////////////////////////
type
Attrib_ = class(Text_) // always OCS
tagstr : string;
visible : boolean;
constructor create(OCSaxis,p,ap:Point3D; ss,tag:string; flag70,flag72:integer; height:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
type
patt_array = ^att_array;
att_array = array[0..0] of Attrib_;
///////////////////////////////////////////////////////////////////////////////
// Attdef Definition
///////////////////////////////////////////////////////////////////////////////
type
Attdef_ = class(Attrib_) // always OCS
promptstr : string;
constructor create(OCSaxis,p,ap:Point3D; ss,tag,prompt:string; flag70,flag72:integer; height:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
end;
///////////////////////////////////////////////////////////////////////////////
// Insert Definition (optionally contains attribs)
///////////////////////////////////////////////////////////////////////////////
type
Insert_ = class(Point_) // always OCS
num_attribs : integer;
attribs : array[0..max_attribs] of Attrib_;
blockname : string;
scale : Point3D;
rotation : double;
blockptr : Block_; // use carefully
blocklist : TObject; // to cross reference the blocks
constructor create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string);
destructor destroy; override;
procedure init_OCS_WCS_matrix(OCSaxis:Point3D); override;
procedure update_block_links(blist:TObject); override;
function block : Block_;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Line Definition
///////////////////////////////////////////////////////////////////////////////
type
Line_ = class(Point_) // always WCS
p2 : Point3D;
constructor create(p_1,p_2:Point3D; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function count_points : integer; override;
function count_lines : integer; override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D) : double; override;
function closest_vertex(p:Point3D) : Point3D; override;
function Move_point(p,newpoint:Point3D) : boolean; override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Circle Definition
///////////////////////////////////////////////////////////////////////////////
type
Circle_ = class(Point_) // always OCS
radius : double;
constructor create(OCSaxis,p_1:Point3D; radius_:double; col:integer);
constructor create_from_polyline(ent1:DXF_Entity);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function is_point_inside_object2D(p:Point3D) : boolean; override;
procedure max_min_extents(var emax,emin:Point3D); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Arc Definition
///////////////////////////////////////////////////////////////////////////////
type
Arc_ = class(Circle_) // always OCS
angle1,angle2 : double;
constructor create(OCSaxis,p_1:Point3D; radius_,sa,ea:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function is_point_inside_object2D(p:Point3D) : boolean; override;
procedure max_min_extents(var emax,emin:Point3D); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline Definition
///////////////////////////////////////////////////////////////////////////////
type
Polyline_ = class(DXF_Entity) // OCS/WCS depends
closed : boolean;
numvertices : integer;
polypoints : ppointlist;
numattrs : integer;
attribs : array[0..max_my_attribs-1] of double;
constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
destructor destroy; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function count_points : integer; override;
function count_lines : integer; override;
function count_polys_open : integer; override;
function count_polys_closed : integer; override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D) : double; override;
function closest_vertex(p:Point3D) : Point3D; override;
// some functions I use...most removed....
function Move_point(p,newpoint:Point3D) : boolean; override;
function is_point_inside_object2D(p:Point3D) : boolean; override;
function triangle_centre : Point3D;
procedure set_attrib(i:integer; v:double);
function get_attrib(i:integer) : double;
procedure copy_attribs(p:Polyline_);
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Face3D_ Definition - Should be 3DFace but can't name a type starting with 3
///////////////////////////////////////////////////////////////////////////////
type
Face3D_ = class(Polyline_) // always WCS
constructor create(numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
function proper_name : string; override; // save as 3DFACE not Face3D
procedure write_to_DXF(var IO:textfile; layer:string); override;
end;
///////////////////////////////////////////////////////////////////////////////
// Solid_ Definition
///////////////////////////////////////////////////////////////////////////////
type
Solid_ = class(Face3D_) // always OCS
thickness : double;
constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
function proper_name : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function details : string; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh) Definition
///////////////////////////////////////////////////////////////////////////////
type
Polygon_mesh_ = class(Polyline_) // always WCS ???
M,N : integer;
closeM,closeN : boolean;
constructor create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
function proper_name : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function details : string; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh) Definition
///////////////////////////////////////////////////////////////////////////////
type
Polyface_mesh_ = class(Polyline_) // always WCS ???
numfaces : integer;
facelist : pfacelist;
constructor create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
destructor destroy; override;
function proper_name : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function details : string; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM);override;
end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class definition
// An entity list is a collection of entities (in this case all the same type)
// I wanted to keep polylines & lines etc in separate lists, so the DXF_Layer
// will automatically handle this.
///////////////////////////////////////////////////////////////////////////////
type
DXF_Layer = class;
Entity_List = class
private
function add_at_end(entity:DXF_Entity) : boolean;
function insert(entity:DXF_Entity) : boolean;
public
list_name : string;
parent_layer : DXF_Layer;
Kludge_layer : DXF_Layer; // see selection.save...
entities : TList;
sorted : boolean;
constructor create(l_name:string);
destructor destroy; override;
property name : string read list_name write list_name;
function add_entity_to_list(entity:DXF_Entity) : boolean;
function remove_entity(ent:DXF_Entity) : boolean;
procedure draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
procedure draw_vertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
function num_entities : integer;
function count_points : integer;
function count_lines : integer;
function count_polys_open : integer;
function count_polys_closed : integer;
procedure max_min_extents(var emax,emin:Point3D);
procedure setcolour(col:integer);
function closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
function find_bounding_object(p:Point3D) : DXF_Entity;
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;
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_Object = 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_Object) : boolean;
// Useful ones
procedure remove_empty_layers_and_lists;
procedure copy_to_strings(ts:TStrings);
function get_min_extent : Point3D;
function get_max_extent : Point3D;
// update the extents (not really needed)
procedure max_min_extents(var emax,emin:Point3D);
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, // zero - not used
clRed, clYellow, clLime, clAqua, clBlue, clPurple, {clWhite}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;
// Header section
function write_header : boolean;
// Tables section
function write_tables : boolean;
function write_layer_information : boolean;
function write_vport_information : boolean;
// BLocks section
function write_blocks : boolean;
// Entities section
function write_entities : 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;
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;
// 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;
// Header section
function move_to_header_section : boolean;
function read_header : boolean;
function get_min_extent : Point3D;
function get_max_extent : Point3D;
// Blocks section
function move_to_blocks_section : boolean;
function read_blocks : boolean;
function read_block : boolean;
function block_list : Entity_List;
// 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;
// Entities section
function move_to_entity_section : boolean;
function read_entities : 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;
implementation
{ --------------------------------------------------------------------------- }
{ ------------------- 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
write_header;
write_tables;
write_blocks;
write_entities;
writeln(IO_chan,0,EOL,'EOF');
end;
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));
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;
function DXF_Writer.write_tables : boolean;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'TABLES');
write_vport_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:=DXF_layers.count-1 downto 0 do begin
layer := DXF_Layer(DXF_Layers[lp1]);
writeln(IO_chan,0 ,EOL,'LAYER');
writeln(IO_chan,2 ,EOL,layer.name);
writeln(IO_chan,62,EOL,layer.layer_colinx);
end;
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;
function DXF_Writer.write_blocks : boolean;
var lp1,lp2,lp3 : integer;
layer : DXF_Layer;
eList : Entity_List;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'BLOCKS');
// find the layer with the blocks in it (should be '0')
layer := nil;
for lp1:=0 to DXF_Layers.count-1 do
if DXF_Layer(DXF_Layers[lp1]).name='0' then layer := DXF_Layer(DXF_Layers[lp1]);
if layer<>nil then begin
for lp2:=0 to layer.num_lists-1 do begin
eList := Entity_List(layer.entity_lists[lp2]);
if eList.name=Block_.ClassName then begin
for lp3:=0 to eList.entities.Count-1 do begin
DXF_Entity(eList.entities[lp3]).write_to_DXF(IO_chan,layer.name);
end;
end;
end;
end;
writeln(IO_chan,0,EOL,'ENDSEC');
end;
function DXF_Writer.write_entities : boolean;
var lp1,lp2,lp3 : integer;
layer : DXF_Layer;
eList : Entity_List;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'ENTITIES');
for lp1:=0 to DXF_layers.count-1 do begin
layer := DXF_Layer(DXF_Layers[lp1]);
for lp2:=0 to layer.num_lists-1 do begin
eList := Entity_List(layer.entity_lists[lp2]);
if eList.name<>Block_.ClassName then begin
for lp3:=0 to eList.entities.Count-1 do begin
DXF_Entity(eList.entities[lp3]).write_to_DXF(IO_chan,layer.name);
end;
end;
end;
end;
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);
//progress.position := progress.position+1;
end{GotMore};
// 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: Ansichar;
// label retry;
begin
// retry:
byte(fLine[0]):=0;
While (ii<num_in_buf) or GotMore do begin
c:=AnsiChar(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 // Extra code added to handle C/Unix style LF not CR/LF
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);
// if fLine='' then goto retry;
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); { y next }
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;
{ --------------------------------------------------------------------------- }
{ Header section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_header_section : boolean;
begin
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;
{ --------------------------------------------------------------------------- }
{ Blocks section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_blocks_section : boolean;
begin
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
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
result := read_entity(s,'ENDBLK',entity,layer);
if entity<>nil then block.entities.Add(entity);
end;
until result;
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;
{ --------------------------------------------------------------------------- }
{ Tables (Layers - VPort) section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_tables_section : boolean;
begin
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;
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;
{ removed Aspectratio stuff since it never seems to make any difference
and sometimes buggers everything up
if (Group=DXF_floatvals1) then Aspect := ValDbl;
}
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;
{ --------------------------------------------------------------------------- }
{ Entities section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_entity_section : boolean;
begin
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;
{ --------------------------------------------------------------------------- }
{ Entity reading code
{ --------------------------------------------------------------------------- }
function DXF_Reader.read_entity_data(ent:abstract_entity) : boolean;
var Groupcode : integer;
begin
ent.OCS_Z := WCS_Z;
repeat
Groupcode := NextGroupCode;
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
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 = 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;
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_;
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);
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;
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
if (NextGroupCode=0) and (ValStr = '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';
// this should set result to true, because 0 SEQEND is next
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_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='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
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;
begin
result := true;
try
mark_position;
if not (move_to_header_section and read_header) then begin
Sleep(message_delay_ms);
goto_marked_position;
end;
mark_position;
if not (move_to_tables_section and read_tables) then begin
Sleep(message_delay_ms);
goto_marked_position;
end;
mark_position;
if not (move_to_blocks_section and read_blocks) then begin
Sleep(message_delay_ms);
goto_marked_position;
end;
mark_position;
if not (move_to_entity_section and read_entities) 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);
end;
on E:EAccessViolation do begin
MessageDlg(E.message, mtWarning, [mbOK], 0);
end;
end;
if p1_eq_p2_3D(min_extents,origin3D) or p1_eq_p2_3D(max_extents,origin3D) then begin
sleep(message_delay_ms); // just a delay to let the message be visible
for lp1:=0 to DXF_layers.count-1 do
DXF_Layer(DXF_Layers[lp1]).max_min_extents(max_extents,min_extents);
end;
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;
begin
result := FloatToStrF(f,ffFixed,7,3);
//result := FloatToStr(f);
end;
function Point3DToStr(p:Point3D) : string;
begin
result := '(' + FloatToStrF(p.x,ffFixed,7,2) + ', ' +
FloatToStrF(p.y,ffFixed,7,2) + ', ' +
FloatToStrF(p.z,ffFixed,7,2) + ')';
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
inc(entities_in_existence);
end;
destructor DXF_Entity.destroy;
begin
if OCS_WCS<>nil then deallocate_matrix(OCS_WCS);
dec(entities_in_existence);
inherited destroy;
end;
procedure DXF_Entity.init_OCS_WCS_matrix(OCSaxis:Point3D);
var Ax,Ay : Point3D;
begin
OCS_axis := OCSaxis;
if not p1_eq_p2_3D(OCSaxis,WCS_Z) then begin
OCS_WCS := allocate_matrix;
if (abs(OCSaxis.x)<1/64) and (abs(OCSaxis.y)<1/64) then Ax := normalize(cross(WCS_Y,OCSaxis))
else Ax := normalize(cross(WCS_Z,OCSaxis));
Ay := normalize(cross(OCSaxis,Ax));
OCS_WCS^ := CreateTransformation(Ax,Ay,OCSaxis);
end;
end;
procedure DXF_Entity.setcolour_index(col:integer);
begin
colinx := col;
colour := DXF_Layer_Colours[col mod (def_cols+1)];
end;
procedure DXF_Entity.setcolour(col:TColor);
var lp1 : integer;
begin
colinx := 0;
for lp1:=0 to def_cols do if DXF_Layer_Colours[lp1]=col then colinx := lp1;
colour := col;
end;
function DXF_Entity.count_points : integer;
begin result := 1; end;
function DXF_Entity.count_lines : integer;
begin result := 0; end;
function DXF_Entity.count_polys_open : integer;
begin result := 0; end;
function DXF_Entity.count_polys_closed : integer;
begin result := 0; end;
function DXF_Entity.proper_name : string;
var temp : string;
begin
temp := UpperCase(ClassName);
result := Copy(temp,1,Length(temp)-1);
end;
procedure DXF_Entity.write_DXF_Point(var IO:textfile; n:integer; p:Point3D);
begin
writeln(IO, n , EOL,float_out(p.x) );
writeln(IO, n+10 , EOL,float_out(p.y) );
writeln(IO, n+20 , EOL,float_out(p.z) );
end;
procedure DXF_Entity.write_to_DXF(var IO:textfile; layer:string);
begin
writeln(IO,0 ,EOL,proper_name);
writeln(IO,8 ,EOL,layer);
writeln(IO,62,EOL,colinx);
if OCS_WCS<>nil then write_DXF_Point(IO,210,OCS_axis);
end;
function DXF_Entity.is_point_inside_object2D(p:Point3D) : boolean;
begin
result := false;
end;
function DXF_Entity.Move_point(p,newpoint:Point3D) : boolean;
begin
result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Block_ class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Block_.create(bname:string; refpoint:Point3D);
begin
entities := TList.Create;
basepoint := refpoint;
if not p1_eq_p2_3D(basepoint,origin3D) then begin
OCS_WCS := allocate_matrix;
OCS_WCS^ := TranslateMatrix(p1_minus_p2(origin3D,basepoint));
end;
name := bname;
end;
destructor Block_.destroy;
var lp1 : integer;
begin
for lp1:=0 to entities.count-1 do DXF_Entity(entities[lp1]).free;
entities.Free;
end;
procedure Block_.update_block_links(blist:TObject);
var lp1 : integer;
begin
for lp1:=0 to entities.count-1 do if (TObject(entities[lp1]) is Insert_) then
Insert_(entities[lp1]).update_block_links(blist);
end;
procedure Block_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1 : integer;
t_matrix : pMatrix;
TempMatrix : Matrix;
begin
// we mustn't use the update_transformations call because blocks may be
// nested inside blocks inside other blocks, and update_transformations uses
// a temp fixed matrix which will be overwritten.
if OCS=nil then t_matrix := OCS_WCS
else if OCS_WCS=nil then t_matrix := OCS
else begin
TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
t_matrix := @TempMatrix;
end;
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).draw(acanvas,map_fn,t_matrix);
end;
procedure Block_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1 : integer;
begin
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).drawvertices(acanvas,map_fn,OCS);
end;
function Block_.details : string;
var lp1 : integer;
begin
result := 'Name :'#9 + name + EOL +
'Base :'#9 + Point3DToStr(basepoint);
for lp1:=0 to entities.count-1 do result := result + EOL + EOL + DXF_Entity(entities[lp1]).details;
end;
procedure Block_.write_to_DXF(var IO:textfile; layer:string);
var lp1 : integer;
begin
writeln(IO,0 ,EOL,proper_name);
writeln(IO,8 ,EOL,layer);
writeln(IO,2 ,EOL,name);
write_DXF_Point(IO,10,basepoint);
for lp1:=0 to entities.count-1 do DXF_Entity(entities[lp1]).write_to_DXF(IO,layer);
writeln(IO,0 ,EOL,'ENDBLK');
end;
procedure Block_.max_min_extents(var emax,emin:Point3D);
begin end;
function Block_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin result := 1E9; end;
function Block_.closest_vertex(p:Point3D) : Point3D;
begin result := aPoint3D(1E9,1E9,1E9); end;
///////////////////////////////////////////////////////////////////////////////
// Point
///////////////////////////////////////////////////////////////////////////////
constructor Point_.create(OCSaxis,p:Point3D; col:integer);
begin
inherited create;
p1 := p;
setcolour_index(col);
init_OCS_WCS_matrix(OCSaxis);
end;
procedure Point_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
end;
procedure Point_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
end;
procedure Point_.translate(T:Point3D);
begin
p1 := p1_plus_p2(p1,T);
end;
procedure Point_.quantize_coords(epsilon:double; mask:byte);
begin
if (mask and 1)=1 then p1.x := round(p1.x*epsilon)/epsilon;
if (mask and 2)=2 then p1.y := round(p1.y*epsilon)/epsilon;
if (mask and 4)=4 then p1.z := round(p1.z*epsilon)/epsilon;
end;
function Point_.details : string;
var t : string;
begin
if OCS_WCS<>nil then t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else t := 'WCS';
result := ClassName + EOL + t + EOL + Point3DToStr(p1);
end;
procedure Point_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
write_DXF_Point(IO,10,p1);
end;
procedure Point_.max_min_extents(var emax,emin:Point3D);
begin
max_bound(emax,p1); min_bound(emin,p1);
end;
function Point_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin
result := sq_dist2D(p1,p);
end;
function Point_.closest_vertex(p:Point3D) : Point3D;
begin
result := p1;
end;
function Point_.Move_point(p,newpoint:Point3D) : boolean;
begin
if p1_eq_p2_3D(p1,p) then begin
p1 := newpoint;
result := true;
end else result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Text
///////////////////////////////////////////////////////////////////////////////
constructor Text_.create(OCSaxis,p,ap:Point3D; ss:string; height:double; col,ha:integer);
begin
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;
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;
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;
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;
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;
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);
var lp1 : integer;
begin
inherited create(OCSaxis,p,col);
blockname := block;
blockptr := nil;
scale := s_f;
rotation := DegToRad(rot);
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];
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;
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)));
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);
begin
blocklist := blist;
if blockname<>'' then block.update_block_links(blist);
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
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;
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 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<>colour then Color:=colour;
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);
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_;
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<>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;
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));
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);
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;
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)));
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));
// 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];
setcolour_index(col);
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<>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 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<>colour then Color:=colour;
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);
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;
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_);
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);
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,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;
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<>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;
///////////////////////////////////////////////////////////////////////////////
// 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];
setcolour_index(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<>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;
///////////////////////////////////////////////////////////////////////////////
// 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;
begin
for lp1:=0 to (entities.Count-1) do DXF_Entity(entities[lp1]).Free;
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]).colour := 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
layer_name := l_name;
entity_names := TStringList.Create;
entity_lists := TList.Create;
inc(layers_in_existence);
end;
destructor DXF_Layer.destroy;
var lp1 : integer;
el : Entity_List;
begin
if num_lists>0 then for lp1:=num_lists-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;
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.colour=0) or (entity.colour=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_Object.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_Object.create_from_file(aname:string; skipped:Tstrings);
var reader : DXF_Reader;
begin
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);
end;
destructor DXF_Object.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_Object.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_Object.num_layers : integer;
begin
result := layer_lists.Count
end;
function DXF_Object.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_Object.add_layer(layer:DXF_Layer) : boolean;
var lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
if DXF_Layer(layer_lists[lp1]).name=layer.name then
raise DXF_Exception.Create('Attempted to add layer with existing name');
layer_lists.Add(layer);
end;
function DXF_Object.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_Object.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_Object.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_Object.merge_files(DXF_:DXF_Object) : 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_Object.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_Object.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_Object.get_min_extent : Point3D;
begin
result := emin;
end;
function DXF_Object.get_max_extent : Point3D;
begin
result := emax;
end;
procedure DXF_Object.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_Object;
layer : DXF_layer;
el : Entity_List;
begin
DXF := DXF_Object.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_Object.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;
procedure DXF_Entity.ExportToPowerCad(Cad: TPCDrawing;
map_fn: PC_convert;LayerNum:integer;OCS:pM);
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_Object.ExportToPowerCad(Cad: TPCDrawing;Layered,incVertex:Boolean);
var Layer:DXF_Layer;
DXFLayer : Integer;
lp1: integer;
emax,emin : Point3d;
begin
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;
if not layered then
begin
DXFLayer := Cad.NewLayer('DXFLayer');
end;
for lp1:=0 to layer_lists.count-1 do begin
layer := layer_lists[lp1];
if layered then DXFLayer := Cad.NewLayer(layer.layer_name);
layer.ExportToPowerCad(Cad,GetPCPoint,DXFLayer)
end;
if not layered then begin
Cad.SelectAll(DxfLayer);
Cad.GroupSelection;
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;
*)
procedure Point_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var po: TDoublePoint;
t_matrix : pMatrix;
begin
//inherited;
t_matrix := update_transformations(OCS_WCS,OCS);
po := map_fn(p1,t_matrix);
if PCVertexOk then Cad.Vertex(LayerNum,po.x,po.y,False);
end;
procedure Line_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var po1,po2: TDoublePoint;
t_matrix : pMatrix;
begin
//inherited;
t_matrix := update_transformations(OCS_WCS,OCS);
po1 := map_fn(p1,t_matrix);
po2 := map_fn(p2,t_matrix);
Cad.Line(LayerNum,po1.x,po1.y,po2.x,po2.y,1,0,colour,0,False);
end;
procedure Text_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var pa : TDoublePoint;
Fheight: Double;
t_matrix : pMatrix;
ratio: double;
begin
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);
cad.TextOut(layernum,pa.x,pa.y,0,fHeight,ratio,textstr,'Arial',0,colour,False);
end;
procedure Attrib_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var pa : TDoublePoint;
Fheight : Double;
t_matrix : pMatrix;
ratio: double;
begin
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;
pa := map_fn(align_pt,OCS_WCS);
cad.TextOut(layernum,pa.x,pa.y,0,fHeight,ratio,tagstr,'Arial',0,colour,False);
end;
procedure Arc_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var pu,pv,pw,px : TDoublePoint;
po,pa,pb : TDoublePoint;
t_matrix: pMatrix;
rad : Double;
cx,cy: Double;
ta,a1,a2: Double;
begin
//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;
if ord(Cad.VerticalZero) = 1 then
begin
a1 := 2*pi - a1;
a2 := 2*pi - a2;
ta := a1;
a1 := a2;
a2 := ta;
end;
if ord(Cad.HorizontalZero) = 1 then
begin
a1 := pi - a1;
a2 := pi - a2;
ta := a1;
a1 := a2;
a2 := ta;
end;
Cad.Arc(LayerNum,cx,cy,rad,a1,a2,1,ord(psSolid),colour,ord(bsClear),0,0,false);
end;
procedure Polyline_.ExportToPowerCad(Cad: TPCDrawing;map_fn: PC_convert;LayerNum:integer;OCS:pM);
var PointArray : TDoublePointArr;
lp1,tn : integer;
t_matrix : pMatrix;
begin
//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);
cad.PolyLine(layernum,PointArray,1,ord(psSolid),colour,0,ord(bsClear),0,closed,false);
end;
procedure Insert_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var lp1 : integer;
t_matrix : pMatrix;
TempMatrix : Matrix;
begin
//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 block.ExportToPowerCad(cad,map_fn,LayerNum,t_matrix);
end;
procedure Circle_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var po,pa,pb:TDoublePoint;
rad:Double;
t_matrix : pMatrix;
cx,cy: Double;
begin
//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;
cad.Circle(layernum,po.x,po.y,rad,1,ord(psSolid),colour,ord(bsClear),0,false)
end;
procedure Block_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;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]).ExportToPowerCAd(cad,map_fn,LayerNum,t_matrix);
end;
procedure Polygon_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var PointArray : TDoublePointArr;
tPointS : TDoublePointArr;
tp : TPoint;
lp1,lp2,inx,i : integer;
t_matrix : pMatrix;
begin
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];
cad.PolyLine(layernum,tPoints,1,ord(psSolid),colour,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;
cad.PolyLine(layernum,tPoints,1,ord(psSolid),colour,0,ord(bsClear),0,CLoseM,false);
end;
end;
procedure Polyface_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM);
var PointArray : TDoublePointArr;
lp1,lp2,inx : integer;
t_matrix : pMatrix;
begin
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;
cad.Polygon(layernum,PointArray,1,ord(psSolid),colour,ord(bsClear),0,false);
end;
end;
initialization
entities_in_existence := 0;
Ent_lists_in_existence := 0;
layers_in_existence := 0;
DXF_Obj_in_existence := 0;
end.
Reference in New Issue View Git Blame Copy Permalink