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

6414 lines
183 KiB
ObjectPascal
Raw Blame History

unit U_DXFEngineSCS;
interface
uses
Windows,SysUtils,StdCtrls,ComCtrls,Dialogs,Classes,Graphics,math,PCDrawing,
PCTypesUtils, U_Cad, U_Common, DrawObjects, U_BaseCommon, FastStrings;
const
message_delay_ms = 15;
EOL = #13#10;
const
DXF_start = 0;
DXF_text_def = 1;
DXF_name = 2;
DXF_text_prompt = 3;
DXF_othername2 = 4;
DXF_entity_handle = 5;
DXF_line_type = 6;
DXF_text_style = 7;
DXF_layer_name = 8;
DXF_var_name = 9;
DXF_primary_X = 10;
DXF_primary_Y = 20;
DXF_primary_Z = 30;
DXF_other_X_1 = 11;
DXF_other_Y_1 = 21;
DXF_other_Z_1 = 31;
DXF_other_X_2 = 12;
DXF_other_Y_2 = 22;
DXF_other_Z_2 = 32;
DXF_other_X_3 = 13;
DXF_other_Y_3 = 23;
DXF_other_Z_3 = 33;
DXF_elevation = 38;
DXF_thickness = 39;
DXF_floatval = 40;
DXF_floatvals1 = 41;
DXF_floatvals2 = 42;
DXF_floatvals3 = 43;
DXF_repeat = 49;
DXF_angle1 = 50;
DXF_angle2 = 51;
DXF_angle3 = 52;
DXF_angle4 = 53;
DXF_angle5 = 54;
DXF_angle6 = 55;
DXF_angle7 = 56;
DXF_angle8 = 57;
DXF_angle9 = 58;
DXF_visible = 60;
DXF_colornum = 62;
DXF_entities_flg = 66;
DXF_ent_ident = 67;
DXF_view_state = 69;
DXF_70Flag = 70;
DXF_71Flag = 71;
DXF_72Flag = 72;
DXF_73Flag = 73;
DXF_74Flag = 74;
DXF_extrusionx = 210;
DXF_extrusiony = 220;
DXF_extrusionz = 230;
DXF_comment = 999;
DXFtoPC = 1;
const
max_vertices_per_polyline = 8192; // AutoCAD places a limit on this, but
max_attribs = 16; // I don't know what it is...
max_my_attribs = 16;
type
file_type = (off,geo,pslg);
type
polyface = record
nf : array[0..3] of integer;
end;
pfacelist = ^facelist;
facelist = array[0..0] of polyface;
pintlist = ^intlist;
intlist = array[0..0] of integer;
pattrlist = ^attrlist;
attrlist = array[0..0] of double;
type
Point3D = record
x,y,z : double;
end;
Point2D = record
x,y : Double;
end;
PPoint3D = ^Point3D;
ppointlist = ^pointlist;
pointlist = array[0..0] of Point3D;
const
origin3D: Point3D = (x:0; y:0; z:0);
WCS_X: Point3D = (x:1; y:0; z:0);
WCS_Y: Point3D = (x:0; y:1; z:0);
WCS_Z: Point3D = (x:0; y:0; z:1);
type
pMatrix = ^Matrix;
pM = pMatrix;
Matrix = record
val : array[0..3,0..3] of double;
end;
const
identity : Matrix = (val:((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1)));
// note the addition of base and scale factor for drawing blocks
type
coord_convert = function(P:Point3D; OCS:pMatrix): TPoint of Object;
PC_convert = function(P:Point3D; OCS:pMatrix): TDoublePoint of Object;
type
planar_eq = record
a,b,c,d : double;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Entity - abstract base class - override where neccessary
// All DXF objects will become sub classes of this
///////////////////////////////////////////////////////////////////////////////
type
DXF_Layer = class;
DXF_Entity = class
fcolor: integer;
colinx: integer;
OCS_WCS: pMatrix;
OCS_axis: Point3D;
scale: Point3D;
rotation: double;
SCS_Layer_Handle: integer;
constructor create;
destructor destroy; override;
procedure init_OCS_WCS_matrix(OCSaxis: Point3D); virtual;
procedure update_block_links(blist:TObject); virtual; abstract;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); virtual; abstract;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); virtual; abstract;
procedure setcolour_index(col:integer); virtual;
procedure setcolour(col:TColor); virtual;
procedure translate(T:Point3D); virtual; abstract;
procedure quantize_coords(epsilon:double; mask:byte); virtual; abstract;
function count_points: integer; virtual;
function count_lines: integer; virtual;
function count_polys_open: integer; virtual;
function count_polys_closed: integer; virtual;
function proper_name: string; virtual;
procedure write_DXF_Point(var IO:textfile; n:integer; p:Point3D); virtual;
procedure write_to_DXF(var IO:textfile; layer:string); virtual;
function details : string; virtual; abstract;
procedure max_min_extents(var emax, emin: Point3D); virtual; abstract;
function closest_vertex_square_distance_2D(p:Point3D): double; virtual; abstract;
function closest_vertex(p:Point3D): Point3D; virtual; abstract;
function is_point_inside_object2D(p:Point3D): boolean; virtual;
function Move_point(p,newpoint:Point3D): boolean; virtual;
function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure; virtual;
end;
///////////////////////////////////////////////////////////////////////////////
// Block_ Definition - special case - not to be used like other entities
// Blocks should always appear in layer '0'
// I'm still not quite sure what to do with them - but here goes anyway...
///////////////////////////////////////////////////////////////////////////////
Block_ = class(DXF_Entity)
BeginPoint: Point3D;
name: string;
basepoint: Point3D;
entities: TList;
scale: Point3D;
rotation: double;
angle: double;
constructor create(bname: string; refpoint: Point3D);
destructor destroy; override;
procedure update_block_links(blist:TObject); override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax, emin: Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D): double; override;
function closest_vertex(p:Point3D): Point3D; override;
function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
end;
///////////////////////////////////////////////////////////////////////////////
// Point Definition
///////////////////////////////////////////////////////////////////////////////
Point_ = class(DXF_Entity) // always WCS
p1 : Point3D;
constructor create(OCSaxis, p: Point3D; col: integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer: string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D): double; override;
function closest_vertex(p:Point3D): Point3D; override;
function Move_point(p,newpoint:Point3D): boolean; override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Text Definition
///////////////////////////////////////////////////////////////////////////////
Text_ = class(Point_) // always OCS
h: double;
textstr: string;
align_pt: Point3D; // alignment point
hor_align: integer; // horizontal justification code
angle: double;
ScaleX: double;
constructor create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha: integer);
procedure Draw(acanvas: TCanvas; map_fn: coord_convert; OCS: pM); override;
procedure calcText(acanvas: TCanvas; map_fn: coord_convert; OCS: pM; t: string);
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax, emin: Point3D); override;
function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// MText Definition
///////////////////////////////////////////////////////////////////////////////
MText_ = class(Point_) // always OCS
h: double;
textstr: string;
align_pt: Point3D; // alignment point
hor_align: integer; // horizontal justification code
AngleRad: Double;
AlignIndex: Integer;
constructor create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha, align: integer);
procedure Draw(acanvas: TCanvas; map_fn: coord_convert; OCS: pM); override;
procedure calcText(acanvas: TCanvas; map_fn: coord_convert; OCS: pM; t: string);
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax, emin: Point3D); override;
function GetRichTextByFormat(aStr: string): TRichText;
function ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): TFigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Attrib Definition
///////////////////////////////////////////////////////////////////////////////
Attrib_ = class(Text_) // always OCS
tagstr: string;
visible: boolean;
constructor create(OCSaxis,p,ap:Point3D; ss,tag:string; flag70,flag72:integer; height:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details : string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
end;
patt_array = ^att_array;
att_array = array[0..0] of Attrib_;
///////////////////////////////////////////////////////////////////////////////
// Attdef Definition
///////////////////////////////////////////////////////////////////////////////
Attdef_ = class(Attrib_) // always OCS
promptstr : string;
constructor create(OCSaxis,p,ap:Point3D; ss,tag,prompt:string; flag70,flag72:integer; height:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
end;
///////////////////////////////////////////////////////////////////////////////
// Insert Definition (optionally contains attribs)
///////////////////////////////////////////////////////////////////////////////
Insert_ = class(Point_) // always OCS
BeginPoint: Point3D;
num_attribs: integer;
attribs: array[0..max_attribs] of Attrib_;
blockname: string;
scale: Point3D;
rotation: double;
blockptr: Block_; // use carefully
blocklist: TObject; // to cross reference the blocks
constructor create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string; aBeginPoint: Point3D);
destructor destroy; override;
procedure init_OCS_WCS_matrix(OCSaxis:Point3D); override;
procedure update_block_links(blist:TObject); override;
function block: Block_;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Line Definition
///////////////////////////////////////////////////////////////////////////////
Line_ = class(Point_) // always WCS
p2: Point3D;
fLineStyle: String;
LineTypeScale: Double; // Tolik 09/07/2019 --
constructor create(p_1,p_2:Point3D; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function count_points: integer; override;
function count_lines: integer; override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D): double; override;
function closest_vertex(p:Point3D): Point3D; override;
function Move_point(p,newpoint:Point3D): boolean; override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Circle Definition
///////////////////////////////////////////////////////////////////////////////
Circle_ = class(Point_) // always OCS
radius : double;
fLineStyle: string;
constructor create(OCSaxis,p_1:Point3D; radius_:double; col:integer);
constructor create_from_polyline(ent1:DXF_Entity);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function is_point_inside_object2D(p:Point3D): boolean; override;
procedure max_min_extents(var emax,emin:Point3D); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Arc Definition
///////////////////////////////////////////////////////////////////////////////
Arc_ = class(Circle_) // always OCS
angle1, angle2 : double;
fLineStyle: string;
constructor create(OCSaxis,p_1:Point3D; radius_,sa,ea:double; col:integer);
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function is_point_inside_object2D(p: Point3D): boolean; override;
procedure max_min_extents(var emax, emin: Point3D); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline Definition
///////////////////////////////////////////////////////////////////////////////
Polyline_ = class(DXF_Entity) // OCS/WCS depends
closed: boolean;
numvertices: integer;
polypoints: ppointlist;
numattrs: integer;
attribs: array[0..max_my_attribs - 1] of double;
fLineStyle: string;
constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
destructor destroy; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function count_points: integer; override;
function count_lines: integer; override;
function count_polys_open: integer; override;
function count_polys_closed: integer; override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D): double; override;
function closest_vertex(p:Point3D): Point3D; override;
// some functions I use...most removed....
function Move_point(p,newpoint:Point3D): boolean; override;
function is_point_inside_object2D(p:Point3D): boolean; override;
function triangle_centre: Point3D;
procedure set_attrib(i:integer; v:double);
function get_attrib(i:integer): double;
procedure copy_attribs(p:Polyline_);
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// LwPolyline Definition
///////////////////////////////////////////////////////////////////////////////
LWPolyline_ = class(DXF_Entity) // OCS/WCS depends
closed: boolean;
numvertices: integer;
polypoints: ppointlist;
numattrs: integer;
attribs: array[0..max_my_attribs - 1] of double;
fLineStyle: string;
constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
destructor destroy; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
procedure translate(T:Point3D); override;
procedure quantize_coords(epsilon:double; mask:byte); override;
function count_points: integer; override;
function count_lines: integer; override;
function count_polys_open: integer; override;
function count_polys_closed: integer; override;
function details: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
procedure max_min_extents(var emax,emin:Point3D); override;
function closest_vertex_square_distance_2D(p:Point3D): double; override;
function closest_vertex(p:Point3D): Point3D; override;
// some functions I use...most removed....
function Move_point(p,newpoint:Point3D): boolean; override;
function is_point_inside_object2D(p:Point3D): boolean; override;
function triangle_centre: Point3D;
procedure set_attrib(i:integer; v:double);
function get_attrib(i:integer): double;
procedure copy_attribs(p:Polyline_);
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): Tfigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Face3D_ Definition - Should be 3DFace but can't name a type starting with 3
///////////////////////////////////////////////////////////////////////////////
Face3D_ = class(Polyline_) // always WCS
constructor create(numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
function proper_name: string; override; // save as 3DFACE not Face3D
procedure write_to_DXF(var IO:textfile; layer:string); override;
end;
///////////////////////////////////////////////////////////////////////////////
// Solid_ Definition
///////////////////////////////////////////////////////////////////////////////
Solid_ = class(Face3D_) // always OCS
thickness: double;
constructor create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
function proper_name: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function details: string; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh) Definition
///////////////////////////////////////////////////////////////////////////////
Polygon_mesh_ = class(Polyline_) // always WCS ???
M,N: integer;
closeM,closeN: boolean;
constructor create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
function proper_name: string; override;
procedure write_to_DXF(var IO:textfile; layer:string); override;
function details: string; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh) Definition
///////////////////////////////////////////////////////////////////////////////
Polyface_mesh_ = class(Polyline_) // always WCS ???
numfaces: integer;
facelist: pfacelist;
constructor create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
destructor destroy; override;
function proper_name: string; override;
procedure write_to_DXF(var IO:textfile; layer: string); override;
function details: string; override;
procedure Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM); override;
function ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer;OCS:pM): TFigure; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class definition
// An entity list is a collection of entities (in this case all the same type)
// I wanted to keep polylines & lines etc in separate lists, so the DXF_Layer
// will automatically handle this.
///////////////////////////////////////////////////////////////////////////////
Entity_List = class
private
function add_at_end(entity:DXF_Entity): boolean;
function insert(entity:DXF_Entity): boolean;
public
list_name: string;
parent_layer: DXF_Layer;
Kludge_layer: DXF_Layer; // see selection.save...
entities: TList;
sorted: boolean;
constructor create(l_name:string);
destructor destroy; override;
property name : string read list_name write list_name;
function add_entity_to_list(entity:DXF_Entity) : boolean;
function remove_entity(ent:DXF_Entity) : boolean;
procedure draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
procedure draw_vertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
function num_entities : integer;
function count_points : integer;
function count_lines : integer;
function count_polys_open : integer;
function count_polys_closed : integer;
procedure max_min_extents(var emax,emin:Point3D);
procedure setcolour(col:integer);
function closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
function find_bounding_object(p:Point3D) : DXF_Entity;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_layer class definition
// A collection of entity lists. One for each type.
///////////////////////////////////////////////////////////////////////////////
DXF_Layer = class
layer_name: string;
layer_colinx: integer;
entity_names: TStringList;
entity_lists: TList;
SCS_Layer_Handle: integer;
constructor create(l_name:string);
destructor destroy; override;
procedure delete(aname:string; releasemem:boolean);
property Colour : integer read layer_colinx write layer_colinx;
property name : string read layer_name write layer_name;
function add_entity_to_layer(entity:DXF_Entity) : boolean;
// Add a pre filled list (save selected to file... see selected lists)
procedure add_entity_list(elist:Entity_List);
// utilities
function num_lists : integer;
procedure max_min_extents(var emax,emin:Point3D);
function create_or_find_list_type(aname:string): Entity_List;
procedure ExportToPowerCad(Cad: TPCDrawing;map_fn:PC_convert;LayerNum:integer);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Object class definition
// A Collection of DXF_Layers - eg a whole DXF file.
///////////////////////////////////////////////////////////////////////////////
type
DXF_ObjectSCS = class
DXF_name: string;
layer_lists: TList;
emax: Point3D;
emin: Point3D;
PCWh: Double;
PCWw: Double;
CadHeight: Double;
CadWidth: Double;
// Create an empty object
constructor create(aname:string);
// Create an object and load from file
constructor create_from_file(aname:string; skipped:Tstrings);
destructor destroy; override;
procedure save_to_file(aname:string);
property name : string read DXF_name write DXF_name;
function num_layers: integer;
// add an empty layer
function new_layer(aname:string; DUPs_OK:boolean) : DXF_Layer;
// add a pre-filled layer
function add_layer(layer:DXF_Layer) : boolean;
// return the layer with a given name
function layer(aname:string) : DXF_Layer;
// add an entity to a named layer
function add_entity_to_layer(entity:DXF_Entity; aname:string) : boolean;
// return layer and create if neccessary
function create_or_find_layer(aname:string) : DXF_Layer;
// Add a second DXF file to this one
function merge_files(DXF_:DXF_ObjectSCS) : boolean;
// Useful ones
procedure remove_empty_layers_and_lists;
procedure copy_to_strings(ts:TStrings);
function get_min_extent: Point3D;
function get_max_extent: Point3D;
// update the extents (not really needed)
procedure max_min_extents(var emax,emin:Point3D);
procedure ExportToPowerCad(Cad: TPCDrawing;Layered,IncVertex: Boolean);
function GetPCPoint(P:Point3D; OCS:pMatrix): TDoublePoint;
end;
///////////////////////////////////////////////////////////////////////////////
// Selection_lists class definition
// A collection of entity lists. Used by mouse selection routines
///////////////////////////////////////////////////////////////////////////////
type
selection_lists = class
entity_lists : TList;
constructor create;
destructor destroy; override;
procedure save_to_DXF_file(aname:string);
function find_closest_2D_point(p:Point3D; var ent:DXF_Entity) : Point3D;
function is_inside_object(p:Point3D; var ent:DXF_Entity) : Point3D;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF exceptions will be this type
///////////////////////////////////////////////////////////////////////////////
type
DXF_exception = class(Exception);
///////////////////////////////////////////////////////////////////////////////
// Default AutoCad layer colours (1..7) - (8..user defined)
///////////////////////////////////////////////////////////////////////////////
const
BYLAYER = 256;
const
def_cols = 12;
DXF_Layer_Colours : array[0..def_cols] of TColor = (clBlack, clRed, clYellow, clLime, clAqua, clBlue, clPurple,
clBlack, clOlive, clFuchsia, clTeal, clGray, clDkGray);
var
PCVertexOk: Boolean;
///////////////////////////////////////////////////////////////////////////////
// General point 3D stuff
///////////////////////////////////////////////////////////////////////////////
function aPoint3D(a,b,c:double): Point3D;
function p1_eq_p2_3D(p1,p2:Point3D): boolean;
function p1_eq_p2_2D(p1,p2:Point3D): boolean;
function p1_minus_p2(p1,p2:Point3D): Point3D;
function p1_plus_p2 (p1,p2:Point3D): Point3D;
function normalize(p1:Point3D): Point3D;
function mag(p1:Point3D): double;
function dist3D(p1,p2:Point3D): double;
function dist2D(p1,p2:Point3D): double;
function sq_dist3D(p1,p2:Point3D): double;
function sq_dist2D(p1,p2:Point3D): double;
function sq_mag3D(p1:Point3D): double;
function p1_x_n(p1:Point3D; n:double): Point3D;
function set_accuracy(factor:double; p:Point3D): Point3D;
///////////////////////////////////////////////////////////////////////////////
// Vector 3D stuff
///////////////////////////////////////////////////////////////////////////////
function dot(p1,p2:Point3D): double;
function cross(p1,p2:Point3D): Point3D;
function angle(p1,p2,p3:Point3D; do_3D:boolean): double;
///////////////////////////////////////////////////////////////////////////////
// Rotations for Insert/Block drawing
///////////////////////////////////////////////////////////////////////////////
function XRotateMatrix(cos_a,sin_a:double): Matrix;
function YRotateMatrix(cos_a,sin_a:double): Matrix;
function ZRotateMatrix(cos_a,sin_a:double): Matrix;
function ScaleMatrix(p:Point3D): Matrix;
function TranslateMatrix(p:Point3D): Matrix;
function MatrixMultiply(matrix1,matrix2:Matrix): Matrix;
function CreateTransformation(Ax,Ay,Az:Point3D): Matrix;
function TransformPoint(TM:Matrix; p:Point3D): Point3D;
function update_transformations(OCS_WCS,OCS:pMatrix): pMatrix;
function RotationAxis(A:Point3D; angle:double): Matrix;
///////////////////////////////////////////////////////////////////////////////
// Bounds
///////////////////////////////////////////////////////////////////////////////
procedure max_bound(var bounds:Point3D; point:Point3D);
procedure min_bound(var bounds:Point3D; point:Point3D);
function dmin(a,b:double) : double;
function dmax(a,b:double) : double;
function imin(a,b:integer) : integer;
function imax(a,b:integer) : integer;
///////////////////////////////////////////////////////////////////////////////
// Memory
///////////////////////////////////////////////////////////////////////////////
function allocate_points(n:integer) : ppointlist;
procedure deallocate_points(var pts:ppointlist; n:integer);
function allocate_matrix : pMatrix;
procedure deallocate_matrix(var m:pMatrix);
///////////////////////////////////////////////////////////////////////////////
// String
///////////////////////////////////////////////////////////////////////////////
function float_out(f:double): string;
function Point3DToStr(p:Point3D): string;
function BoolToStr(b:boolean): string;
///////////////////////////////////////////////////////////////////////////////
// DXF_Writer class definition
///////////////////////////////////////////////////////////////////////////////
type
DXF_Writer = class
private
IO_Chan: Text;
public
// Extents in (x,y) of the dataset
min_extents: Point3D;
max_extents: Point3D;
DXF_Layers: TList;
// Constructors and destructors
Constructor create(aname: string; data_list: TList);
Destructor destroy; override;
procedure write_file;
// 1 - Header section
function write_header: boolean;
// 2 - Classes section
function write_classes: boolean;
// 3 - Tables section
function write_tables: boolean;
function write_layer_information: boolean;
function write_ltype_information: boolean;
function write_vport_information: boolean;
// 4 - Blocks section
function write_blocks: boolean;
// 5 - Entities section
function write_entities: boolean;
// 6 - Objects section
function write_objects: boolean;
// 7 - Thumbnailimage section
function write_thumbnailimage: boolean;
end;
// DXF File write exceptions will be this type
type
DXF_write_exception = class(Exception);
///////////////////////////////////////////////////////////////////////////////
// DXF_Reader class definition
///////////////////////////////////////////////////////////////////////////////
Const
MaxSizeOfBuf = 4096;
type
//tCharArray = array [0..MaxSizeOfBuf - 1] of char;
tCharArray = array [0..MaxSizeOfBuf - 1] of AnsiChar;
type
abstract_entity = class;
DXF_Reader = class
private
// used when reading data from the file
IO_chan: file;
SizeOfBuf: integer;
num_in_buf: integer;
ii: integer;
EC, fCode: integer;
pBuf: ^tCharArray;
Line_num: longint;
fLine: shortstring;
//progress : TProgressBar;
// useful bits to make parsing easier...
file_pos: integer;
marked_pos: integer;
backflag: boolean;
procedure go_back_to_last(code:integer; str:shortstring);
procedure mark_position;
procedure goto_marked_position;
//
procedure go_back_to_start;
function NextGroupCode: integer;
function ValStr: shortstring;
function ValDbl: double;
function ValInt: integer;
function code_and_string(var group:integer; var s:string): boolean;
function code_and_double(var group:integer; var d:double): boolean;
function read_2Dpoint(var p1:Point3D): boolean;
function skip_upto_section(name:string): boolean;
// lowest level read function
function read_entity_data(ent: abstract_entity): boolean;
function read_generic(var layer:integer): abstract_entity;
// we can read most entities with this one
function general_purpose_read(obj_type:TClass; var entity:DXF_Entity; var layer:integer): boolean;
// inserts/polylines need a little more complexity
function read_insert(var entity:DXF_Entity; var layer:integer): boolean;
function read_polyline(var entity:DXF_Entity; var layer:integer): boolean;
function read_lwpolyline(var entity:DXF_Entity; var layer:integer): boolean;
// this calls the others above
function read_entity(s,endstr:string; var entity:DXF_Entity; var layer:integer): boolean;
public
// Extents in (x,y) of the dataset
min_extents: Point3D;
max_extents: Point3D;
// We will read the Entities in the layers into this list
DXF_Layers: TList;
colour_BYLAYER: boolean;
skipped: TStrings;
// Constructors and destructors
Constructor Create (const aName: shortstring);
Destructor Destroy; override;
// 1 - Header section
function move_to_header_section: boolean;
function read_header: boolean;
function get_min_extent: Point3D;
function get_max_extent: Point3D;
// 2 -Classes section
function move_to_classes_section: boolean;
function read_classes: boolean;
// 3 - Tables section
function move_to_tables_section: boolean;
function read_tables: boolean;
function read_layer_information: boolean;
function read_vport_information: boolean;
function layer_num(layername:string) : integer;
// 4 - Blocks section
function move_to_blocks_section: boolean;
function read_blocks: boolean;
function read_block: boolean;
function block_list: Entity_List;
// 5 - Entities section
function move_to_entity_section: boolean;
function read_entities: boolean;
// 6 - Objects section
function move_to_objects_section: boolean;
function read_objects: boolean;
// 7 - Thumbnailimage section
function move_to_thumbnailimage_section: boolean;
function read_thumbnailimage: boolean;
// These are the main routines to use
function read_file: boolean;
function remove_empty_layers: boolean;
function release_control_of_layers: TList;
procedure set_skipped_list(s: TStrings);
end;
///////////////////////////////////////////////////////////////////////////////
// This is a simple class used only during file reads, it should not be used
// as a base for any objects.
// It is to allow all entities to be read using the same basic structure
// even though they all use different group codes
// Add extra group codes if you need to recognize them
///////////////////////////////////////////////////////////////////////////////
abstract_entity = class
p1, p2, p3, p4: Point3D;
rad_hgt: double;
angle1, angle2: double;
fv1, fv2, fv3: double;
thickness: double;
colour: integer;
flag_70, flag_71, flag_72, flag_73, flag_74: integer;
attflag: integer;
namestr, tagstr, promptstr: string;
layer: string;
elev: double;
OCS_Z: Point3D;
procedure clear;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF file read exceptions will be this type
///////////////////////////////////////////////////////////////////////////////
type
DXF_read_exception = class(Exception)
line_number: integer;
constructor create(err_msg:string; line:integer);
end;
///////////////////////////////////////////////////////////////////////////////
// Memory check variables
///////////////////////////////////////////////////////////////////////////////
var
entities_in_existence: integer;
Ent_lists_in_existence: integer;
layers_in_existence: integer;
DXF_Obj_in_existence: integer;
GArcsCount: Integer = 0;
GRotPoints: TDoublePoint;
implementation
uses U_Constants, U_ExportDXF, U_ImportDXF;
{ --------------------------------------------------------------------------- }
{ ------------------- DXFWriter ----------------------- }
{ --------------------------------------------------------------------------- }
Constructor DXF_Writer.Create(aname:string; data_list:TList);
begin
Inherited Create;
AssignFile(IO_Chan,aName);
Rewrite(IO_Chan);
DXF_Layers := data_list;
end;
destructor DXF_Writer.Destroy;
begin
CloseFile(IO_chan);
Inherited Destroy;
end;
procedure DXF_Writer.write_file;
begin
// 1
write_header;
// 2
write_classes;
// 3
write_tables;
// 4
write_blocks;
// 5
write_entities;
// 6
write_objects;
// 7
write_thumbnailimage;
writeln(IO_chan, 0, EOL, 'EOF');
end;
// 1
function DXF_Writer.write_header : boolean;
var
lp1 : integer;
begin
min_extents := aPoint3D( 1E10, 1E10, 1E10);
max_extents := aPoint3D(-1E10,-1E10,-1E10);
writeln(IO_chan, 0, EOL, 'SECTION');
writeln(IO_chan, 2, EOL, 'HEADER');
for lp1 := 0 to DXF_layers.count - 1 do
DXF_Layer(DXF_Layers[lp1]).max_min_extents(max_extents, min_extents);
writeln(IO_chan,9 ,EOL,'$EXTMIN');
writeln(IO_chan,10,EOL,FloatToStr(min_extents.x));
writeln(IO_chan,20,EOL,FloatToStr(min_extents.y));
writeln(IO_chan,30,EOL,FloatToStr(min_extents.z));
{//01.11.2012 test
writeln(IO_chan,10,EOL,0);
writeln(IO_chan,20,EOL,0);
writeln(IO_chan,30,EOL,FloatToStr(min_extents.z));}
writeln(IO_chan,9 ,EOL,'$EXTMAX');
writeln(IO_chan,10,EOL,FloatToStr(max_extents.x));
writeln(IO_chan,20,EOL,FloatToStr(max_extents.y));
writeln(IO_chan,30,EOL,FloatToStr(max_extents.z));
writeln(IO_chan,0,EOL,'ENDSEC');
end;
// 2
function DXF_Writer.write_classes: boolean;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'CLASSES');
writeln(IO_chan,0,EOL,'ENDSEC');
end;
// 3
function DXF_Writer.write_tables : boolean;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'TABLES');
write_vport_information;
write_ltype_information;
write_layer_information;
writeln(IO_chan,0,EOL,'ENDSEC');
end;
function DXF_Writer.write_layer_information : boolean;
var
lp1: integer;
layer: DXF_Layer;
begin
writeln(IO_chan, 0, EOL, 'TABLE');
writeln(IO_chan, 2, EOL, 'LAYER');
for lp1 := 0 to DXF_layers.count - 1 do
begin
layer := DXF_Layer(DXF_Layers[lp1]);
writeln(IO_chan, 0, EOL, 'LAYER');
if layer.name = '' then
layer.name := 'Unknown';
writeln(IO_chan, 2, EOL, layer.name);
writeln(IO_chan, 70, EOL, 0);
if layer.layer_colinx = 0 then
layer.layer_colinx := 7;
writeln(IO_chan, 62, EOL, layer.layer_colinx);
writeln(IO_chan, 6, EOL, 'CONTINUOUS');
end;
writeln(IO_chan,0,EOL,'ENDTAB');
end;
function DXF_Writer.write_ltype_information: boolean;
begin
writeln(IO_chan, 0, EOL, 'TABLE');
writeln(IO_chan, 2, EOL, 'LTYPE');
// Solid
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'SOLID');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'SOLID');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 0);
writeln(IO_chan, 40, EOL, 0);
// Dash
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'DASH');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'DASH');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 2);
writeln(IO_chan, 40, EOL, 0.75);
writeln(IO_chan, 49, EOL, 0.5);
writeln(IO_chan, 49, EOL, -0.25);
// Dot
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'DOT');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'DOT');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 2);
writeln(IO_chan, 40, EOL, 0.25);
writeln(IO_chan, 49, EOL, 0);
writeln(IO_chan, 49, EOL, -0.25);
// DashDot
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'DASHDOT');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'DASHDOT');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 4);
writeln(IO_chan, 40, EOL, 1);
writeln(IO_chan, 49, EOL, 0.5);
writeln(IO_chan, 49, EOL, -0.25);
writeln(IO_chan, 49, EOL, 0);
writeln(IO_chan, 49, EOL, -0.25);
// DashDotDot
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'DASHDOTDOT');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'DASHDOTDOT');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 6);
writeln(IO_chan, 40, EOL, 1.25);
writeln(IO_chan, 49, EOL, 0.5);
writeln(IO_chan, 49, EOL, -0.25);
writeln(IO_chan, 49, EOL, 0);
writeln(IO_chan, 49, EOL, -0.25);
writeln(IO_chan, 49, EOL, 0);
writeln(IO_chan, 49, EOL, -0.25);
// Clear
writeln(IO_chan, 0, EOL, 'LTYPE');
writeln(IO_chan, 2, EOL, 'CLEAR');
writeln(IO_chan, 70, EOL, 0);
writeln(IO_chan, 3, EOL, 'CLEAR');
writeln(IO_chan, 72, EOL, 65);
writeln(IO_chan, 73, EOL, 8);
writeln(IO_chan, 40, EOL, 0);
writeln(IO_chan, 0, EOL, 'ENDTAB');
end;
function DXF_Writer.write_vport_information : boolean;
begin
writeln(IO_chan,0,EOL,'TABLE');
writeln(IO_chan,2,EOL,'VPORT');
// writeln(IO_chan,0,EOL,'VPORT');
writeln(IO_chan,2,EOL,'*ACTIVE');
// writeln(IO_chan,41,EOL,1.0{aspect}:10:6);
writeln(IO_chan,0,EOL,'ENDTAB');
end;
// 4
function DXF_Writer.write_blocks : boolean;
var
i, j, k: integer;
Layer: DXF_Layer;
eList: Entity_List;
begin
writeln(IO_chan, 0, EOL, 'SECTION');
writeln(IO_chan, 2, EOL, 'BLOCKS');
layer := nil;
for i := 0 to DXF_Layers.count - 1 do
begin
Layer := DXF_Layer(DXF_Layers[i]);
for j := 0 to Layer.num_lists - 1 do
begin
eList := Entity_List(layer.entity_lists[j]);
if eList.name = Block_.ClassName then
begin
for k := 0 to eList.entities.Count - 1 do
begin
DXF_Entity(eList.entities[k]).write_to_DXF(IO_chan, layer.name);
end;
end;
end;
end;
writeln(IO_chan, 0, EOL, 'ENDSEC');
end;
// 5
function DXF_Writer.write_entities : boolean;
var
i, j, k: integer;
Layer: DXF_Layer;
eList: Entity_List;
Entity: DXF_Entity;
insert_name: string;
p1: point3D;
a1: double;
begin
writeln(IO_chan, 0, EOL, 'SECTION');
writeln(IO_chan, 2, EOL, 'ENTITIES');
for i := 0 to DXF_layers.count - 1 do
begin
layer := DXF_Layer(DXF_Layers[i]);
for j := 0 to layer.num_lists - 1 do
begin
eList := Entity_List(layer.entity_lists[j]);
// <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD>
if eList.name <> Block_.ClassName then
begin
for k := 0 to eList.entities.Count - 1 do
begin
DXF_Entity(eList.entities[k]).write_to_DXF(IO_chan, layer.name);
end;
end
// <20><><EFBFBD><EFBFBD>
else
begin
for k := 0 to eList.entities.Count - 1 do
begin
Entity := DXF_Entity(eList.entities[k]);
insert_name := BLOCK_(Entity).name;
p1.x := BLOCK_(Entity).basepoint.x;
p1.y := BLOCK_(Entity).basepoint.y;
p1.z := BLOCK_(Entity).basepoint.z;
a1 := BLOCK_(Entity).angle;
writeln(IO_Chan, 0, EOL, 'INSERT');
writeln(IO_Chan, 5, EOL, 'E5');
writeln(IO_Chan, 8, EOL, layer.name);
writeln(IO_chan, 2, EOL, insert_name);
writeln(IO_Chan, 10, EOL, float_out(p1.x));
writeln(IO_Chan, 20, EOL, float_out(p1.y));
writeln(IO_chan, 30, EOL, float_out(p1.z));
writeln(IO_chan, 50, EOL, float_out(a1));
end;
end;
end;
end;
writeln(IO_chan, 0, EOL, 'ENDSEC');
end;
// 6
function DXF_Writer.write_objects: boolean;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'OBJECTS');
writeln(IO_chan,0,EOL,'ENDSEC');
end;
function DXF_Writer.write_thumbnailimage: boolean;
begin
writeln(IO_chan,0,EOL,'SECTION');
writeln(IO_chan,2,EOL,'THUMBNAILIMAGE');
writeln(IO_chan,0,EOL,'ENDSEC');
end;
///////////////////////////////////////////////////////////////////////////////
// abstract_entity implementation
// used when reading vertexes - just to make sure all flags are reset
// quicker than using create/destroy for each vertex.
///////////////////////////////////////////////////////////////////////////////
procedure abstract_entity.clear;
begin
InitInstance(self);
end;
///////////////////////////////////////////////////////////////////////////////
// DXFReader implementation
///////////////////////////////////////////////////////////////////////////////
Constructor DXF_Reader.Create (const aName: shortstring);
begin
Inherited Create;
AssignFile(IO_chan,aName);
Reset(IO_chan, 1);
SizeOfBuf := MaxSizeOfBuf;
GetMem(pBuf,SizeOfBuf);
DXF_Layers := TList.Create;
colour_BYLAYER := false;
Line_num := 0;
backflag := false;
min_extents := origin3D;
max_extents := origin3D;
end;
destructor DXF_Reader.Destroy;
var
lp1: integer;
begin
if (DXF_Layers <> nil) then
for lp1 := 0 to DXF_Layers.count - 1 do
DXF_Layer(DXF_Layers[lp1]).Free;
DXF_Layers.Free;
CloseFile(IO_chan);
FreeMem(pBuf,SizeOfBuf);
Inherited Destroy;
end;
{ --------------------------------------------------------------------------- }
{ Routines for fetching codes and values
{ --------------------------------------------------------------------------- }
procedure DXF_Reader.go_back_to_start;
begin
Reset(IO_chan,1);
num_in_buf := 0;
ii := 0;
end;
procedure DXF_Reader.go_back_to_last(code:integer; str:shortstring);
begin
fCode := code;
fLine := str;
backflag := true;
end;
procedure DXF_Reader.mark_position;
begin
marked_pos := File_pos + ii;
end;
procedure DXF_Reader.goto_marked_position;
begin
Seek(IO_chan, marked_pos);
File_pos := marked_pos;
num_in_buf := 0;
ii := 0;
end;
function DXF_Reader.NextGroupCode: integer;
function GotMore: boolean;
begin
file_pos := FilePos(IO_chan);
BlockRead(IO_chan, pBuf^, SizeOfBuf,num_in_buf);
ec:=IoResult;
ii:=0;
If (ec = 0) and (num_in_buf = 0) then
ec := -1;
GotMore := (ec = 0);
end;
// Sometimes you get (download) a bad DXF file which has a couple of blank
// lines in it. The commented retry code, can be used to skip blank lines, but you
// should only use it as an emergency fix because you'll often find blank lines
// in TEXT entities and other text strings.
function GotLine: boolean;
const
CR=#13;
LF=#10;
var
//c: char;
c: Ansichar;
begin
byte(fLine[0]) := 0;
While (ii < num_in_buf) or GotMore do
begin
c := pBuf^[ii];
inc(ii);
If (c <> CR) and (c <> LF) and (length(fLine) < 255) then
begin
inc(fLine[0]);
fLine[length(fLine)] := c;
end
else
begin
if (c = CR) then
begin
if (ii < num_in_buf) or GotMore then
begin
if pBuf^[ii] = LF then
begin
inc(ii);
break;
end;
end;
end
else
if (c = LF) then
break;
end;
end;
GotLine := (ec = 0) and ((c = CR) or (c = LF));
inc(Line_num);
end;
begin {NextGroupCode}
if backflag then
begin
result := fCode;
backflag := false;
end
else
begin
repeat
if not GotLine then
begin
fCode := -2;
Result := fCode;
exit;
end;
until fLine <> '';
Val(fLine, fCode, ec);
If ec <> 0 then
fCode := -2
else
if not GotLine then
fCode := -2;
Result := fCode;
end;
end {NextGroupCode};
function DXF_Reader.ValStr: shortstring;
begin
Result := fLine;
end;
function DXF_Reader.ValDbl: double;
begin
Val(fLine, Result, ec);
If ec <> 0 then
raise DXF_read_exception.Create('Invalid Floating point conversion',line_num);
end;
function DXF_Reader.ValInt: integer;
begin
Val(fLine, Result, ec);
If ec <> 0 then
raise DXF_read_exception.Create('Invalid Integer conversion',line_num);
end;
function DXF_Reader.code_and_string(var group:integer; var s:string) : boolean;
var
astr: string;
begin
result := true;
group := NextGroupCode;
if group >= 0 then
s := ValStr
else
result := false;
// useful in debugging
// if (group=0) then begin astr := IntToStr(group)+' '+s; alb.Items.Add(astr); end;
end;
function DXF_Reader.code_and_double(var group:integer; var d:double) : boolean;
begin
result := true;
group := NextGroupCode;
if group >= 0 then
d := Valdbl
else
result := false;
end;
// This routine is just for the $EXT(max/min) and should be used with care....
function DXF_Reader.read_2Dpoint(var p1:Point3D) : boolean;
var
Groupcode : integer;
begin
repeat
Groupcode := NextGroupCode;
until (Groupcode=DXF_primary_X) or (Groupcode<0);
if Groupcode < 0 then
begin
result := false;
exit;
end;
p1.x := Valdbl;
result := code_and_double(Groupcode, p1.y);
end;
function DXF_Reader.skip_upto_section(name: string): boolean;
var
Group: integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) then
begin
if (s = 'SECTION') then
begin
if not code_and_string(Group, s) then
break;
if (Group = DXF_name) then
begin
if (s = name) then
result := true
else
exit;
end
else
if skipped <> nil then
Skipped.Add(s);
end
else
if skipped <> nil then
Skipped.Add(s);
end;
until (result);
end;
{ --------------------------------------------------------------------------- }
{ 1 - Header section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_header_section : boolean;
begin
result := false;
result := skip_upto_section('HEADER');
end;
function DXF_Reader.read_header : boolean;
var
Group: integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group,s) then
break;
if (group=9) and (s='$EXTMAX') then
begin
if not read_2Dpoint(max_extents) then
break;
end;
if (group=9) and (s='$EXTMIN') then
begin
if not read_2Dpoint(min_extents) then
break;
end;
if (group=9) and (s='$CECOLOR') then
begin
if (NextGroupCode=DXF_colornum) and (ValInt=256) then
colour_BYLAYER := true;
end;
result := (Group=0) and (s='ENDSEC');
until result;
end;
function DXF_Reader.get_min_extent : Point3D;
begin
result := min_extents;
end;
function DXF_Reader.get_max_extent : Point3D;
begin
result := max_extents;
end;
{ --------------------------------------------------------------------------- }
{ 2 - Classes section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_classes_section: boolean;
begin
result := false;
result := skip_upto_section('CLASSES');
end;
function DXF_Reader.read_classes: boolean;
var
Group: integer;
GroupCode: integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) and (s = 'CLASS') then
begin
if not code_and_string(Group, s) then
break;
if (Group = DXF_name) then
begin
if skipped <> nil then
Skipped.Add(s);
end;
end;
result := (Group = 0) and (s = 'ENDSEC');
until result;
end;
{ --------------------------------------------------------------------------- }
{ 4 - Blocks section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_blocks_section : boolean;
begin
result := false;
result := skip_upto_section('BLOCKS');
end;
function DXF_Reader.read_blocks : boolean;
var
Group: integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) and (s = 'BLOCK') then
begin
if not read_block then
break;
end;
result := (Group=0) and (s = 'ENDSEC');
until result;
end;
function DXF_Reader.read_block : boolean;
var
Groupcode: integer;
s: string;
ent: abstract_entity;
block: Block_;
layer,lp1: integer;
entity: DXF_Entity;
base: Point3D;
begin
result := false;
ent := read_generic(layer);
layer := layer_num('0'); // ALL BLOCKS GOING TO LAYER 0 (makes things easier)
if layer < 0 then
layer := DXF_Layers.Add(DXF_Layer.create('0'));
if ent <> nil then
begin
if ent.namestr <> '_ArchTick' then
begin
block := Block_.create(ent.namestr, ent.p1);
DXF_Layer(DXF_Layers[layer]).add_entity_to_layer(block);
repeat
if not code_and_string(Groupcode,s) then
break;
if (Groupcode = 0) then
begin
GArcsCount := GArcsCount + 1;
result := read_entity(s, 'ENDBLK', entity, layer);
if entity <> nil then
begin
block.entities.Add(entity);
end;
end;
until result;
end
else
begin
s := '';
while s <> 'ENDBLK' do
code_and_string(Groupcode, s);
Result := True;
end;
end;
end;
// we need to know where the blocks are stored for lookup purposes
function DXF_Reader.block_list : Entity_List;
var
lp1,lp2: integer;
layer: DXF_Layer;
begin
for lp1 := 0 to DXF_Layers.count - 1 do
begin
layer := DXF_Layers[lp1];
for lp2 := 0 to layer.entity_lists.count - 1 do
begin
if Entity_List(layer.entity_lists[lp2]).name = 'Block_' then
begin
result := Entity_List(layer.entity_lists[lp2]);
exit;
end;
end;
end;
end;
{ --------------------------------------------------------------------------- }
{ 3 - Tables (Layers - VPort) section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_tables_section : boolean;
begin
result := false;
result := skip_upto_section('TABLES');
end;
function DXF_Reader.read_tables : boolean;
var
Group: integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) and (s = 'TABLE') then
begin
if not code_and_string(Group, s) then
break;
if (Group = DXF_name) then
begin
if (s = 'LAYER') then
read_layer_information
else
if (s = 'VPORT') then
read_vport_information
else
if skipped <> nil then
Skipped.Add(s);
end;
end;
result := (Group=0) and (s='ENDSEC');
until result;
end;
function DXF_Reader.read_layer_information : boolean;
var
Group,Lay_num: integer;
s: string;
begin
lay_num := -1;
result := false;
repeat
if not code_and_string(Group,s) then
break;
if (Group=0) then
begin
if (s='LAYER') then
begin
if not code_and_string(Group,s) then
break;
if (Group=DXF_name) then
lay_num := DXF_Layers.Add(DXF_Layer.create(s));
end
else
if (s='ENDTAB') then
result := true
else
if skipped<>nil then
Skipped.Add(s);
end
else
if (Group=DXF_colornum) and (lay_num<>-1) then
DXF_Layer(DXF_Layers[lay_num]).Colour := ValInt;
until result;
end;
// This no longer does anything !
function DXF_Reader.read_vport_information : boolean;
var
Group : integer;
s: string;
begin
result := false;
result := true;
exit;
repeat
if not code_and_string(Group,s) then
break;
if (Group = 0) then
begin
if (s='VPORT') then
begin
if not code_and_string(Group,s) then
break;
if (Group = DXF_name) then
begin
if (s='*ACTIVE') then
repeat
if not code_and_string(Group, s) then
break;
result := (Group=0) and (s = 'ENDTAB');
until (result)
else
if skipped <> nil then
Skipped.Add(s);
end;
end
else
if skipped <> nil then
Skipped.Add(s);
end
until (result);
end;
function DXF_Reader.layer_num(layername:string) : integer;
var
lp1 : integer;
begin
result := -1;
for lp1:=0 to DXF_Layers.count-1 do
begin
if DXF_Layer(DXF_Layers[lp1]).name=layername then
begin
result := lp1;
exit;
end;
end;
end;
{ --------------------------------------------------------------------------- }
{ 5 - Entities section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_entity_section : boolean;
begin
result := false;
result := skip_upto_section('ENTITIES');
end;
function DXF_Reader.read_entities : boolean;
var
Groupcode,layer: integer;
s: string;
entity: DXF_Entity;
begin
result := false;
repeat
try
if not code_and_string(Groupcode,s) then
break;
if (Groupcode = 0) then
begin
result := read_entity(s, 'ENDSEC', entity, layer);
// put the entity in the layer...
if (entity <> nil) then
DXF_Layer(DXF_Layers[layer]).add_entity_to_layer(entity);
end;
except
on E:DXF_read_exception do
begin
if MessageBox(0,@E.message[1], 'DXF read error warning', MB_OKCANCEL) = IDCANCEL then
raise DXF_read_exception.Create('User aborted', -1);
end;
on E:Exception do Showmessage(E.Message);
end;
until result;
end;
{ --------------------------------------------------------------------------- }
{ 6 - Objects section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_objects_section: boolean;
begin
result := false;
result := skip_upto_section('OBJECTS');
end;
function DXF_Reader.read_objects: boolean;
var
Group: Integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) and (s = 'OBJECTS') then
begin
if not code_and_string(Group, s) then
break;
if (Group = DXF_name) then
begin
if skipped <> nil then
Skipped.Add(s);
end;
end;
result := (Group = 0) and (s = 'ENDSEC');
until result;
end;
{ --------------------------------------------------------------------------- }
{ 7 - Thumbnailimage section
{ --------------------------------------------------------------------------- }
function DXF_Reader.move_to_thumbnailimage_section: boolean;
begin
result := false;
result := skip_upto_section('THUMBNAILIMAGE');
end;
function DXF_Reader.read_thumbnailimage: boolean;
var
Group: Integer;
s: string;
begin
result := false;
repeat
if not code_and_string(Group, s) then
break;
if (Group = 0) and (s = 'THUMBNAILIMAGE') then
begin
if not code_and_string(Group, s) then
break;
if (Group = DXF_name) then
begin
if skipped <> nil then
Skipped.Add(s);
end;
end;
result := (Group = 0) and (s = 'ENDSEC');
until result;
end;
{ --------------------------------------------------------------------------- }
{ Entity reading code
{ --------------------------------------------------------------------------- }
function DXF_Reader.read_entity_data(ent: abstract_entity) : boolean;
var
Groupcode : integer;
str: string;
begin
ent.OCS_Z := WCS_Z;
repeat
Groupcode := NextGroupCode;
str := ValStr;
case Groupcode of
DXF_primary_X:
ent.p1.x := Valdbl;
DXF_primary_Y:
ent.p1.y := Valdbl;
DXF_primary_Z:
ent.p1.z := Valdbl;
DXF_other_X_1:
ent.p2.x := Valdbl;
DXF_other_Y_1:
ent.p2.y := Valdbl;
DXF_other_Z_1:
ent.p2.z := Valdbl;
DXF_other_X_2:
ent.p3.x := Valdbl;
DXF_other_Y_2:
ent.p3.y := Valdbl;
DXF_other_Z_2:
ent.p3.z := Valdbl;
DXF_other_X_3:
ent.p4.x := Valdbl;
DXF_other_Y_3:
ent.p4.y := Valdbl;
DXF_other_Z_3:
ent.p4.z := Valdbl;
DXF_floatval:
ent.rad_hgt := Valdbl;
DXF_floatvals1:
ent.fv1 := Valdbl;
DXF_floatvals2:
ent.fv2 := Valdbl;
DXF_floatvals3:
ent.fv3 := Valdbl;
DXF_angle1:
ent.angle1 := Valdbl;
DXF_angle2:
ent.angle2 := Valdbl;
DXF_thickness:
ent.thickness := Valdbl;
DXF_elevation:
ent.elev := Valdbl;
DXF_70Flag:
ent.flag_70 := ValInt;
DXF_71Flag:
ent.flag_71 := ValInt;
DXF_72Flag:
ent.flag_72 := ValInt;
DXF_73Flag:
ent.flag_73 := ValInt;
DXF_74Flag:
ent.flag_74 := ValInt;
DXF_colornum:
ent.colour := ValInt;
DXF_entities_flg:
ent.attflag := ValInt;
DXF_layer_name:
ent.layer := ValStr;
DXF_name:
ent.namestr := ValStr;
DXF_text_def:
ent.tagstr := ValStr;
DXF_text_prompt:
ent.promptstr := ValStr;
DXF_extrusionx:
ent.OCS_Z.x := Valdbl;
DXF_extrusiony:
ent.OCS_Z.y := Valdbl;
DXF_extrusionz:
ent.OCS_Z.z := Valdbl;
end;
until (Groupcode <= 0); // end or fault;
if Groupcode < 0 then
begin
result := false;
exit;
end;
// we need to put the code=0, and valstr back, so the next entity starts
// with the zero when neccessary
go_back_to_last(Groupcode,fline);
ent.OCS_Z := normalize(ent.OCS_Z); // for safety
result := true;
end;
function DXF_Reader.read_generic(var layer:integer) : abstract_entity;
var
ent: abstract_entity;
s: string;
begin
result := nil;
ent:= abstract_entity.create; // set everything to zero EVERY time
if read_entity_data(ent) then
begin
layer := layer_num(ent.layer);
if layer < 0 then
layer := DXF_Layers.Add(DXF_Layer.create(ent.layer));
result := ent;
end
else
ent.free;
end;
{ These ones are straightforward, so we'll use a crafty TClass parameter }
function DXF_Reader.general_purpose_read(obj_type: TClass; var entity: DXF_Entity; var layer: integer): boolean;
var
ent: abstract_entity;
begin
try
entity := nil;
ent := read_generic(layer);
if ent <> nil then
begin
with ent do
begin
if obj_type = Point_ then
entity := Point_.create(OCS_Z,p1,colour)
else
if obj_type = Text_ then
entity := Text_.create(OCS_Z, p1, p2, tagstr, rad_hgt, colour, flag_72)
else
if obj_type = MText_ then
entity := MText_.create(OCS_Z, p1, p2, tagstr, rad_hgt, colour, flag_72, flag_71)
else
if obj_type = Line_ then
entity := Line_.create(p1, p2, colour)
else
if obj_type = Circle_ then
entity := Circle_.create(OCS_Z, p1, rad_hgt, colour)
else
if obj_type = Arc_ then
entity := Arc_.create(OCS_Z, p1, rad_hgt, angle1, angle2, colour)
// face3ds and solids can have 3 or 4 points, if 4=3, then 3 used
else
if obj_type = Face3D_ then
begin
if p1_eq_p2_3d(p3,p4) then
entity := Face3D_.create(3, @p1, colour,true)
else
entity := Face3D_.create(4, @p1, colour,true);
end
else
if obj_type = Solid_ then
begin
if p1_eq_p2_3d(p3,p4) then
entity := Solid_.create(OCS_Z,3, @p1, colour,thickness)
else
entity := Solid_.create(OCS_Z,4, @p1, colour,thickness);
end
else
if obj_type = Attdef_ then
entity := Attdef_.create(OCS_Z,p1,p2,namestr,tagstr,promptstr,flag_70,flag_72,rad_hgt,colour)
else
if obj_type = Attrib_ then
entity := Attrib_.create(OCS_Z,p1,p2,namestr,tagstr,flag_70,flag_72,rad_hgt,colour);
end;
ent.Free;
result := true;
end;
except
ShowMessage('general_purpose_read');
end;
end;
{ INSERTs may have ATTRIBs + BLOCKs which makes it a little more complicated }
function DXF_Reader.read_insert(var entity: DXF_Entity; var layer: integer) : boolean;
var
ent, ent2: abstract_entity;
code,num: integer;
atts: array[0..255] of Attrib_;
//
Groupcode: integer;
s: string;
begin
result := true;
entity := nil;
num := 0;
ent := read_generic(layer);
if ent <> nil then
begin
if ent.attflag = 1 then
begin
repeat
result := (Nextgroupcode = 0);
if result and (ValStr = 'ATTRIB') then
begin
ent2 := read_generic(layer);
if ent2 <> nil then
with ent2 do
begin
atts[num] := Attrib_.create(OCS_Z,p1,p2,namestr,tagstr,flag_70,flag_72,rad_hgt,colour);
ent2.Free;
inc(num);
end
else
result := false;
end;
until (not result) or (ValStr='SEQEND');
if result then
Nextgroupcode; // remove the SEQEND put back
end;
with ent do
begin
if fv1 = 0 then
fv1 := 1;
if fv2 = 0 then
fv2 := 1;
if fv3 = 0 then
fv3 := 1;
entity := Insert_.create(OCS_Z,p1,aPoint3D(fv1,fv2,fv3),angle1,colour,num,@atts[0],namestr, p1);
try
Insert_(entity).update_block_links(block_list);
except
entity.Free;
entity := nil;
// raise
// DXF_read_exception.Create('Cannot reference an undefined BLOCK'+EOL+EOL+ '(File may not have been saved with BLOCKs)'+EOL,line_num);
end;
end;
ent.Free;
end
else
result := false;
end;
// POLYLINEs have variable number of points...
// Modified to accept polyface mesh variety of polyline ...
// I've ignored the invisible flag for edges
// Modified to accept polygon MxN grid mesh ...
// It's a bit messy - you could simplify it a bit - but hey - what do you
// expect from free code.
function DXF_Reader.read_polyline(var entity: DXF_Entity; var layer: integer) : boolean;
var
ent1,ent2: abstract_entity;
vertices,lp1: integer;
faces: integer;
tempvert: array[0..max_vertices_per_polyline-1] of Point3D;
tempface: array[0..4095] of polyface;
closed_poly: boolean;
M,N,mn: integer;
// my
NextGroupCode_flag: integer;
ValStr_flag: string;
label
vertex_overflow;
begin
result := false;
closed_poly := false;
entity := nil;
ent1 := abstract_entity.create;
// read initial polyline data
if not read_entity_data(ent1) then
begin
ent1.Free;
exit;
end;
layer := layer_num(ent1.layer);
if (layer = -1) then
layer := DXF_Layers.Add(DXF_Layer.create(ent1.layer));
vertices := 0;
faces := 0;
ent2 := abstract_entity.create;
//////////////////////////////////////////
if (ent1.flag_70 and (64 + 16)) = 0 then
begin
// THIS IS A NORMAL POLYLINE
repeat
NextGroupCode_flag := NextGroupCode;
ValStr_flag := ValStr;
if (NextGroupCode_flag = 0) and (ValStr_flag = 'VERTEX') then
begin
ent2.clear;
if read_entity_data(ent2) then
begin
tempvert[vertices] := ent2.p1;
inc(vertices);
if vertices >= max_vertices_per_polyline then
goto vertex_overflow;
end
else
begin
ent1.Free;
ent2.Free;
exit;
end; // error
end;
until fLine = 'SEQEND';
result := NextGroupCode = 0;
if ((ent1.flag_70) and 1) = 1 then
closed_poly := true;
entity := Polyline_.create(ent1.OCS_Z, vertices, @tempvert[0], ent1.colour, closed_poly);
end
//////////////////////////////////////////
else
if (ent1.flag_70 and 16) = 16 then
begin
// THIS IS A POLYGON MESH - a grid of vertices joined along M & N
M := ent1.flag_71;
N := ent1.flag_72;
mn := 0;
repeat
if (NextGroupCode = 0) and (ValStr = 'VERTEX') then
begin
if read_entity_data(ent2) then
begin
inc(mn);
if (ent2.Flag_70 and 64) = 64 then
begin
tempvert[vertices] := ent2.p1;
inc(vertices);
if vertices >= max_vertices_per_polyline then
goto vertex_overflow;
end
else
begin
ent1.Free;
ent2.Free;
exit;
end; // error
end
else
begin
ent1.Free;
ent2.Free;
exit;
end; // error
end;
until fLine = 'SEQEND';
result := NextGroupCode = 0;
if mn <> M * N then
begin
ent1.Free;
ent2.Free;
exit;
end; // error
entity := Polygon_mesh_.create(vertices, M, N, @tempvert[0], ent1.flag_70, ent1.colour);
end
//////////////////////////////////////////
//////////////////////////////////////////
else
if (ent1.flag_70 and 64) = 64 then
begin
// THIS IS A POLYFACE MESH - a vertex array with facets
repeat
if (NextGroupCode = 0) and (ValStr = 'VERTEX') then
begin
if read_entity_data(ent2) then
begin
if (ent2.Flag_70 and (128 + 64)) = (128 + 64) then
begin
// this is a normal coordinate vertex
tempvert[vertices] := ent2.p1;
inc(vertices);
if vertices >= max_vertices_per_polyline then
goto vertex_overflow;
end
else
if (ent2.Flag_70 and (128)) = (128) then
begin
// this is a face definition vertex
// negative indices indicate invisible edges (ignored for now)
tempface[faces].nf[0] := Abs(ent2.flag_71) - 1; // index 1..n -> 0..n-1
tempface[faces].nf[1] := Abs(ent2.flag_72) - 1;
tempface[faces].nf[2] := Abs(ent2.flag_73) - 1;
tempface[faces].nf[3] := Abs(ent2.flag_74) - 1;
inc(faces);
end
else
begin
ent1.Free;
ent2.Free;
exit;
end; // error
end
else
begin
ent1.Free;
ent2.Free;
exit;
end; // error
end;
until fLine='SEQEND';
result := NextGroupCode=0;
entity := Polyface_mesh_.create(vertices, faces, @tempvert[0], @tempface[0], ent1.colour);
end;
//////////////////////////////////////////
ent1.Free;
ent2.Free;
exit; // next bit only when vertices overflow
vertex_overflow:
ent1.Free;
ent2.Free;
raise DXF_read_exception.Create('Polyline contained more than '+ IntToStr(max_vertices_per_polyline)+' vertices', line_num);
end;
function DXF_Reader.read_lwpolyline(var entity: DXF_Entity; var layer: integer): boolean;
var
ent1: abstract_entity;
vertices,lp1: integer;
faces: integer;
tempvert: array[0..max_vertices_per_polyline-1] of Point3D;
tempface: array[0..4095] of polyface;
closed_poly: boolean;
M,N,mn: integer;
// my
NextGroupCode_flag: integer;
ValStr_flag: string;
ValDbl_flag: Double;
ValInt_flag: Integer;
VertCount: Integer;
label
vertex_overflow;
begin
result := false;
closed_poly := false;
entity := nil;
ent1 := abstract_entity.create;
layer := layer_num(ent1.layer);
if (layer = -1) then
layer := DXF_Layers.Add(DXF_Layer.create(ent1.layer));
vertices := 0;
faces := 0;
begin
// THIS IS A NORMAL POLYLINE
repeat
NextGroupCode_flag := NextGroupCode;
ValStr_flag := ValStr;
if (NextGroupCode_flag = 90) then
begin
ValInt_flag := ValInt;
VertCount := ValInt_flag;
end;
if (NextGroupCode_flag = 70) then
begin
ValInt_flag := ValInt;
if ValInt_flag = 1 then
closed_poly := true
else
closed_poly := false;
end;
if (NextGroupCode_flag = 10) then
begin
ent1.clear;
while vertices < VertCount do
begin
// <20><><EFBFBD><EFBFBD> - 10, 20 <20><><EFBFBD><EFBFBD><EFBFBD>
ent1.p1.x := ValDbl;
NextGroupCode_flag := NextGroupCode;
ent1.p1.y := ValDbl;
tempvert[vertices] := ent1.p1;
inc(vertices);
if vertices >= max_vertices_per_polyline then
goto vertex_overflow;
// <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD>. <20><><EFBFBD><EFBFBD><EFBFBD>
if vertices < VertCount then
NextGroupCode_flag := NextGroupCode;
end;
result := true;
end;
// result := (NextGroupCode_flag = 0);
until result;
ent1.OCS_Z.z := 1;
ent1.colour := 0;
entity := LWPolyline_.create(ent1.OCS_Z, vertices, @tempvert[0], ent1.colour, closed_poly);
end;
ent1.Free;
exit; // next bit only when vertices overflow
vertex_overflow:
ent1.Free;
raise DXF_read_exception.Create('LwPolyline contained more than '+ IntToStr(max_vertices_per_polyline)+' vertices', line_num);
end;
function DXF_Reader.read_entity(s, endstr: string; var entity: DXF_Entity; var layer: integer): boolean;
begin
entity := nil;
result := false;
if (s = 'POINT') then
begin
if not general_purpose_read(Point_, entity,layer) then
raise DXF_read_exception.Create('Error reading POINT entity',line_num);
end
else
if (s = 'INSERT') then
begin
if not read_insert(entity,layer) then
raise DXF_read_exception.Create('Error reading INSERT entity',line_num);
end
else
if (s = 'TEXT') then
begin
if not general_purpose_read(Text_,entity,layer) then
raise DXF_read_exception.Create('Error reading TEXT entity',line_num);
end
else
if (s = 'MTEXT') then
begin
if not general_purpose_read(MText_,entity,layer) then
raise DXF_read_exception.Create('Error reading TEXT entity',line_num);
end
else
if (s = 'LINE') then begin
if not general_purpose_read(Line_,entity,layer) then
raise DXF_read_exception.Create('Error reading LINE entity',line_num);
end
else
if (s = 'POLYLINE') then
begin
if not read_polyline(entity, layer) then
raise DXF_read_exception.Create('Error reading POLYLINE entity', line_num);
end
// LWPOLYLINE
else
if (s = 'LWPOLYLINE') then
begin
if not read_lwpolyline(entity, layer) then
raise DXF_read_exception.Create('Error reading POLYLINE entity', line_num);
end
//
else
if (s = '3DFACE') then
begin
if not general_purpose_read(Face3D_,entity,layer) then
raise DXF_read_exception.Create('Error reading 3DFACE entity',line_num);
end
else
if (s = 'SOLID') then begin
if not general_purpose_read(Solid_,entity,layer) then
raise DXF_read_exception.Create('Error reading SOLID entity',line_num);
end
else
if (s = 'CIRCLE') then begin
if not general_purpose_read(Circle_,entity,layer) then
raise DXF_read_exception.Create('Error reading CIRCLE entity',line_num);
end
else
if (s = 'ARC') then
begin
if not general_purpose_read(Arc_,entity,layer) then
raise DXF_read_exception.Create('Error reading ARC entity',line_num);
end
else
if (s = 'ATTDEF') then
begin
if not general_purpose_read(AttDef_,entity,layer) then
raise DXF_read_exception.Create('Error reading ATTDEF entity',line_num);
end
else
if (s = 'ATTRIB') then
begin
if not general_purpose_read(Attrib_,entity,layer) then
raise DXF_read_exception.Create('Error reading ATTRIB entity',line_num);
end
else
if (s = endstr) then
result := true
else
if skipped <> nil then
Skipped.Add(s);
end;
///////////////////////////////////////////////////////////////////////////////
// Main routines to use
///////////////////////////////////////////////////////////////////////////////
function DXF_Reader.read_file : boolean;
var
lp1: integer;
move_to_header_section_flag: Boolean;
read_header_flag: Boolean;
move_to_classes_section_flag: Boolean;
read_classes_flag: Boolean;
move_to_tables_section_flag: Boolean;
read_tables_flag: Boolean;
move_to_blocks_section_flag: Boolean;
read_blocks_flag: Boolean;
move_to_entity_section_flag: Boolean;
read_entities_flag: Boolean;
move_to_objects_section_flag: Boolean;
read_objects_flag: Boolean;
move_to_thumbnailimage_section_flag: Boolean;
read_thumbnailimage_flag: Boolean;
LogStr: string;
begin
result := true;
try
LogStr := '';
// 1 - HEADER
try
mark_position;
move_to_header_section_flag := move_to_header_section;
read_header_flag := read_header;
if not (move_to_header_section_flag and read_header_flag) then
begin
LogStr := LogStr + cImport_Mes6;
sleep(message_delay_ms);
goto_marked_position;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section1', E.Message);
end;
// 2 - CLASSES
try
mark_position;
move_to_classes_section_flag := move_to_classes_section;
read_classes_flag := read_classes;
if not (move_to_classes_section_flag and read_classes_flag) then
begin
LogStr := LogStr + #13#10 + cImport_Mes7;
sleep(message_delay_ms);
goto_marked_position;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section2', E.Message);
end;
// 3 - TABLES
try
mark_position;
move_to_tables_section_flag := move_to_tables_section;
read_tables_flag := read_tables;
if not (move_to_tables_section_flag and read_tables_flag) then
begin
LogStr := LogStr + #13#10 + cImport_Mes8;
sleep(message_delay_ms);
goto_marked_position;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section3', E.Message);
end;
// 4 - BLOCKS
try
mark_position;
move_to_blocks_section_flag := move_to_blocks_section;
read_blocks_flag := read_blocks;
if not (move_to_blocks_section_flag and read_blocks_flag) then
begin
LogStr := LogStr + #13#10 + cImport_Mes9;
sleep(message_delay_ms);
goto_marked_position;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section4', E.Message);
end;
// 5 - ENTITIES
try
mark_position;
move_to_entity_section_flag := move_to_entity_section;
read_entities_flag := read_entities;
if not (move_to_entity_section_flag and read_entities_flag) then
begin
LogStr := LogStr + #13#10 + cImport_Mes10;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section5', E.Message);
end;
// 6 - OBJECTS
try
mark_position;
move_to_objects_section_flag := move_to_objects_section;
read_objects_flag := read_objects;
if not (move_to_objects_section_flag and read_objects_flag) then
begin
LogStr := LogStr + #13#10 + cImport_Mes11;
sleep(message_delay_ms);
goto_marked_position;
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file, Section6', E.Message);
end;
// 7 - THUMBNAILIMAGE
// mark_position;
// move_to_thumbnailimage_section_flag := move_to_thumbnailimage_section;
// read_thumbnailimage_flag := read_thumbnailimage;
// if not (move_to_thumbnailimage_section_flag and read_thumbnailimage_flag) then
// begin
// sleep(message_delay_ms);
// goto_marked_position;
// end;
// if not (move_to_objects_section_flag and read_objects_flag) then
// raise DXF_read_exception.Create('No Entities or invalid Entities section in DXF file', -1);
except
on E: DXF_read_exception do
begin
MessageBox(0,@E.message[1],'DXF Read Error',MB_ICONWARNING);
AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
end;
on E: EAccessViolation do
begin
MessageDlg(E.message, mtWarning, [mbOK], 0);
AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
end;
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
end;
try
if p1_eq_p2_3D(min_extents,origin3D) or p1_eq_p2_3D(max_extents,origin3D) then
begin
sleep(message_delay_ms);
for lp1 := 0 to DXF_layers.count - 1 do
DXF_Layer(DXF_Layers[lp1]).max_min_extents(max_extents,min_extents);
end;
except
on E: Exception do AddExceptionToLogEx('DXF_Reader.read_file', E.Message);
end;
// if LogStr <> '' then
// ShowMessage(LogStr);
end;
function DXF_Reader.remove_empty_layers : boolean;
var
lp1: integer;
layer: DXF_layer;
begin
for lp1 := DXF_Layers.count - 1 downto 0 do
begin
layer := DXF_Layers[lp1];
if layer.num_lists = 0 then
begin
DXF_Layers.Remove(layer);
layer.Free;
end;
end;
result := (DXF_Layers.count > 0);
end;
// Hand over ownership of the layers, the owner of the entity lists
// is now responsible for their destruction
function DXF_Reader.release_control_of_layers : TList;
begin
result := DXF_Layers;
DXF_Layers := nil;
end;
// Since we're not reading all groupcodes, we offer the chance
// to dump the main titles into a list so we can see what
// we've missed
procedure DXF_Reader.set_skipped_list(s:TStrings);
begin
skipped := s;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF File exception
///////////////////////////////////////////////////////////////////////////////
constructor DXF_read_exception.create(err_msg:string; line:integer);
begin
if line>-1 then
message := err_msg + #13#10 + 'Error occured at or near line number ' + IntToStr(line)
else
message := err_msg;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF UTils
///////////////////////////////////////////////////////////////////////////////
function aPoint3D(a,b,c:double) : Point3D;
begin
result.x := a; result.y := b; result.z := c;
end;
function p1_eq_p2_3D(p1,p2:Point3D) : boolean;
begin
result := (p1.x=p2.x) and (p1.y=p2.y) and (p1.z=p2.z);
end;
function p1_eq_p2_2D(p1,p2:Point3D) : boolean;
begin
result := (p1.x=p2.x) and (p1.y=p2.y);
end;
function p1_minus_p2(p1,p2:Point3D) : Point3D;
begin
result.x := p1.x-p2.x;
result.y := p1.y-p2.y;
result.z := p1.z-p2.z;
end;
function p1_plus_p2(p1,p2:Point3D) : Point3D;
begin
result.x := p1.x+p2.x;
result.y := p1.y+p2.y;
result.z := p1.z+p2.z;
end;
function normalize(p1:Point3D) : Point3D;
var mag : double;
begin
mag := Sqrt( sqr(p1.x) + sqr(p1.y) + sqr(p1.z) );
result.x := p1.x/mag;
result.y := p1.y/mag;
result.z := p1.z/mag;
end;
function mag(p1:Point3D) : double;
begin
with p1 do
result := Sqrt( sqr(x) + sqr(y) + sqr(z) );
end;
function dist3D(p1,p2:Point3D) : double;
begin
with p1_minus_p2(p2,p1) do
result := Sqrt( sqr(x) + sqr(y) + sqr(z) );
end;
function dist2D(p1,p2:Point3D) : double;
begin
with p1_minus_p2(p2,p1) do
result := Sqrt( sqr(x) + sqr(y) );
end;
function sq_dist3D(p1,p2:Point3D) : double;
begin
with p1_minus_p2(p2,p1) do
result := sqr(x) + sqr(y) + sqr(z);
end;
function sq_dist2D(p1,p2:Point3D) : double;
begin
with p1_minus_p2(p2,p1) do
result := sqr(x) + sqr(y);
end;
function sq_mag3D(p1:Point3D) : double;
begin
with p1 do
result := sqr(x) + sqr(y) + sqr(z);
end;
function p1_x_n(p1:Point3D; n:double) : Point3D;
begin
result.x := p1.x*n;
result.y := p1.y*n;
result.z := p1.z*n;
end;
function set_accuracy(factor:double; p:Point3D) : Point3D;
begin
result.x := round(p.x*factor)/factor;
result.y := round(p.y*factor)/factor;
result.z := round(p.z*factor)/factor;
end;
///////////////////////////////////////////////////////////////////////////////
// Vector 3D stuff
///////////////////////////////////////////////////////////////////////////////
function dot(p1,p2:Point3D) : double;
begin
result := p1.x*p2.x + p1.y*p2.y + p1.z*p2.z;
end;
function cross(p1,p2:Point3D) : Point3D;
begin
result.x := p1.y*p2.z - p1.z*p2.y;
result.y := p1.z*p2.x - p1.x*p2.z;
result.z := p1.x*p2.y - p1.y*p2.x;
end;
function angle(p1,p2,p3:Point3D; do_3D:boolean) : double;
var
v1,v2 : Point3D;
d1,d2 : double;
begin
v1 := p1_minus_p2(p2,p1);
v2 := p1_minus_p2(p3,p2);
if not do_3D then
begin
v1.z := 0;
v2.z := 0;
end;
d1 := Mag(v1);
d2 := Mag(v2);
if ((d1=0) or (d2=0)) then
result := 0
else
begin
d1 := dot(v1,v2)/(d1*d2);
if abs(d1)<=1 then
result := ArcCos(d1)
else
result := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Rotations for Insert/Block drawing
///////////////////////////////////////////////////////////////////////////////
function XRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
result := identity;
result.val[1,1]:= cos_a;
result.val[1,2]:=-sin_a;
result.val[2,1]:= sin_a;
result.val[2,2]:= cos_a;
end;
function YRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
result := identity;
result.val[0,0]:= cos_a;
result.val[0,2]:= sin_a;
result.val[2,0]:=-sin_a;
result.val[2,2]:= cos_a;
end;
function ZRotateMatrix(cos_a,sin_a:double) : Matrix;
begin
result := identity;
result.val[0,0]:= cos_a;
result.val[0,1]:=-sin_a;
result.val[1,0]:= sin_a;
result.val[1,1]:= cos_a;
end;
function ScaleMatrix(p:Point3D) : Matrix;
begin
result := identity;
result.val[0,0] := p.x;
result.val[1,1] := p.y;
result.val[2,2] := p.z;
end;
function TranslateMatrix(p:Point3D) : Matrix;
begin
result := identity;
result.val[3,0] := p.x;
result.val[3,1] := p.y;
result.val[3,2] := p.z;
end;
function MatrixMultiply(matrix1,matrix2:matrix) : Matrix;
var row,column : integer;
begin
for row:=0 to 3 do
begin
for column:=0 to 3 do
result.val[row,column]:= matrix1.val[row,0]*matrix2.val[0,column] + matrix1.val[row,1]*matrix2.val[1,column] +
matrix1.val[row,2]*matrix2.val[2,column] + matrix1.val[row,3]*matrix2.val[3,column];
end;
end;
var
GlobalTempMatrix : Matrix;
function update_transformations(OCS_WCS,OCS:pMatrix) : pMatrix;
begin
if OCS = nil then
result := OCS_WCS
else
if OCS_WCS = nil then
result := OCS
else
begin
GlobalTempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
result := @GlobalTempMatrix;
end;
end;
{ Matrix order : For reference
start with a point at ( cos(30),sin(30),0 )
rotate by 30 degrees - shifts point to (1,0,0)
then translate by (10,0,0) shifts to (11,0,0)
then rotate by -45 degrees goes to (7.77, 7.77 ,0) 7.77 = Sqrt(11^2 /2 )
NOTE THE ORDER OF MATRIX OPERATIONS !
test := aPoint3D( cos(degtorad(30)) , sin(degtorad(30)) , 0);
mat := ZRotateMatrix( cos(degtorad(30)) , sin(degtorad(30)) );
mat := MatrixMultiply( mat , TranslateMatrix(aPoint3D(10,0,0)) );
mat := MatrixMultiply( mat , ZRotateMatrix( cos(degtorad(-45)) , sin(degtorad(-45)) ) );
test := TransformPoint(mat,test);
}
function CreateTransformation(Ax,Ay,Az:Point3D) : Matrix;
begin
result := Identity;
result.val[0,0] :=Ax.x;
result.val[1,0] :=Ay.x;
result.val[2,0] :=Az.x;
result.val[0,1] :=Ax.y;
result.val[1,1] :=Ay.y;
result.val[2,1] :=Az.y;
result.val[0,2] :=Ax.z;
result.val[1,2] :=Ay.z;
result.val[2,2] :=Az.z;
end;
function TransformPoint(TM:Matrix; p:Point3D) : Point3D;
begin
with TM do begin
result.x := p.x*val[0,0] + p.y*val[1,0] + p.z*val[2,0] + val[3,0];
result.y := p.x*val[0,1] + p.y*val[1,1] + p.z*val[2,1] + val[3,1];
result.z := p.x*val[0,2] + p.y*val[1,2] + p.z*val[2,2] + val[3,2];
end;
end;
function RotationAxis(A:Point3D; angle:double) : Matrix;
var
sin_a,cos_a : double;
begin
result := Identity;
sin_a := sin(angle);
cos_a := cos(angle);
result.val[0][0] := (A.x*A.x + (1. - A.x*A.x)*cos_a);
result.val[1][0] := (A.x*A.y*(1. - cos_a) + A.z*sin_a);
result.val[2][0] := (A.x*A.z*(1. - cos_a) - A.y*sin_a);
result.val[0][1] := (A.x*A.y*(1. - cos_a) - A.z*sin_a);
result.val[1][1] := (A.y*A.y + (1. - A.y*A.y)*cos_a);
result.val[2][1] := (A.y*A.z*(1. - cos_a) + A.x*sin_a);
result.val[0][2] := (A.x*A.z*(1. - cos_a) + A.y*sin_a);
result.val[1][2] := (A.y*A.z*(1. - cos_a) - A.x*sin_a);
result.val[2][2] := (A.z*A.z + (1. - A.z*A.z)*cos_a);
end;
///////////////////////////////////////////////////////////////////////////////
// Bounds
///////////////////////////////////////////////////////////////////////////////
procedure max_bound(var bounds:Point3D; point:Point3D);
begin
if point.x>bounds.x then
bounds.x := point.x;
if point.y>bounds.y then
bounds.y := point.y;
if point.z>bounds.z then
bounds.z := point.z;
end;
procedure min_bound(var bounds:Point3D; point:Point3D);
begin
if point.x<bounds.x then
bounds.x := point.x;
if point.y<bounds.y then
bounds.y := point.y;
if point.z<bounds.z then
bounds.z := point.z;
end;
function dmin(a,b:double) : double;
begin
if a < b then
result := a
else
result := b;
end;
function dmax(a,b:double) : double;
begin
if a>b then
result := a
else
result := b;
end;
function imax(a,b:integer) : integer;
begin
if a>b then
result :=a
else
result:=b;
end;
function imin(a,b:integer) : integer;
begin
if a>b then
result :=b
else
result:=a;
end;
///////////////////////////////////////////////////////////////////////////////
// Memory
///////////////////////////////////////////////////////////////////////////////
function allocate_points(n:integer) : ppointlist;
begin
Getmem(result,n*SizeOf(Point3D));
end;
procedure deallocate_points(var pts:ppointlist; n:integer);
begin
Freemem(pts,n*SizeOf(Point3D));
pts := nil;
end;
function allocate_matrix : pMatrix;
begin
Getmem(result,SizeOf(Matrix));
end;
procedure deallocate_matrix(var m:pMatrix);
begin
Freemem(m,SizeOf(Matrix));
m := nil;
end;
///////////////////////////////////////////////////////////////////////////////
// String
///////////////////////////////////////////////////////////////////////////////
function float_out(f:double) : string;
var
SavedSeparator: Char;
begin
// result := FloatToStrF(f, ffFixed, 7, 3);
SavedSeparator := DecimalSeparator;
DecimalSeparator := '.';
result := FloatToStrF(f, ffFixed, 7, 3);
DecimalSeparator := SavedSeparator;
// result := FloatToStr(f);
end;
function Point3DToStr(p:Point3D) : string;
var
SavedSeparator: Char;
begin
SavedSeparator := DecimalSeparator;
DecimalSeparator := '.';
result := '(' + FloatToStrF(p.x, ffFixed, 7, 3) + ', ' +
FloatToStrF(p.y, ffFixed, 7, 3) + ', ' +
FloatToStrF(p.z, ffFixed, 7, 3) + ')';
DecimalSeparator := SavedSeparator;
end;
function BoolToStr(b:boolean) : string;
begin
if b then
result := 'TRUE'
else
result := 'FALSE';
end;
procedure draw_cross(acanvas:TCanvas; p1:TPoint);
var
pa,pb : TPoint;
begin
pa.x := p1.x-2; pa.y := p1.y-2;
pb.x := p1.x+3; pb.y := p1.y+3;
acanvas.Moveto(pa.x,pa.y);
acanvas.Lineto(pb.x,pb.y);
pa.x := p1.x-2; pa.y := p1.y+2;
pb.x := p1.x+3; pb.y := p1.y-3;
acanvas.Moveto(pa.x,pa.y);
acanvas.Lineto(pb.x,pb.y);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Entity - abstract base class - override where neccessary
///////////////////////////////////////////////////////////////////////////////
constructor DXF_Entity.create;
begin
// Tolik -- 10/02/20107 --
OCS_WCS := nil;
//
SCS_Layer_Handle := 0;
scale.x := -10000;
scale.y := -10000;
scale.z := -10000;
rotation := -10000;
inc(entities_in_existence);
end;
destructor DXF_Entity.destroy;
begin
if OCS_WCS<>nil then
deallocate_matrix(OCS_WCS);
dec(entities_in_existence);
inherited destroy;
end;
procedure DXF_Entity.init_OCS_WCS_matrix(OCSaxis:Point3D);
var
Ax,Ay : Point3D;
begin
OCS_axis := OCSaxis;
if not p1_eq_p2_3D(OCSaxis,WCS_Z) then
begin
OCS_WCS := allocate_matrix;
if (abs(OCSaxis.x)<1/64) and (abs(OCSaxis.y)<1/64) then
Ax := normalize(cross(WCS_Y,OCSaxis))
else
Ax := normalize(cross(WCS_Z,OCSaxis));
Ay := normalize(cross(OCSaxis,Ax));
OCS_WCS^ := CreateTransformation(Ax,Ay,OCSaxis);
end;
end;
procedure DXF_Entity.setcolour_index(col:integer);
begin
colinx := col;
fcolor := col; //DXF_Layer_Colours[col mod (def_cols + 1)];
end;
procedure DXF_Entity.setcolour(col:TColor);
var
lp1 : integer;
begin
colinx := 0;
for lp1:=0 to def_cols do
if DXF_Layer_Colours[lp1]=col then
colinx := lp1;
// fcolor := col;
end;
function DXF_Entity.count_points : integer;
begin
result := 1;
end;
function DXF_Entity.count_lines : integer;
begin
result := 0;
end;
function DXF_Entity.count_polys_open : integer;
begin
result := 0;
end;
function DXF_Entity.count_polys_closed : integer;
begin
result := 0;
end;
function DXF_Entity.proper_name : string;
var
temp : string;
begin
temp := UpperCase(ClassName);
result := Copy(temp,1,Length(temp)-1);
end;
procedure DXF_Entity.write_DXF_Point(var IO:textfile; n:integer; p:Point3D);
begin
writeln(IO, n, EOL, float_out(p.x));
writeln(IO, n + 10, EOL, float_out(p.y));
writeln(IO, n + 20, EOL, float_out(p.z));
end;
procedure DXF_Entity.write_to_DXF(var IO:textfile; layer: string);
var
DxfColor: Integer;
begin
writeln(IO, 0, EOL, proper_name);
writeln(IO, 8, EOL, layer);
DxfColor := ColorToDxfColor(fColor);
writeln(IO, 62, EOL, Dxfcolor);
if OCS_WCS <> nil then
write_DXF_Point(IO, 210, OCS_axis);
end;
function DXF_Entity.is_point_inside_object2D(p:Point3D) : boolean;
begin
result := false;
end;
function DXF_Entity.Move_point(p,newpoint:Point3D) : boolean;
begin
result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Block_ class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Block_.create(bname:string; refpoint:Point3D);
begin
entities := TList.Create;
basepoint := refpoint;
if not p1_eq_p2_3D(basepoint,origin3D) then
begin
OCS_WCS := allocate_matrix;
OCS_WCS^ := TranslateMatrix(p1_minus_p2(origin3D,basepoint));
end;
name := bname;
scale.x := -10000;
scale.y := -10000;
scale.z := -10000;
rotation := -10000;
BeginPoint.x := -10000;
BeginPoint.y := -10000;
BeginPoint.z := -10000;
angle := 0;
end;
destructor Block_.destroy;
var
lp1 : integer;
begin
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).free;
entities.Free;
end;
procedure Block_.update_block_links(blist:TObject);
var
lp2 : integer;
begin
for lp2:=0 to entities.count-1 do
begin
if (TObject(entities[lp2]) is Insert_) then
Insert_(entities[lp2]).update_block_links(blist);
end;
end;
procedure Block_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
lp1: integer;
t_matrix: pMatrix;
TempMatrix: Matrix;
begin
// we mustn't use the update_transformations call because blocks may be
// nested inside blocks inside other blocks, and update_transformations uses
// a temp fixed matrix which will be overwritten.
if OCS=nil then
t_matrix := OCS_WCS
else
if OCS_WCS=nil then
t_matrix := OCS
else
begin
TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
t_matrix := @TempMatrix;
end;
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).draw(acanvas,map_fn,t_matrix);
end;
procedure Block_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
lp1 : integer;
begin
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).drawvertices(acanvas,map_fn,OCS);
end;
function Block_.details : string;
var
lp1 : integer;
begin
result := 'Name :'#9 + name + EOL + 'Base :'#9 + Point3DToStr(basepoint);
for lp1:=0 to entities.count-1 do
result := result + EOL + EOL + DXF_Entity(entities[lp1]).details;
end;
procedure Block_.write_to_DXF(var IO:textfile; layer:string);
var
lp1 : integer;
begin
writeln(IO, 0, EOL, proper_name);
writeln(IO, 8, EOL, layer);
writeln(IO, 2, EOL, name);
writeln(IO, 70, EOL, 0);
write_DXF_Point(IO, 10, basepoint);
for lp1:=0 to entities.count-1 do
DXF_Entity(entities[lp1]).write_to_DXF(IO,layer);
writeln(IO,0 ,EOL,'ENDBLK');
end;
procedure Block_.max_min_extents(var emax, emin: Point3D);
var
i: integer;
begin
for i := 0 to entities.Count - 1 do
begin
DXF_Entity(entities[i]).max_min_extents(emax, emin);
end;
end;
function Block_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin
result := 1E9;
end;
function Block_.closest_vertex(p:Point3D) : Point3D;
begin
result := aPoint3D(1E9,1E9,1E9);
end;
///////////////////////////////////////////////////////////////////////////////
// Point
///////////////////////////////////////////////////////////////////////////////
constructor Point_.create(OCSaxis,p:Point3D; col:integer);
begin
inherited create;
p1 := p;
fcolor := col;
init_OCS_WCS_matrix(OCSaxis);
end;
procedure Point_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
po: TPoint;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color <> fcolor then
Color:=fcolor;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
end;
procedure Point_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
po: TPoint;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color <> fcolor then
Color:=fcolor;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
end;
procedure Point_.translate(T:Point3D);
begin
p1 := p1_plus_p2(p1,T);
end;
procedure Point_.quantize_coords(epsilon:double; mask:byte);
begin
if (mask and 1)=1 then
p1.x := round(p1.x*epsilon)/epsilon;
if (mask and 2)=2 then
p1.y := round(p1.y*epsilon)/epsilon;
if (mask and 4)=4 then
p1.z := round(p1.z*epsilon)/epsilon;
end;
function Point_.details : string;
var
t : string;
begin
if OCS_WCS<>nil then
t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else
t := 'WCS';
result := ClassName + EOL + t + EOL + Point3DToStr(p1);
end;
procedure Point_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
write_DXF_Point(IO,10,p1);
end;
procedure Point_.max_min_extents(var emax,emin:Point3D);
begin
max_bound(emax,p1); min_bound(emin,p1);
end;
function Point_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin
result := sq_dist2D(p1,p);
end;
function Point_.closest_vertex(p:Point3D) : Point3D;
begin
result := p1;
end;
function Point_.Move_point(p,newpoint:Point3D) : boolean;
begin
if p1_eq_p2_3D(p1,p) then
begin
p1 := newpoint;
result := true;
end
else
result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Text
///////////////////////////////////////////////////////////////////////////////
constructor Text_.create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha: integer);
//var f: TextFile;
begin
// Tolik -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
{ AssignFile(f, 'd:\Color.txt');
Append(f);
Writeln(f,ss + ' Color == ' + Inttostr(Col));
CloseFile(f);}
//
inherited create(OCSaxis, p, col);
h := height;
if ss <> '' then
textstr := ss;
if p1_eq_p2_3D(ap, origin3D) then
ap := p;
align_pt := ap;
hor_align := ha;
angle := 0;
ScaleX := 1;
fcolor := col;
end;
procedure Text_.calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
var
pa,dummy1,dummy2: TPoint;
Fheight: integer;
begin
with acanvas.Pen do
if Color <> fcolor then
Color:=fcolor;
// kludgy method for scaling text heights
dummy1 := map_fn(origin3D,nil);
dummy2 := map_fn(aPoint3D(0,h,0),nil);
Fheight := 2+(dummy1.y-dummy2.y);
if FHeight=2 then
exit;
with acanvas.Font do
begin
if Height<>Fheight then
Height := Fheight;
if color<>fcolor then
color := fcolor;
end;
case hor_align of
0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
end;
pa := map_fn(align_pt,OCS_WCS);
acanvas.TextOut(pa.x,pa.y,t);
end;
procedure Text_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
calcText(acanvas,map_fn,t_matrix,textstr);
end;
function Text_.details : string;
begin
result := inherited details + EOL + 'Text '#9 + textstr + EOL + 'TextHeight = ' + float_out(h);
end;
procedure Text_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO, 40, EOL, float_out(h));
writeln(IO, 1, EOL, textstr);
if hor_align <> 0 then
begin
write_DXF_Point(IO, 11, align_pt);
writeln(IO, 72, EOL, hor_align);
end;
writeln(IO, 50, EOL, float_out(angle));
writeln(IO, 41, EOL, float_out(ScaleX));
end;
procedure Text_.max_min_extents(var emax,emin:Point3D);
begin
max_bound(emax,p1); min_bound(emin,p1);
end;
///////////////////////////////////////////////////////////////////////////////
// Attrib
///////////////////////////////////////////////////////////////////////////////
constructor Attrib_.create(OCSaxis,p,ap:Point3D; ss,tag:string; flag70,flag72:integer; height:double; col:integer);
begin
inherited create(OCSaxis,p,ap,ss,height,col,flag72);
tagstr := tag;
if (flag70 and 1) = 1 then
visible := false
else
visible := true;
fcolor := col;
end;
procedure Attrib_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
if not visible then
exit;
calcText(acanvas,map_fn,t_matrix,tagstr);
end;
function Attrib_.details : string;
var
t : string;
begin
if visible then
t:='Visible'
else
t:='Invisible';
result := inherited details + EOL + 'Tag '#9 + TagStr + EOL + t;
end;
procedure Attrib_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO,2 ,EOL,tagstr);
if visible then
writeln(IO,70 ,EOL,0)
else
writeln(IO,70 ,EOL,1);
end;
///////////////////////////////////////////////////////////////////////////////
// Attdef
///////////////////////////////////////////////////////////////////////////////
constructor Attdef_.create(OCSaxis,p,ap:Point3D; ss,tag,prompt:string; flag70,flag72:integer; height:double; col:integer);
begin
inherited create(OCSaxis,p,ap,ss,tag,flag70,flag72,height,col);
promptstr := prompt;
fcolor := col;
end;
procedure Attdef_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
begin
// Attdefs are used in the blocks section to act as templates for Attribs
// so no need to draw them as there will be an Attrib in its place
end;
procedure Attdef_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO,DXF_text_prompt ,EOL,promptstr);
end;
///////////////////////////////////////////////////////////////////////////////
// Insert
///////////////////////////////////////////////////////////////////////////////
constructor Insert_.create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string; aBeginPoint: Point3D);
var
lp1 : integer;
begin
inherited create(OCSaxis,p,col);
blockname := block;
blockptr := nil;
scale := s_f;
rotation := DegToRad(rot);
BeginPoint := aBeginPoint;
init_OCS_WCS_matrix(OCSaxis);
num_attribs := numatts;
if num_attribs>max_attribs then
raise Exception.Create('This version only handles '+IntToStr(max_attribs)+' ATTRIBs');
for lp1:=0 to num_attribs - 1 do
attribs[lp1] := atts^[lp1];
fcolor := col;
end;
destructor Insert_.destroy;
var
lp1 : integer;
begin
for lp1:=0 to num_attribs-1 do
attribs[lp1].Free;
inherited destroy;
end;
procedure Insert_.init_OCS_WCS_matrix(OCSaxis:Point3D);
var
Ax,Ay : Point3D;
sc1: Point3D;
begin
// inserts always have a transformation matrix - to allow the translation
// even when the other parameters are defauls
OCS_axis := OCSaxis;
OCS_WCS := allocate_matrix;
if (abs(OCSaxis.x)<1/64) and (abs(OCSaxis.y)<1/64) then
Ax := normalize(cross(WCS_Y,OCSaxis))
else
Ax := normalize(cross(WCS_Z,OCSaxis));
Ay := normalize(cross(OCSaxis,Ax));
OCS_WCS^ := Identity;
OCS_WCS^ := MatrixMultiply(OCS_WCS^, ZRotateMatrix(cos(-rotation),sin(-rotation)));
sc1.x := 1;
if scale.x < 0 then
sc1.x := -1;
sc1.y := 1;
if scale.y < 0 then
sc1.y := -1;
OCS_WCS^ := MatrixMultiply(OCS_WCS^, ScaleMatrix(sc1) );
// OCS_WCS^ := MatrixMultiply(OCS_WCS^, ScaleMatrix(scale) );
OCS_WCS^ := MatrixMultiply(OCS_WCS^, TranslateMatrix(p1) );
OCS_WCS^ := MatrixMultiply(OCS_WCS^, CreateTransformation(Ax,Ay,OCSaxis) );
end;
procedure Insert_.update_block_links(blist:TObject);
var
Blk: Block_;
begin
blocklist := blist;
if (blockname <> '') then { and (blockname <> '_ArchTick') then}
begin
Blk := block;
Blk.update_block_links(blist);
end;
end;
// instead of searching for the block every time it's needed, we'll store
// the object pointer after the first time it's used, and return it
// when needed. Only use this function to access it - for safety.
function Insert_.block : Block_;
var
lp1 : integer;
begin
result := nil;
if blockptr = nil then
begin // this bit called once
for lp1:=0 to Entity_List(blocklist).entities.count-1 do
begin
if Block_(Entity_List(blocklist).entities[lp1]).name=blockname then
begin
blockptr := Block_(Entity_List(blocklist).entities[lp1]);
result := blockptr;
exit;
end;
end;
end // this bit every subsequent time
else
result := blockptr;
if result=nil then
raise Exception.Create('Block reference '+blockname+' not found');
end;
procedure Insert_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
lp1: integer;
t_matrix: pMatrix;
TempMatrix: Matrix;
begin
// we mustn't use the update_transformations call because inserts may be
// nested inside blocks inside other blocks, and update_transformations uses
// a temp fixed matrix which will be overwritten.
if OCS=nil then
t_matrix := OCS_WCS
else
if OCS_WCS=nil then
t_matrix := OCS
else
begin
TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
t_matrix := @TempMatrix;
end;
for lp1:=0 to num_attribs-1 do
attribs[lp1].Draw(acanvas,map_fn,t_matrix);
if blockname<>'' then
block.Draw(acanvas,map_fn,t_matrix);
end;
function Insert_.details : string;
var
lp1 : integer;
begin
result := inherited details + EOL +
'Block '#9 + blockname + EOL +
'Scaling'#9 + Point3DToStr(scale) + EOL +
'Rotation'#9 + float_out(RadToDeg(rotation)) + EOL +
'Attribs '#9 + IntToStr(num_attribs);
for lp1:=0 to num_attribs-1 do
begin
result := result + EOL + EOL;
result := result + IntToStr(lp1+1) + ' : ' + attribs[lp1].details;
end;
result := result + EOL + EOL +
'----BLOCK-----' + EOL +
block.details + EOL +
'---ENDBLOCK---';
end;
procedure Insert_.write_to_DXF(var IO:textfile; layer:string);
var
lp1 : integer;
begin
inherited;
if blockname <> '' then
writeln(IO,2,EOL,blockname);
if (scale.x <> 1) or (scale.y <> 1) or (scale.z <> 1) then
begin
writeln(IO, 41, EOL, float_out(scale.x));
writeln(IO, 42, EOL, float_out(scale.y));
writeln(IO, 43, EOL, float_out(scale.z));
end;
if rotation <> 0 then
writeln(IO, 50, EOL, float_out(RadToDeg(rotation)));
if num_attribs > 0 then
begin
writeln(IO, 66, EOL, 1);
for lp1 := 0 to num_attribs - 1 do
attribs[lp1].write_to_DXF(IO, layer);
writeln(IO, 0, EOL, 'SEQEND');
end
else
writeln(IO,66,EOL,0);
end;
procedure Insert_.max_min_extents(var emax,emin:Point3D);
begin
inherited;
end;
///////////////////////////////////////////////////////////////////////////////
// Line
///////////////////////////////////////////////////////////////////////////////
constructor Line_.create(p_1,p_2:Point3D; col:integer);
begin
inherited create(WCS_Z,p_1,col);
p2 := p_2;
fcolor := col;
fLineStyle := 'SOLID';
LineTypeScale := 1;// Tolik 09/047/2019 --
end;
procedure Line_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
pa,pb: TPoint;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
pa := map_fn(p1,t_matrix);
pb := map_fn(p2,t_matrix);
acanvas.Moveto(pa.x,pa.y);
acanvas.Lineto(pb.x,pb.y);
end;
procedure Line_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
po : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
po := map_fn(p2,t_matrix);
draw_cross(acanvas,po);
end;
procedure Line_.translate(T:Point3D);
begin
p1 := p1_plus_p2(p1,T);
p2 := p1_plus_p2(p2,T);
end;
procedure Line_.quantize_coords(epsilon:double; mask:byte);
begin
if (mask and 1)=1 then
begin
p1.x := round(p1.x*epsilon)/epsilon;
p2.x := round(p2.x*epsilon)/epsilon;
end;
if (mask and 2)=2 then
begin
p1.y := round(p1.y*epsilon)/epsilon;
p2.y := round(p2.y*epsilon)/epsilon;
end;
if (mask and 4)=4 then
begin
p1.z := round(p1.z*epsilon)/epsilon;
p2.z := round(p2.z*epsilon)/epsilon;
end;
end;
function Line_.count_points : integer;
begin
result := 2;
end;
function Line_.count_lines : integer;
begin
result := 1;
end;
function Line_.details : string;
begin
result := inherited details + EOL + Point3DToStr(p2);
end;
procedure Line_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
write_DXF_Point(IO, 11, p2);
writeln(IO, 6, EOL, fLineStyle);
writeln(IO, 48, EOL, FloatTostr(LineTypeScale));
end;
procedure Line_.max_min_extents(var emax, emin: Point3D);
begin
max_bound(emax, p1);
min_bound(emin, p1);
max_bound(emax, p2);
min_bound(emin, p2);
end;
function Line_.closest_vertex_square_distance_2D(p:Point3D) : double;
begin
result := dmin(sq_dist2D(p1,p),sq_dist2D(p2,p));
end;
function Line_.closest_vertex(p:Point3D) : Point3D;
begin
if sq_dist2D(p1,p)<sq_dist2D(p2,p) then
result := p1
else
result := p2;
end;
function Line_.Move_point(p,newpoint:Point3D) : boolean;
begin
if p1_eq_p2_3D(p1,p) then
begin
p1 := newpoint;
result := true;
end
else
if p1_eq_p2_3D(p2,p) then
begin
p2 := newpoint;
result := true;
end
else
result := false;
end;
///////////////////////////////////////////////////////////////////////////////
// Circle
///////////////////////////////////////////////////////////////////////////////
constructor Circle_.create(OCSaxis,p_1:Point3D; radius_:double; col:integer);
begin
inherited create(OCSaxis,p_1,col);
radius := radius_;
fcolor := col;
fLineStyle := 'SOLID';
end;
constructor Circle_.create_from_polyline(ent1:DXF_Entity);
var
p_1: Point3D;
d: double;
lp1: integer;
begin
p_1 := origin3D;
d := 0;
with Polyline_(ent1) do
begin
for lp1:=0 to numvertices - 1 do
p_1 := p1_plus_p2(polypoints^[lp1],p_1);
p_1.x := p_1.x/numvertices;
p_1.y := p_1.y/numvertices;
p_1.z := p_1.z/numvertices;
for lp1:=0 to numvertices-1 do
d := d + dist3D(polypoints^[lp1],p_1);
d := d/numvertices;
end;
inherited create(ent1.OCS_axis,p_1,ent1.colinx);
radius := d;
end;
procedure Circle_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
pa,pb: TPoint;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
// bug in Ellipse routine causes crash if extents are too small
if (pb.x>pa.x+1) and (pa.y>pb.y+1) then
acanvas.Ellipse(pa.x,pa.y,pb.x,pb.y)
else
acanvas.pixels[pa.x,pa.y] := acanvas.Pen.Color;
end;
function Circle_.details : string;
begin
result := inherited details + EOL + 'Radius = ' + float_out(radius);
end;
procedure Circle_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO,40,EOL,float_out(radius));
writeln(IO, 6, EOL, fLineStyle);
end;
function Circle_.is_point_inside_object2D(p:Point3D) : boolean;
begin
result := dist2D(p,p1)<=radius;
end;
procedure Circle_.max_min_extents(var emax,emin:Point3D);
var
lp1 : integer;
begin
max_bound(emax, p1_plus_p2 (p1, aPoint3D(radius,radius,0)));
min_bound(emin, p1_minus_p2(p1, aPoint3D(radius,radius,0)));
end;
///////////////////////////////////////////////////////////////////////////////
// Arc
///////////////////////////////////////////////////////////////////////////////
constructor Arc_.create(OCSaxis,p_1:Point3D; radius_,sa,ea:double; col:integer);
begin
inherited create(OCSaxis,p_1, radius_, col);
angle1 := DegToRad(sa);
angle2 := DegToRad(ea);
fcolor := col;
fLineStyle := 'SOLID';
end;
procedure Arc_.Draw(acanvas: TCanvas; map_fn:coord_convert; OCS: pM);
var
pu,pv,pw,px : TPoint;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color <> fcolor then
Color := fcolor;
pu := map_fn(aPoint3D(p1.x - radius, p1.y - radius, p1.z - radius), t_matrix);
pv := map_fn(aPoint3D(p1.x + radius, p1.y + radius, p1.z + radius), t_matrix);
pw := map_fn(aPoint3D(p1.x + cos(angle1) * radius, p1.y + sin(angle1) * radius, p1.z + radius), t_matrix);
px := map_fn(aPoint3D(p1.x + cos(angle2) * radius,p1.y + sin(angle2) * radius, p1.z + radius), t_matrix);
if (pv.x > pu.x + 1) and (pu.y > pv.y + 1) then
acanvas.Arc(pu.x, pu.y, pv.x, pv.y, pw.x, pw.y, px.x, px.y)
else
acanvas.pixels[pu.x, pu.y] := acanvas.Pen.Color;
end;
function Arc_.details : string;
begin
result := inherited details + EOL + 'Angle 1 = ' + float_out(angle1) + EOL +
'Angle 2 = ' + float_out(angle2);
end;
procedure Arc_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO, 50, EOL, float_out(RadToDeg(angle1)));
writeln(IO, 51, EOL, float_out(RadToDeg(angle2)));
writeln(IO, 6, EOL, fLineStyle);
end;
function Arc_.is_point_inside_object2D(p:Point3D) : boolean;
begin
result := false;
end;
procedure Arc_.max_min_extents(var emax,emin:Point3D);
var
lp1: integer;
ax,ay,bx,by: double;
thisboundary: integer;
lastboundary: integer;
begin
// the end points of the arc
ax := p1.x + radius * cos(angle1);
ay := p1.y + radius * sin(angle1);
bx := p1.x + radius * cos(angle2);
by := p1.y + radius * sin(angle2);
max_bound(emax, aPoint3D(ax, ay, 0));
min_bound(emin, aPoint3D(ax, ay, 0));
max_bound(emax, aPoint3D(bx, by, 0));
min_bound(emin, aPoint3D(bx, by, 0));
// test
if angle1 < 0 then
begin
while abs(angle1) > 2*Pi do
angle1 := angle1 + 2*Pi;
angle1 := angle1 + 2 * pi;
end;
if angle2 < 0 then
begin
while abs(angle2) > 2*Pi do
angle2 := angle2 + 2*Pi;
angle2 := angle2 + 2 * pi;
end;
//
// long arcs may extend along the axes (quadrants) (eg 1 to 359 ->90,180,270)
lastboundary := 90 * ((trunc(RadToDeg(angle2)) + 89) div 90);
if lastboundary = 360 then
lastboundary := 0;
thisboundary := 90 * ((trunc(RadToDeg(angle1)) + 90) div 90);
if thisboundary = 360 then
thisboundary := 0;
while thisboundary <> lastboundary do
begin
ax := p1.x + radius * cos(DegToRad(thisboundary));
ay := p1.y + radius * sin(DegToRad(thisboundary));
max_bound(emax, aPoint3D(ax, ay, 0));
min_bound(emin, aPoint3D(ax, ay, 0));
thisboundary := thisboundary + 90;
if thisboundary = 360 then
thisboundary := 0;
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline
///////////////////////////////////////////////////////////////////////////////
constructor Polyline_.create(OCSaxis: Point3D; numpoints: integer; points: ppointlist; col: integer; closed_: boolean);
var
lp1 : integer;
begin
inherited create;
init_OCS_WCS_matrix(OCSaxis);
numvertices := numpoints;
if closed_ then
closed := true
else
if p1_eq_p2_3D(points[0], points[numvertices - 1]) then
begin
closed := true;
dec(numvertices);
end
else
closed := false;
polypoints := allocate_points(numvertices);
for lp1:=0 to numvertices - 1 do
polypoints^[lp1] := points^[lp1];
fcolor := col;
fLineStyle := 'SOLID';
end;
destructor Polyline_.destroy;
begin
deallocate_points(polypoints,numvertices);
inherited destroy;
end;
procedure Polyline_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
PointArray: array[0..max_vertices_per_polyline-1] of TPoint;
lp1,tn: integer;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
if not closed then
acanvas.Polyline(Slice(PointArray,numvertices))
else
acanvas.Polygon(Slice(PointArray,numvertices));
end;
procedure Polyline_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
po: TPoint;
lp1: integer;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numvertices-1 do
begin
po := map_fn(polypoints^[lp1],t_matrix);
draw_cross(acanvas,po);
end;
end;
procedure Polyline_.translate(T:Point3D);
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
polypoints^[lp1] := p1_plus_p2(polypoints^[lp1],T);
end;
procedure Polyline_.quantize_coords(epsilon:double; mask:byte);
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
begin
if (mask and 1)=1 then
polypoints^[lp1].x := round(polypoints^[lp1].x*epsilon)/epsilon;
if (mask and 2)=2 then
polypoints^[lp1].y := round(polypoints^[lp1].y*epsilon)/epsilon;
if (mask and 4)=4 then
polypoints^[lp1].z := round(polypoints^[lp1].z*epsilon)/epsilon;
end;
end;
function Polyline_.count_points : integer;
begin
result := numvertices;
end;
function Polyline_.count_lines : integer;
begin
result := numvertices;
end;
function Polyline_.count_polys_open : integer;
begin
if not closed then
result := 1
else
result := 0;
end;
function Polyline_.count_polys_closed : integer;
begin
if closed then
result := 1
else
result := 0;
end;
function Polyline_.details : string;
var
lp1 : integer;
t : string;
begin
if OCS_WCS <> nil then
t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else
t := 'WCS';
result := classname + EOL + t;
if closed then
result := result + EOL + 'Closed'
else
result := result + EOL + 'Open';
for lp1:=0 to numvertices-1 do
result := result + EOL + Point3DToStr(polypoints^[lp1]);
end;
procedure Polyline_.write_to_DXF(var IO:textfile; layer:string);
var
lp1 : integer;
begin
inherited;
if closed then
writeln(IO, 70, EOL, 1 + 8) // 1+8 = closed+3D
else
writeln(IO, 70, EOL, 8);
writeln(IO, 66, EOL, 1);
writeln(IO, 6, EOL, fLineStyle);
for lp1 := 0 to numvertices - 1 do
begin
writeln(IO, 0, EOL, 'VERTEX');
writeln(IO, 8, EOL, layer);
writeln(IO, 70, EOL, 32); // 3D polyline mesh vertex
write_DXF_Point(IO, 10, polypoints^[lp1]);
end;
writeln(IO, 0, EOL, 'SEQEND');
end;
procedure Polyline_.max_min_extents(var emax,emin:Point3D);
var
lp1 : integer;
begin
for lp1:=0 to numvertices - 1 do
begin
max_bound(emax,polypoints^[lp1]); min_bound(emin,polypoints^[lp1]);
end;
end;
function Polyline_.closest_vertex_square_distance_2D(p:Point3D) : double;
var
lp1 : integer;
begin
result := 1E10;
for lp1:=0 to numvertices-1 do
result := dmin(result,sq_dist2D(polypoints^[lp1],p));
end;
function Polyline_.closest_vertex(p:Point3D) : Point3D;
var
lp1,c : integer;
d1,d2 : double;
begin
d1 := 1E10;
for lp1:=0 to numvertices-1 do
begin
d2 := sq_dist2D(polypoints^[lp1],p);
if d2<d1 then
begin
result := polypoints^[lp1];
d1 := d2;
end;
end;
end;
function Polyline_.Move_point(p,newpoint:Point3D) : boolean;
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
begin
if p1_eq_p2_3D(polypoints^[lp1],p) then
begin
polypoints^[lp1] := newpoint;
result := true;
exit;
end;
end;
result := false;
end;
function Polyline_.triangle_centre : Point3D;
var
s,t : integer;
begin
if numvertices<>3 then
raise Exception.Create('Shouldn''t call this for non triangular facets');
s := 1;
t := 2;
result := p1_plus_p2(polypoints^[0],p1_plus_p2(polypoints^[s],polypoints^[t]));
result := p1_x_n(result,1/3);
end;
procedure Polyline_.set_attrib(i:integer; v:double);
begin
if (i+1)>numattrs then
numattrs:=(i+1);
attribs[i] := v;
end;
function Polyline_.get_attrib(i:integer) : double;
begin
if i>=numattrs then
result := 0
else
result := attribs[i];
end;
procedure Polyline_.copy_attribs(p:Polyline_);
var
lp1 : integer;
begin
p.numattrs := numattrs;
for lp1:=0 to numattrs-1 do
p.attribs[lp1] := attribs[lp1];
end;
function Polyline_.is_point_inside_object2D(p:Point3D) : boolean;
var
i,j: integer;
p1_i,p1_j: Point3D;
begin
result := false;
if not closed then
exit;
j := numvertices-1;
for i:=0 to numvertices-1 do with p do
begin
p1_i := polypoints^[i];
p1_j := polypoints^[j];
if ((((p1_i.y<=y) and (y<p1_j.y)) or ((p1_j.y<=y) and (y<p1_i.y))) and
(x<(p1_j.x - p1_i.x)*(y-p1_i.y) / (p1_j.y - p1_i.y) + p1_i.x)) then
result:= not result;
j:=i;
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Face3D
///////////////////////////////////////////////////////////////////////////////
constructor Face3D_.create(numpoints:integer; points:ppointlist; col:integer; closed_:boolean);
begin
inherited create(WCS_Z,numpoints,points,col,closed_);
fcolor := col;
end;
function Face3D_.proper_name : string;
begin
result := '3DFACE';
end;
procedure Face3D_.write_to_DXF(var IO:textfile; layer:string);
var
lp1 : integer;
begin
writeln(IO,0 ,EOL,proper_name);
writeln(IO,8 ,EOL,layer);
writeln(IO,62,EOL,colinx);
for lp1:=0 to numvertices-1 do
write_DXF_Point(IO, 10 + lp1, polypoints^[lp1]);
if numvertices=3 then
begin // 4th point is same as third
lp1 := 3;
write_DXF_Point(IO, 10 + lp1, polypoints^[lp1-1]);
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Solid_
///////////////////////////////////////////////////////////////////////////////
constructor Solid_.create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
begin
inherited create(numpoints,points,col,true);
thickness := t;
init_OCS_WCS_matrix(OCSaxis);
fcolor := col;
end;
function Solid_.proper_name : string;
begin
result := 'SOLID';
end;
procedure Solid_.write_to_DXF(var IO:textfile; layer:string);
begin
inherited;
writeln(IO, 39, EOL, float_out(thickness));
end;
function Solid_.details : string;
begin
result := inherited details + EOL +
'Thickness'#9 + float_out(thickness);
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polygon_mesh_.create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
begin
inherited create(WCS_Z,numpoints,points,col,false);
M := Mc; N := Nc;
closeM := (closebits and 1 )=1;
closeN := (closebits and 32)=32;
fcolor := col;
end;
function Polygon_mesh_.proper_name : string;
begin
result := 'POLYLINE';
end;
procedure Polygon_mesh_.write_to_DXF(var IO:textfile; layer:string);
var
lp1,flag : integer;
begin
writeln(IO, 0, EOL,proper_name);
writeln(IO, 8, EOL,layer);
writeln(IO, 62, EOL, colinx);
writeln(IO, 66, EOL, 1);
flag := 16;
if closeM then
flag := flag+1;
if closeN then
flag := flag+32;
writeln(IO,70 ,EOL,flag);
writeln(IO,71 ,EOL,M);
writeln(IO,72 ,EOL,N);
for lp1:=0 to numvertices-1 do
begin
writeln(IO,0 ,EOL,'VERTEX');
writeln(IO,70 ,EOL,64); // polygon mesh vertex
write_DXF_Point(IO, 10, polypoints^[lp1]);
end;
writeln(IO,0 ,EOL,'SEQEND');
end;
function Polygon_mesh_.details : string;
var
t : string;
begin
if OCS_WCS<>nil then
t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else
t := 'WCS';
result := 'Polyline_ (polygon mesh)' + EOL + t + EOL +
'Vertices'#9 + IntToStr(numvertices) + EOL +
'M'#9 + IntToStr(M) + EOL +
'N'#9 + IntToStr(N) + EOL +
'Closed M'#9 + BoolToStr(closeM) + EOL +
'Closed N'#9 + BoolToStr(closeN);
end;
type
ptarray = array[0..max_vertices_per_polyline-1] of TPoint;
pptarray = ^ptarray;
procedure Polygon_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
PointArray : array[0..max_vertices_per_polyline-1] of TPoint;
tp : TPoint;
lp1,lp2,inx : integer;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
// draw the M N-length polylines - we can use the array directly
if closeN then
for lp1:=0 to M-1 do
acanvas.Polygon( Slice(pptarray(@PointArray[N*lp1])^,N))
else
for lp1:=0 to M-1 do
acanvas.Polyline(Slice(pptarray(@PointArray[N*lp1])^,N));
// draw the N M-length polylines - we need to hop along the array in M steps
for lp1:=0 to N-1 do
begin
acanvas.MoveTo(PointArray[lp1].x,PointArray[lp1].y);
for lp2:=1 to M-1 do
begin
tp := PointArray[lp2*N+lp1];
acanvas.LineTo(tp.x,tp.y);
end;
if closeM then
acanvas.LineTo(PointArray[lp1].x,PointArray[lp1].y);
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polyface_mesh_.create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
var
lp1 : integer;
begin
DXF_Entity.create; // don't call polyline_constructor
numvertices := numpoints;
numfaces := nfaces;
polypoints := allocate_points(numvertices);
for lp1:=0 to numvertices-1 do
polypoints^[lp1] := points^[lp1];
Getmem(facelist,numfaces*SizeOf(polyface));
for lp1:=0 to numfaces-1 do
facelist^[lp1] := faces^[lp1];
fcolor := col;
end;
destructor Polyface_mesh_.destroy;
begin
Freemem(facelist,numfaces*SizeOf(polyface));
inherited destroy;
end;
function Polyface_mesh_.proper_name : string;
begin
result := 'POLYLINE';
end;
procedure Polyface_mesh_.write_to_DXF(var IO:textfile; layer:string);
var
lp1,lp2,inx : integer;
begin
writeln(IO,0 ,EOL,proper_name);
writeln(IO,8 ,EOL,layer);
writeln(IO,62,EOL,colinx);
writeln(IO,66,EOL,1);
writeln(IO,70,EOL,64);
writeln(IO,71,EOL,numvertices);
writeln(IO,72,EOL,numfaces);
for lp1:=0 to numvertices-1 do
begin
writeln(IO,0 ,EOL,'VERTEX');
writeln(IO,70 ,EOL,64+128); // polyface mesh coordinate vertex
write_DXF_Point(IO, 10, polypoints^[lp1]);
end;
for lp1:=0 to numfaces-1 do
begin
writeln(IO,0 ,EOL,'VERTEX');
writeln(IO,70 ,EOL,128); // polyface mesh face vertex
for lp2:=0 to 3 do writeln(IO,71+lp2 ,EOL,facelist^[lp1].nf[lp2]+1);
end;
writeln(IO,0 ,EOL,'SEQEND');
end;
function Polyface_mesh_.details : string;
var
t : string;
begin
if OCS_WCS<>nil then
t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else
t := 'WCS';
result := 'Polyline_ (polyface mesh)' + EOL + t + EOL +
'Vertices'#9 + IntToStr(numvertices) + EOL +
'Faces'#9 + IntToStr(numfaces);
end;
procedure Polyface_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
PointArray : array[0..3] of TPoint;
lp1,lp2,inx : integer;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numfaces-1 do
begin
for lp2:=0 to 3 do
begin
inx := facelist^[lp1].nf[lp2];
if inx<0 then
break; // index -> -1 = end of vertices
PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
end;
acanvas.Polygon(Slice(PointArray,lp2));
end;
end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Entity_List.create(l_name:string);
begin
list_name := l_name;
entities := TList.Create;
inc(Ent_lists_in_existence);
end;
destructor Entity_List.destroy;
var
lp1 : integer;
// Tolik
ent: DXF_Entity;
//
begin
for lp1:=0 to (entities.Count-1) do
begin
// DXF_Entity(entities[lp1]).Free;
ent := DXF_Entity(entities[lp1]);
try
ent.free;
except
on E: Exception do AddExceptionToLogEx('U_DXFEngineSCS.Entity_List.Destroy', E.Message);
end;
end;
entities.Free;
dec(Ent_lists_in_existence);
inherited destroy;
end;
function Entity_List.add_entity_to_list(entity:DXF_Entity) : boolean;
begin
if sorted then
result := insert(entity)
else
result := add_at_end(entity);
end;
function Entity_List.remove_entity(ent:DXF_Entity) : boolean;
var
lp1 : integer;
begin
result := false;
for lp1:=0 to (entities.Count-1) do
begin
if entities[lp1]=ent then
begin
entities.remove(ent);
ent.free;
result := true;
exit;
end;
end;
end;
function Entity_List.add_at_end(entity:DXF_Entity) : boolean;
begin
entities.Add(entity);
end;
function Entity_List.insert(entity:DXF_Entity) : boolean;
begin
entities.Add(entity);
end;
procedure Entity_List.draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
lp1 : integer;
begin
for lp1:=0 to (entities.Count-1) do
begin
DXF_Entity(entities[lp1]).Draw(acanvas, map_fn,OCS);
end;
end;
procedure Entity_List.draw_vertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var
lp1 : integer;
begin
for lp1:=0 to (entities.Count-1) do
DXF_Entity(entities[lp1]).DrawVertices(acanvas, map_fn,OCS);
end;
function Entity_List.num_entities : integer;
begin
result := entities.Count;
end;
function Entity_List.count_points : integer;
var
lp1 : integer;
begin
result := 0;
for lp1:=0 to (entities.Count-1) do
result := result + DXF_Entity(entities[lp1]).count_points;
end;
function Entity_List.count_lines : integer;
var
lp1 : integer;
begin
result := 0;
for lp1:=0 to (entities.Count-1) do
result := result + DXF_Entity(entities[lp1]).count_lines;
end;
function Entity_List.count_polys_open : integer;
var
lp1 : integer;
begin
result := 0;
for lp1:=0 to (entities.Count-1) do
result := result + DXF_Entity(entities[lp1]).count_polys_open;
end;
function Entity_List.count_polys_closed : integer;
var
lp1 : integer;
begin
result := 0;
for lp1:=0 to (entities.Count-1) do
result := result + DXF_Entity(entities[lp1]).count_polys_closed;
end;
procedure Entity_List.max_min_extents(var emax,emin:Point3D);
var
lp1 : integer;
begin
for lp1 := 0 to (entities.Count - 1) do
DXF_Entity(entities[lp1]).max_min_extents(emax, emin);
end;
procedure Entity_List.setcolour(col:integer);
var
lp1 : integer;
begin
for lp1:=0 to (entities.Count-1) do
DXF_Entity(entities[lp1]).fcolor := col;
end;
function Entity_List.closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
var
lp1 : integer;
cl_ : DXF_Entity;
t : double;
begin
result := 1E10;
for lp1:=0 to (entities.Count-1) do
begin
cl_ := DXF_Entity(entities[lp1]);
t := cl_.closest_vertex_square_distance_2D(p);
if t<result then
begin
cl := cl_;
result := t;
end;
end;
end;
function Entity_List.find_bounding_object(p:Point3D) : DXF_Entity;
var
lp1 : integer;
ent : DXF_Entity;
begin
result := nil;
for lp1:=0 to (entities.Count-1) do
begin
ent := DXF_Entity(entities[lp1]);
if ent.is_point_inside_object2D(p) then
begin
result := ent;
exit;
end;
end;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_layer class implementation
///////////////////////////////////////////////////////////////////////////////
constructor DXF_Layer.create(l_name:string);
begin
SCS_Layer_Handle := 0;
layer_name := l_name;
entity_names := TStringList.Create;
entity_lists := TList.Create;
inc(layers_in_existence);
end;
// Tolik -- 10/02/2017 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
destructor DXF_Layer.destroy;
var
lp1 : integer;
el : Entity_List;
begin
for lp1 := entity_lists.Count -1 downto 0 do
begin
el := Entity_List(entity_lists[lp1]);
el.Free;
end;
entity_names.Free;
entity_lists.Free;
dec(layers_in_existence);
inherited destroy;
end;
{
destructor DXF_Layer.destroy;
var
lp1 : integer;
el : Entity_List;
begin
if num_lists>0 then
begin
for lp1:=num_lists-1 downto 0 do
begin
el := Entity_List(entity_lists[lp1]);
el.Free;
end;
end;
entity_names.Free;
entity_lists.Free;
dec(layers_in_existence);
inherited destroy;
end;
}
procedure DXF_Layer.delete(aname:string; releasemem:boolean);
var
lp1 : integer;
el : Entity_List;
begin
for lp1:=num_lists-1 downto 0 do
begin
el := Entity_List(entity_lists[lp1]);
if el.name=aname then
begin
entity_lists.remove(el);
if releasemem then
el.Free;
entity_names.delete(lp1);
end;
end;
end;
function DXF_Layer.add_entity_to_layer(entity:DXF_Entity) : boolean;
var
i: integer;
el: Entity_List;
begin
i := entity_names.IndexOf(entity.ClassName);
if i= - 1 then
begin
el := Entity_List.create(entity.ClassName);
el.parent_layer := self;
i := entity_lists.Add(el);
if i <> entity_names.Add(entity.ClassName) then
raise Exception.Create('Entity list ID mismatch');
// This has never been raised yet, but might as well be sure.
end;
Entity_List(entity_lists[i]).add_entity_to_list(entity);
if ((entity.fcolor = 0) or (entity.fcolor = BYLAYER)) then
entity.setcolour_index(layer_colinx);
result := true;
end;
procedure DXF_Layer.add_entity_list(elist:Entity_List);
var
i : integer;
begin
i := entity_names.IndexOf(elist.name);
if i<>-1 then
raise Exception.create('Attempted to add two lists with same name');
elist.parent_layer := self;
i := entity_lists.Add(elist);
if i<>entity_names.Add(elist.Name) then
raise Exception.Create('Entity list ID mismatch');
end;
function DXF_Layer.num_lists : integer;
begin
result := entity_names.Count;
end;
procedure DXF_Layer.max_min_extents(var emax, emin: Point3D);
var
lp1 : integer;
begin
for lp1 := 0 to num_lists - 1 do
Entity_List(entity_lists[lp1]).max_min_extents(emax, emin);
end;
function DXF_Layer.create_or_find_list_type(aname:string) : Entity_List;
var
inx : integer;
begin
inx := entity_names.IndexOf(aname);
if inx=-1 then
begin
result := Entity_List.create(aname);
result.parent_layer := self;
inx := entity_lists.Add(result);
if inx<>entity_names.Add(aname) then
raise Exception.Create('Entity list ID mismatch');
end
else
result := Entity_List(entity_lists[inx]);
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_Object class implementation
///////////////////////////////////////////////////////////////////////////////
constructor DXF_ObjectSCS.create(aname:string);
begin
layer_lists := TList.create;
if aname<>'' then
DXF_name := aname
else
DXF_name := 'Untitled';
emax := origin3D;
emin := origin3D;
inc(DXF_Obj_in_existence);
end;
constructor DXF_ObjectSCS.create_from_file(aname:string; skipped:Tstrings);
var
reader : DXF_Reader;
begin
try
Reader := DXF_Reader.Create(aname);
Reader.set_skipped_list(skipped);
With Reader do
if (read_file) then
begin
name := ExtractFileName(aname);
emax := get_max_extent;
emin := get_min_extent;
layer_lists := release_control_of_layers;
end
else
begin
layer_lists := TList.create;
DXF_name := aname;
emax := origin3D;
emin := origin3D;
end;
Reader.Free;
inc(DXF_Obj_in_existence);
except
on E: Exception do AddExceptionToLogEx('DXF_ObjectSCS.create_from_file', E.Message);
end;
end;
// Tolik -- 10/02/2017 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
destructor DXF_ObjectSCS.destroy;
var
i : integer;
EntList: TList;
procedure AddEntitiesToDelList(aLayer: DXF_Layer);
var i: Integer;
Entity: DXF_Entity;
procedure AddEntityToList(aEnt: DXF_Entity);
var i: Integer;
Ent: DXF_Entity;
begin
if aEnt.ClassName = Block_.ClassName then
begin
for i := 0 to Block_(aEnt).entities.Count - 1 do
begin
AddEntityToList(DXF_Entity(Block_(aEnt).entities[i]));
end;
Block_(aEnt).entities.Clear;
{if EntList.IndexOf(aEnt) = -1 then
EntList.Add(aEnt);}
end
else
if aEnt.ClassName = Entity_List.ClassName then
begin
for i := 0 to Entity_List(aEnt).entities.Count - 1 do
begin
AddEntityToList(DXF_Entity(Entity_List(aEnt).entities[i]));
end;
Entity_List(aEnt).entities.Clear;
{if EntList.IndexOf(aEnt) = -1 then
EntList.Add(aEnt);}
end;
// else
if EntList.IndexOf(aEnt) = -1 then
EntList.Add(aEnt);
end;
begin
for i := 0 to aLayer.entity_lists.Count - 1 do
begin
Entity := DXF_Entity(aLayer.entity_lists[i]);
AddEntityToList(Entity);
end;
end;
begin
EntList := TList.Create;
for i := 0 to layer_lists.Count - 1 do
begin
AddEntitiesToDelList(DXF_Layer(layer_lists.Items[i]));
DXF_Layer(layer_lists.Items[i]).entity_lists.Clear;
DXF_Layer(layer_lists.Items[i]).entity_lists.Clear;
DXF_Layer(layer_lists.Items[i]).Free;
end;
for i := 0 to EntList.Count - 1 do
DXF_Entity(EntList[i]).destroy;
EntList.Clear;
layer_lists.Free;
dec(DXF_Obj_in_existence);
inherited destroy;
end;
{
destructor DXF_ObjectSCS.destroy;
var
lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
DXF_Layer(layer_lists.Items[lp1]).Free;
layer_lists.Free;
dec(DXF_Obj_in_existence);
inherited destroy;
end;
}
//
procedure DXF_ObjectSCS.save_to_file(aname:string);
var
Writer : DXF_Writer;
begin
writer := DXF_writer.create(aname,layer_lists);
writer.write_file;
writer.free;
end;
function DXF_ObjectSCS.num_layers : integer;
begin
result := layer_lists.Count
end;
function DXF_ObjectSCS.new_layer(aname:string; DUPs_OK:boolean) : DXF_Layer;
var
lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
begin
if DXF_Layer(layer_lists[lp1]).name = aname then
begin
if not DUPs_OK then
raise DXF_Exception.Create('Attempted to create layer with existing name');
result := DXF_Layer(layer_lists[lp1]);
exit;
end;
end;
result := DXF_Layer.Create(aname);
layer_lists.Add(result);
end;
function DXF_ObjectSCS.add_layer(layer:DXF_Layer) : boolean;
var
lp1 : integer;
LayExist: Boolean;
// Tolik -- 16/02/2017 -- <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>...
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DXF - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Procedure CheckRenameLayer;
var i: Integer;
LayerNameExists: Boolean;
begin
LayerNameExists := false;
for i := 0 to layer_lists.Count - 1 do
begin
if DXF_Layer(layer_lists[i]).name = layer.name then
begin
LayerNameExists := True;
layer.name := layer.name + '1';
end;
if LayerNameExists then
CheckRenameLayer;
end;
end;
//
begin
LayExist := False;
// Tolik -- 16/02/2017 --
CheckRenameLayer;
(*
for lp1:=0 to layer_lists.Count - 1 do
if DXF_Layer(layer_lists[lp1]).name = layer.name then
LayExist := True;
// raise DXF_Exception.Create('Attempted to add layer with existing name');
if not LayExist then
*)
//
layer_lists.Add(layer);
end;
function DXF_ObjectSCS.layer(aname:string) : DXF_Layer;
var
lp1 : integer;
begin
result := nil;
for lp1:=0 to layer_lists.Count-1 do
if DXF_Layer(layer_lists[lp1]).name=aname then
begin
result := DXF_Layer(layer_lists[lp1]);
exit;
end;
end;
// Avoid using this if possible because we have to search for layer name every time
function DXF_ObjectSCS.add_entity_to_layer(entity:DXF_Entity; aname:string) : boolean;
var
lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
if DXF_Layer(layer_lists[lp1]).name=aname then
begin
DXF_Layer(layer_lists[lp1]).add_entity_to_layer(entity);
result := true;
exit;
end;
raise DXF_Exception.Create('Attempted to add to unnamed layer');
end;
function DXF_ObjectSCS.create_or_find_layer(aname:string) : DXF_Layer;
var
lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
if DXF_Layer(layer_lists[lp1]).name=aname then
begin
result := DXF_Layer(layer_lists[lp1]);
exit;
end;
result := new_layer(aname, true);
end;
function DXF_ObjectSCS.merge_files(DXF_:DXF_ObjectSCS) : boolean;
var
lp1,lp2,lp3,lp4 : integer;
layer1,layer2 : DXF_Layer;
elist1,elist2,blist : Entity_List;
ent : DXF_Entity;
begin
// rather annoyingly we have to keep track of insert/block lookups
layer2 := create_or_find_layer('0');
blist := layer2.create_or_find_list_type('Block_');
//
for lp1:=0 to DXF_.layer_lists.Count-1 do
begin
layer1 := DXF_.layer_lists[lp1];
layer2 := create_or_find_layer(layer1.name);
for lp2:=0 to layer1.entity_lists.count-1 do
begin
elist1 := layer1.entity_lists[lp2];
elist2 := layer2.create_or_find_list_type(elist1.name);
for lp3:=elist1.entities.count-1 downto 0 do
begin
ent := elist1.entities[lp3];
elist2.Add_entity_to_list(ent);
elist1.entities.remove(ent);
if ent is Insert_ then
ent.update_block_links(blist);
end;
end;
end;
end;
procedure DXF_ObjectSCS.remove_empty_layers_and_lists;
var
lp1,lp2 : integer;
layer: DXF_Layer;
el: Entity_List;
begin
for lp1:=layer_lists.Count-1 downto 0 do
begin
layer := DXF_Layer(layer_lists[lp1]);
for lp2:=layer.num_lists-1 downto 0 do
begin
el := Entity_List(layer.entity_lists[lp2]);
if el.num_entities=0 then
begin
layer.entity_lists.remove(el);
layer.entity_names.delete(lp2);
el.Free;
if layer.entity_lists.count<>layer.entity_names.count then
showmessage('Internal error : Layer lists and names mismatch');
end;
end;
if layer.num_lists=0 then
begin
layer_lists.remove(layer);
layer.Free;
end;
end;
end;
procedure DXF_ObjectSCS.copy_to_strings(ts:TStrings);
var
lp1,lp2,pos : integer;
layer : DXF_Layer;
begin
ts.Add(DXF_name);
for lp1:=0 to layer_lists.count-1 do
begin
layer := layer_lists[lp1];
pos := ts.Add(' '+layer.name);
ts.Objects[pos] := layer;
for lp2:=0 to layer.num_lists-1 do
begin
pos := ts.Add(' '+Entity_List(layer.entity_lists[lp2]).name);
ts.Objects[pos] := layer.entity_lists[lp2];
end;
end;
end;
function DXF_ObjectSCS.get_min_extent : Point3D;
begin
result := emin;
end;
function DXF_ObjectSCS.get_max_extent : Point3D;
begin
result := emax;
end;
procedure DXF_ObjectSCS.max_min_extents(var emax,emin:Point3D);
var
lp1 : integer;
begin
for lp1:=0 to layer_lists.Count-1 do
DXF_Layer(layer_lists[lp1]).max_min_extents(emax,emin);
end;
///////////////////////////////////////////////////////////////////////////////
// Selection_lists class implementation
///////////////////////////////////////////////////////////////////////////////
constructor selection_lists.create;
begin
entity_lists := TList.Create;;
end;
destructor selection_lists.destroy;
begin
entity_lists.Free;
inherited destroy;
end;
procedure selection_lists.save_to_DXF_file(aname:string);
var
lp1,lp2 : integer;
DXF : DXF_ObjectSCS;
layer: DXF_layer;
el : Entity_List;
begin
DXF := DXF_ObjectSCS.create('');
for lp1:=0 to entity_lists.count-1 do
begin
el := Entity_List(entity_lists[lp1]);
el.Kludge_layer := el.parent_layer; // we need to keep track of where they came from
layer := DXF.new_layer(el.parent_layer.name,true);
layer.add_entity_list(el);
end;
DXF.save_to_file(aname);
// now get the lists back from the temporary DXF object (without it deleting them)
for lp1:=DXF.layer_lists.count-1 downto 0 do
begin
layer := DXF_Layer(DXF.layer_lists[lp1]);
for lp2:=layer.entity_lists.count-1 downto 0 do
layer.delete(Entity_List(layer.entity_lists[lp2]).name,FALSE);
end;
DXF.Free;
// reset the parent layer of the entity_lists
for lp1:=0 to entity_lists.count-1 do
begin
el := Entity_List(entity_lists[lp1]);
el.parent_layer := el.Kludge_layer; // we stored them temporarily
end;
end;
function selection_lists.find_closest_2D_point(p:Point3D; var ent:DXF_Entity) : Point3D;
var
lp1: integer;
dist,mind : double;
entx : DXF_Entity;
begin
mind := 1E10;
for lp1:=0 to entity_lists.count-1 do
begin
dist := Entity_List(entity_lists[lp1]).closest_vertex_square_distance_2D(p,entx);
if dist<mind then
begin
result := entx.closest_vertex(p);
ent := entx;
mind := dist;
end;
end;
end;
function selection_lists.is_inside_object(p:Point3D; var ent:DXF_Entity) : Point3D;
var
lp1: integer;
entx: DXF_Entity;
begin
result := origin3D;
for lp1:=0 to entity_lists.count-1 do
begin
entx := Entity_List(entity_lists[lp1]).find_bounding_object(p);
if entx<>nil then
begin
result := entx.closest_vertex(p);
ent := entx;
exit;
end;
end;
end;
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// Generating PowerCAD source
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
function DXF_ObjectSCS.GetPCPoint(P:Point3D; OCS:pMatrix): TDoublePoint;
var
tc : Point3D;
begin
try
if OCS=nil then
begin
result.x := P.x - pcww;
result.y := P.y - pcwh;
end
else
begin
tc := TransformPoint(OCS^,P);
result.x := tc.x - pcww;
result.y := tc.y - pcwh;
end;
if CadHeight > 0 then
result.y := CadHeight - result.y;
if CadWidth > 0 then
result.x := CadWidth - result.x;
except
end;
end;
function DXF_Entity.ExportToPowerCad(Cad: TPCDrawing;
map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
begin
end;
procedure Entity_List.ExportToPowerCad(Cad: TPCDrawing;
map_fn: PC_convert;LayerNum:integer);
var
lp1 : integer;
begin
if name = 'Block_' then
exit;
for lp1 := 0 to (entities.Count - 1) do
DXF_Entity(entities[lp1]).exportToPowerCAD(cad, map_fn, layerNum, nil);
end;
procedure DXF_Layer.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer);
var
lp2: integer;
data_list : Entity_List;
begin
for lp2 := 0 to num_lists - 1 do
begin
data_list := entity_lists[lp2];
data_list.ExportToPowerCad(cad, map_fn, LayerNum);
end;
end;
procedure DXF_ObjectSCS.ExportToPowerCad(Cad: TPCDrawing; Layered, incVertex: Boolean);
var
Layer:DXF_Layer;
DXFLayer : Integer;
i: integer;
emax,emin : Point3d;
Test: point3d;
NewLayer: TLayer;
LName: string;
BegLNbr, LNbr: Integer;
begin
try
emax := get_max_extent;
emin := get_min_extent;
PCWh := ((emax.y-emin.y) / 2) - (Cad.WorkHeight / 2);
PCWw := ((emax.x-emin.x) / 2) - (Cad.WorkWidth / 2);
PCVertexOk := incVertex;
CadHeight := 0;
CadWidth := 0;
if ord(Cad.VerticalZero) = 1 then
CadHeight := Cad.WorkHeight;
if ord(Cad.HorizontalZero) = 1 then
CadWidth := Cad.WorkWidth;
LName := cDXFEngineSCS_Msg1; // '<27><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
BegLNbr := -1;
for i := 0 to layer_lists.count - 1 do
begin
layer := layer_lists[i];
if Layer.layer_name <> '' then
NewLayer := TLayer.create(Layer.layer_name)
else
NewLayer := TLayer.create(LName);
NewLayer.IsDxf := True;
Cad.Layers.Add(NewLayer);
LNbr := Cad.Layers.Count - 1;
if i = 0 then
BegLNbr := LNbr;
layer.ExportToPowerCad(Cad, GetPCPoint, lNbr);
end;
except
on E: Exception do AddExceptionToLogEx('DXF_ObjectSCS.ExportToPowerCad', E.Message);
end;
end;
(*
procedure Point_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
po := map_fn(p1,t_matrix);
draw_cross(acanvas,po);
end;
procedure Line_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pa,pb : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
pa := map_fn(p1,t_matrix);
pb := map_fn(p2,t_matrix);
acanvas.Moveto(pa.x,pa.y);
acanvas.Lineto(pb.x,pb.y);
end;
procedure Text_.calcText(acanvas:TCanvas; map_fn:coord_convert; OCS:pM; t:string);
var pa,dummy1,dummy2 : TPoint;
Fheight : integer;
begin
with acanvas.Pen do if Color<>colour then Color:=colour;
// kludgy method for scaling text heights
dummy1 := map_fn(origin3D,nil);
dummy2 := map_fn(aPoint3D(0,h,0),nil);
Fheight := 2+(dummy1.y-dummy2.y);
if FHeight=2 then exit;
with acanvas.Font do begin
if Height<>Fheight then Height := Fheight;
if color<>colour then color := colour;
end;
case hor_align of
0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
end;
pa := map_fn(align_pt,OCS_WCS);
acanvas.TextOut(pa.x,pa.y,t);
end;
procedure Text_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
calcText(acanvas,map_fn,t_matrix,textstr);
end;
procedure Circle_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pa,pb : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
// bug in Ellipse routine causes crash if extents are too small
if (pb.x>pa.x+1) and (pa.y>pb.y+1) then
acanvas.Ellipse(pa.x,pa.y,pb.x,pb.y)
else acanvas.pixels[pa.x,pa.y] := acanvas.Pen.Color;
end;
procedure Arc_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var pu,pv,pw,px : TPoint;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
pu := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
pv := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
pw := map_fn(aPoint3D(p1.x+cos(angle1)*radius,p1.y+sin(angle1)*radius,p1.z+radius),t_matrix);
px := map_fn(aPoint3D(p1.x+cos(angle2)*radius,p1.y+sin(angle2)*radius,p1.z+radius),t_matrix);
if (pv.x>pu.x+1) and (pu.y>pv.y+1) then
acanvas.Arc(pu.x,pu.y,pv.x,pv.y,pw.x,pw.y,px.x,px.y)
else
acanvas.pixels[pu.x,pu.y] := acanvas.Pen.Color;
end;
procedure Polyline_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray : array[0..max_vertices_per_polyline-1] of TPoint;
lp1,tn : integer;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
if not closed then acanvas.Polyline(Slice(PointArray,numvertices))
else acanvas.Polygon(Slice(PointArray,numvertices));
end;
procedure Polygon_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray : array[0..max_vertices_per_polyline-1] of TPoint;
tp : TPoint;
lp1,lp2,inx : integer;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
// draw the M N-length polylines - we can use the array directly
if closeN then for lp1:=0 to M-1 do acanvas.Polygon( Slice(pptarray(@PointArray[N*lp1])^,N))
else for lp1:=0 to M-1 do acanvas.Polyline(Slice(pptarray(@PointArray[N*lp1])^,N));
// draw the N M-length polylines - we need to hop along the array in M steps
for lp1:=0 to N-1 do begin
acanvas.MoveTo(PointArray[lp1].x,PointArray[lp1].y);
for lp2:=1 to M-1 do begin
tp := PointArray[lp2*N+lp1];
acanvas.LineTo(tp.x,tp.y);
end;
if closeM then acanvas.LineTo(PointArray[lp1].x,PointArray[lp1].y);
end;
end;
procedure Polyface_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray : array[0..3] of TPoint;
lp1,lp2,inx : integer;
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do if Color<>colour then Color:=colour;
for lp1:=0 to numfaces-1 do begin
for lp2:=0 to 3 do begin
inx := facelist^[lp1].nf[lp2];
if inx<0 then break; // index -> -1 = end of vertices
PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
end;
acanvas.Polygon(Slice(PointArray,lp2));
end;
end;
*)
function Point_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
po: TDoublePoint;
t_matrix : pMatrix;
begin
Result := nil;
//inherited;
t_matrix := update_transformations(OCS_WCS,OCS);
po := map_fn(p1,t_matrix);
if PCVertexOk then
Result := TFigure(Cad.Vertex(LayerNum,po.x,po.y,False));
end;
function Line_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
po1,po2: TDoublePoint;
t_matrix : pMatrix;
begin
Result := nil;
//inherited;
t_matrix := update_transformations(OCS_WCS,OCS);
po1 := map_fn(p1,t_matrix);
po2 := map_fn(p2,t_matrix);
fcolor := DxfColorToColor(fcolor);
Result := Tfigure(Cad.Line(LayerNum, po1.x, po1.y, po2.x, po2.y, 1, 0, fcolor, 0, False));
end;
function Text_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
pa : TDoublePoint;
Fheight: Double;
t_matrix : pMatrix;
ratio: double;
begin
Result := nil;
t_matrix := update_transformations(OCS_WCS,OCS);
Fheight := h;
ratio := 0;
//case hor_align of
// 0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
// 1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
// 2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
//end;
pa := map_fn(align_pt, {t_matrix}OCS_WCS);
fcolor := DxfColorToColor(fcolor);
Result := TFigure(cad.TextOut(layernum, pa.x, pa.y, 0, fHeight, ratio, textstr, GCadForm.FFontName, RUSSIAN_CHARSET, fcolor, False));
end;
function Attrib_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
pa : TDoublePoint;
Fheight : Double;
t_matrix : pMatrix;
ratio: double;
begin
Result := nil;
t_matrix := update_transformations(OCS_WCS,OCS);
if not visible then
exit;
Fheight := h;
ratio := 0;
//case hor_align of
// 0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
// 1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
// 2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
//end;
if Gt_matrix then
pa := map_fn(align_pt, OCS)
else
pa := map_fn(align_pt, {t_matrix}OCS_WCS);
fcolor := DxfColorToColor(fcolor);
Result := TFigure(cad.TextOut(layernum, pa.x, pa.y, 0, fHeight, ratio, tagstr, GCadForm.FFontName, RUSSIAN_CHARSET, fcolor, False));
end;
function Arc_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS:pM): Tfigure;
var
pu,pv,pw,px : TDoublePoint;
po,pa,pb : TDoublePoint;
t_matrix: pMatrix;
rad : Double;
cx,cy: Double;
ta,a1,a2: Double;
blk_ang: double;
blk_scale: Point3D;
Arc: TArc;
rPoints: TDoublePoint;
b1, b2: double;
modscalex, modscaley: double;
z: double;
begin
Result := nil;
// inherited;
t_matrix := update_transformations(OCS_WCS, OCS);
pu := map_fn(aPoint3D(p1.x - radius, p1.y - radius, p1.z - radius), t_matrix);
pv := map_fn(aPoint3D(p1.x + radius, p1.y + radius, p1.z + radius), t_matrix);
pw := map_fn(aPoint3D(p1.x + cos(angle1) * radius, p1.y + sin(angle1) * radius, p1.z + radius), t_matrix);
px := map_fn(aPoint3D(p1.x + cos(angle2) * radius, p1.y + sin(angle2) * radius, p1.z + radius), t_matrix);
rad := radius;
cx := (pu.x + pv.x) / 2;
cy := (pu.y + pv.y) / 2;
a1 := angle1;
a2 := angle2;
z := OCS_axis.z;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> PowerCad
if ord(Cad.VerticalZero) = 1 then
begin
if ord(Cad.HorizontalZero) = 0 then
begin
a1 := 2 * pi - a1;
a2 := 2 * pi - a2;
ta := a1;
a1 := a2;
a2 := ta;
end;
end;
if z < 0 then
begin
a1 := pi - a1;
a2 := pi - a2;
ta := a1;
a1 := a2;
a2 := ta;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
blk_ang := rotation;
blk_scale := scale;
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> !!!
if (blk_scale.x <> - 10000) and (blk_scale.y <> - 10000) then
begin
// SCALE <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> !!!
modscalex := abs(scale.x);
modscaley := abs(scale.y);
if (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> !!!!
a1 := a1 + (pi * 2 - blk_ang);
a2 := a2 + (pi * 2 - blk_ang);
if (scale.x < 0) and (scale.y < 0) then
begin
a1 := a1 - pi;
a2 := a2 - pi;
end
else
begin
if scale.x < 0 then
begin
a1 := a1 + 2 * (pi / 2 - a1);
a2 := a2 + 2 * (pi / 2 - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
if scale.y < 0 then
begin
a1 := a1 + 2 * (pi - a1);
a2 := a2 + 2 * (pi - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Result := TFigure(Cad.Arc(LayerNum, cx, cy, rad, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, 0, false));
Result.Draw(Cad.DEngine, False);
end
else
// SCALE <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> !!!
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> !!!!
a1 := a1 + (pi * 2 - blk_ang);
a2 := a2 + (pi * 2 - blk_ang);
if (scale.x < 0) and (scale.y < 0) then
begin
a1 := a1 - pi;
a2 := a2 - pi;
end
else
begin
if scale.x < 0 then
begin
a1 := a1 + 2 * (pi / 2 - a1);
a2 := a2 + 2 * (pi / 2 - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
if scale.y < 0 then
begin
a1 := a1 + 2 * (pi - a1);
a2 := a2 + 2 * (pi - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
fcolor := DxfColorToColor(fcolor);
Result := TFigure(Cad.ElpArc(LayerNum, cx, cy, rad, rad, 0, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, ord(asOpen), false));
Result.Draw(Cad.DEngine, False);
end;
end
else
begin
fcolor := DxfColorToColor(fcolor);
Result := TFigure(Cad.Arc(LayerNum, cx, cy, rad, a1, a2, 1, ord(psSolid), fcolor, ord(bsClear), 0, 0, false));
end;
end;
function Polyline_.ExportToPowerCad(Cad: TPCDrawing;map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
PointArray : TDoublePointArr;
lp1,tn : integer;
t_matrix : pMatrix;
begin
Result := nil;
//inherited;
SetLength(PointArray, numvertices);
t_matrix := update_transformations(OCS_WCS, OCS);
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1], t_matrix);
fcolor := DxfColorToColor(fcolor);
Result := TFigure(cad.PolyLine(layernum, PointArray, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, closed, false));
end;
function Insert_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
lp1 : integer;
t_matrix : pMatrix;
TempMatrix : Matrix;
Blk: Block_;
begin
Result := nil;
//inherited;
// we mustn't use the update_transformations call because inserts may be
// nested inside blocks inside other blocks, and update_transformations uses
// a temp fixed matrix which will be overwritten.
if OCS = nil then
t_matrix := OCS_WCS
else
if OCS_WCS=nil then
t_matrix := OCS
else
begin
TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
t_matrix := @TempMatrix;
end;
//for lp1:=0 to num_attribs-1 do attribs[lp1].Draw(acanvas,map_fn,t_matrix);
//if blockname<>'' then block.Draw(acanvas,map_fn,t_matrix);
for lp1 := 0 to num_attribs - 1 do
attribs[lp1].ExportToPowerCad(cad, map_fn, LayerNum, t_matrix);
if blockname <> '' then
begin
Blk := Block;
Blk.scale := scale;
Blk.rotation := rotation;
Blk.BeginPoint := BeginPoint;
Blk.ExportToPowerCad(cad, map_fn, LayerNum, t_matrix);
end;
end;
function Circle_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
po,pa,pb: TDoublePoint;
rad:Double;
t_matrix : pMatrix;
cx,cy: Double;
begin
Result := nil;
//inherited;
t_matrix := update_transformations(OCS_WCS,OCS);
pa := map_fn(aPoint3D(p1.x-radius,p1.y-radius,p1.z-radius),t_matrix);
pb := map_fn(aPoint3D(p1.x+radius,p1.y+radius,p1.z+radius),t_matrix);
po := map_fn(p1,t_matrix);
rad := radius;
fcolor := DxfColorToColor(fcolor);
Result := TFigure(cad.Circle(layernum, po.x, po.y, rad, 1, ord(psSolid), fcolor, ord(bsClear), 0, false));
end;
function Block_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): TFigure;
var
i, lp1 : integer;
t_matrix : pMatrix;
TempMatrix : Matrix;
vFigure: TFigure;
vBlock: TBlock;
InFiguresList: TList;
LHandle: Integer;
Bnd: TDoubleRect;
deltax, deltay: double;
RotPoints: TDoublePoint;
Angle_rad: double;
Angle_deg: double;
modscalex, modscaley: double;
str: string;
begin
Result := nil;
// we mustn't use the update_transformations call because blocks may be
// nested inside blocks inside other blocks, and update_transformations uses
// a temp fixed matrix which will be overwritten.
if OCS = nil then
t_matrix := OCS_WCS
else
if OCS_WCS = nil then
t_matrix := OCS
else
begin
TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
t_matrix := @TempMatrix;
end;
LHandle := Cad.GetLayerHandle(LayerNum);
InFiguresList := TList.create;
GRotPoints := map_fn(BeginPoint, nil);
for lp1 := 0 to entities.count - 1 do
begin
DXF_Entity(entities[lp1]).scale := scale;
DXF_Entity(entities[lp1]).rotation := rotation;
DXF_Entity(entities[lp1]).fcolor := fcolor;
Gt_matrix := true;
DXF_Entity(entities[lp1]).OCS_axis.z := scale.z;
vFigure := DXF_Entity(entities[lp1]).ExportToPowerCAd(cad, map_fn, LayerNum, t_matrix);
Gt_matrix := false;
if vFigure <> nil then
InFiguresList.Add(vFigure);
end;
if InFiguresList.Count > 0 then
begin
vBlock := TBlock.Create(LHandle, Cad);
for i := 0 to InFiguresList.Count - 1 do
begin
vFigure := TFigure(InFiguresList[i]);
if vFigure <> nil then
begin
vBlock.AddFigure(vFigure);
GCadForm.PCad.Figures.Remove(vFigure);
end;
end;
Cad.AddCustomFigure(LayerNum, vBlock, False);
RotPoints := map_fn(BeginPoint, nil);
Angle_deg := rotation * 180 / pi;
Angle_rad := rotation;
modscalex := abs(scale.x);
modscaley := abs(scale.y);
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> SCALE
if not (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>!!!
if not CheckTTextExistForDXF(vBlock) then
begin
if (scale.x > 0) and (scale.y > 0) then
begin
vBlock.Rotate(- (2 * pi - Angle_rad), vBlock.ap1{RotPoints});
vBlock.Scale(scale.x, scale.y, vBlock.ap1{RotPoints});
vBlock.Rotate((2 * pi - Angle_rad), vBlock.ap1{RotPoints});
end
else
if ((scale.x < 0) and (scale.y > 0)) or ((scale.x > 0) and (scale.y < 0)) then
begin
vBlock.Rotate(- Angle_rad, {vBlock.ap1}RotPoints);
vBlock.Scale(abs(scale.x), abs(scale.y), {vBlock.ap1}RotPoints);
vBlock.Rotate(Angle_rad, {vBlock.ap1}RotPoints);
end
else
if (scale.x < 0) and (scale.y < 0) then
begin
vBlock.Rotate(- (2 * pi - Angle_rad), vBlock.ap1{RotPoints});
vBlock.Scale(scale.x, scale.y, vBlock.ap1{RotPoints});
vBlock.Rotate((2 * pi - Angle_rad + pi), vBlock.ap1{RotPoints});
end;
end;
end;
if ((scale.x < 0) and (scale.y > 0)) or ((scale.x > 0) and (scale.y < 0)) then
begin
Angle_rad := (2 * pi - 2 * Rotation);
vBlock.Rotate(Angle_rad, RotPoints);
end;
FreeAndNil(InFiguresList);
Result := vBlock;
end;
GRotPoints := DoublePoint(-10000, -10000);
end;
function Polygon_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
PointArray : TDoublePointArr;
tPointS : TDoublePointArr;
tp : TPoint;
lp1,lp2,inx,i : integer;
t_matrix : pMatrix;
begin
Result := nil;
t_matrix := update_transformations(OCS_WCS,OCS);
SetLength(PointArray,numvertices);
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
// draw the M N-length polylines - we can use the array directly
SetLength(tPoints,N);
for lp1:=0 to M-1 do
begin
for i := 0 to n-1 do
tPoints[i] := PointArray[n*lp1+i];
Result := TFigure(cad.PolyLine(layernum,tPoints,1,ord(psSolid),fcolor,0,ord(bsClear),0,CloseN,false));
end;
Setlength(tPoints,M);
for lp1:=0 to N-1 do
begin
tPoints[0] := PointArray[lp1];
for lp2:=1 to M-1 do
begin
tPoints[lp2] := PointArray[lp2 * N + lp1];
end;
fcolor := DxfColorToColor(fcolor);
Result := Tfigure(cad.PolyLine(layernum, tPoints, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, CLoseM,false));
end;
end;
function Polyface_mesh_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert;LayerNum:integer;OCS:pM): Tfigure;
var
PointArray: TDoublePointArr;
lp1,lp2,inx: integer;
t_matrix: pMatrix;
begin
Result := nil;
t_matrix := update_transformations(OCS_WCS,OCS);
for lp1:=0 to numfaces-1 do
begin
for lp2 := 0 to 3 do
begin
inx := facelist^[lp1].nf[lp2];
if inx<0 then
break;
SetLength(PointArray,lp2+1);
PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
end;
fcolor := DxfColorToColor(fcolor);
Result := Tfigure(cad.Polygon(layernum, PointArray, 1, ord(psSolid), fcolor, ord(bsClear), 0, false));
end;
end;
{ MText_ }
procedure MText_.calcText(acanvas: TCanvas; map_fn: coord_convert; OCS: pM; t: string);
var
pa,dummy1,dummy2: TPoint;
Fheight: integer;
begin
with acanvas.Pen do
if Color <> fcolor then
Color:=fcolor;
// kludgy method for scaling text heights
dummy1 := map_fn(origin3D,nil);
dummy2 := map_fn(aPoint3D(0,h,0),nil);
Fheight := 2+(dummy1.y-dummy2.y);
if FHeight=2 then
exit;
with acanvas.Font do
begin
if Height<>Fheight then
Height := Fheight;
if color<>fcolor then
color := fcolor;
end;
case hor_align of
0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
end;
pa := map_fn(align_pt,OCS_WCS);
acanvas.TextOut(pa.x,pa.y,t);
end;
constructor MText_.create(OCSaxis, p, ap: Point3D; ss: string; height: double; col, ha, align: integer);
var
rotx, roty: double;
begin
inherited create(OCSaxis, p, col);
h := height;
if ss <> '' then
textstr := ss;
// **************************
rotx := ArcCos(ap.x);
roty := ArcSin(ap.y);
AngleRad := roty;
AngleRad := 2 * pi - AngleRad;
// if p1_eq_p2_3D(ap, origin3D) then
ap := p;
align_pt := ap;
hor_align := ha;
AlignIndex := align;
fcolor := col;
end;
function MText_.details: string;
begin
result := inherited details + EOL + 'Text '#9 + textstr + EOL + 'TextHeight = ' + float_out(h);
end;
procedure MText_.Draw(acanvas: TCanvas; map_fn: coord_convert; OCS: pM);
var
t_matrix : pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
calcText(acanvas,map_fn,t_matrix,textstr);
end;
function MText_.GetRichTextByFormat(aStr: string): TRichText;
var
MText: TRichText;
StrList: TStringList;
i: Integer;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
Ch: Char;
ResStr: string;
LHandle: Integer;
begin
try
Result := nil;
LHandle := GCadForm.PCad.GetLayerHandle(1);
fcolor := DxfColorToColor(fcolor);
MText := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(psClear), clBlack, LHandle, mydsNormal, GCadForm.PCad);
StrList := TStringList.Create;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> *********************************************************
ResStr := '';
i := 1;
Ch := aStr[i];
if Ch = '{' then
begin
i := i + 1;
Ch := aStr[i];
while Ch <> '}' do
begin
if Ch = '\' then
begin
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
while Ch <> ';' do
begin
i := i + 1;
Ch := aStr[i];
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
while ((Ch <> '\') and (Ch <> '}')) do
begin
i := i + 1;
Ch := aStr[i];
if ((Ch <> '\') and (Ch <> '}')) then
ResStr := ResStr + Ch;
end;
end;
end;
end;
// *************************************************************************
StrList.Add(ResStr);
MText.re.WordWrap := False;
MText.re.Font.Name := GCadForm.FFontName;
MText.re.Font.Charset := RUSSIAN_CHARSET;
MText.re.Font.Size := 12;
MText.re.Font.Style := [];
MText.re.Font.Color := fcolor;
MText.re.Lines.Clear;
for i := 0 to StrList.Count - 1 do
begin
StrList.Strings[i] := FastReplace(StrList.Strings[i],#13#10,' ');
MText.re.Lines.Add(StrList.Strings[i]);
end;
// Tolik
MText.ttMetaFile:= TMetaFile.Create;
MText.ttMetafile.Enhanced := True;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xCanvas := TMetafileCanvas.Create(MText.ttMetafile, 0);
xCanvas.Font.Name := MText.re.Font.Name;
xCanvas.Font.Size := MText.re.Font.Size;
xCanvas.Font.Style := MText.re.Font.Style;
GetTextMetrics(xCanvas.Handle, TM);
if MText.re.Lines.Count > 1 then
h := TM.tmHeight / 4 * MText.re.Lines.Count + 1
else
h := TM.tmHeight / 4 * MText.re.Lines.Count;
w := 0;
for i := 0 to MText.re.Lines.Count - 1 do
begin
if w < xCanvas.TextWidth(MText.Re.Lines[i]) then
w := xCanvas.TextWidth(MText.Re.Lines[i]);
end;
w := (w + 3) / 4 ;
FreeAndNil(xCanvas);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if MText <> nil then
begin
MText.ttMetaFile.Free;
FreeAndNil(MText);
end;
MText := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, GCadForm.PCad);
MText.re.WordWrap := False;
MText.re.Font.Name := GCadForm.FFontName;
MText.re.Font.Charset := RUSSIAN_CHARSET;
MText.re.Font.Size := 12;
MText.re.Font.Style := [];
MText.re.Font.Color := fcolor;
MText.re.Lines.Clear;
for i := 0 to StrList.Count - 1 do
begin
StrList.Strings[i] := FastReplace(StrList.Strings[i],#13#10,' ');
MText.re.Lines.Add(StrList.Strings[i]);
end;
MText.rotate(AngleRad, MText.ap1);
Result := MText;
except
on E: Exception do AddExceptionToLogEx('U_DXFEngineSCS.GetRichTextByFormat', E.Message);
end;
end;
function MText_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): TFigure;
var
pa : TDoublePoint;
Fheight: Double;
t_matrix : pMatrix;
ratio: double;
RichText: TRichText;
begin
Result := nil;
t_matrix := update_transformations(OCS_WCS, OCS);
Fheight := h;
ratio := 0;
// case hor_align of
// 0 : SetTextAlign(acanvas.handle,TA_LEFT + TA_BASELINE);
// 1 : SetTextAlign(acanvas.handle,TA_CENTER + TA_BASELINE);
// 2 : SetTextAlign(acanvas.handle,TA_RIGHT + TA_BASELINE);
// end;
pa := map_fn(align_pt, OCS_WCS);
if textstr <> '' then
begin
RichText := GetRichTextByFormat(textstr);
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
if (AlignIndex = 1) then
begin
RichText.Move(pa.x - RichText.ap1.x, pa.y - RichText.ap1.y);
end;
if (AlignIndex = 2) then
begin
RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.ap1.y);
end;
if (AlignIndex = 3) then
begin
RichText.Move(pa.x - RichText.ap2.x, pa.y - RichText.ap2.y);
end;
if (AlignIndex = 4) then
begin
RichText.Move(pa.x - RichText.ap1.x, pa.y - RichText.CenterPoint.y);
end;
if (AlignIndex = 5) then
begin
RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.CenterPoint.y);
end;
if (AlignIndex = 6) then
begin
RichText.Move(pa.x - RichText.ap2.x, pa.y - RichText.CenterPoint.y);
end;
if (AlignIndex = 7) then
begin
RichText.Move(pa.x - RichText.ap4.x, pa.y - RichText.ap4.y);
end;
if (AlignIndex = 8) then
begin
RichText.Move(pa.x - RichText.CenterPoint.x, pa.y - RichText.ap4.y);
end;
if (AlignIndex = 9) then
begin
RichText.Move(pa.x - RichText.ap3.x, pa.y - RichText.ap3.y);
end;
Result := TFigure(Cad.AddCustomFigure(LayerNum, RichText, false));
end;
end;
procedure MText_.max_min_extents(var emax, emin: Point3D);
begin
max_bound(emax,p1); min_bound(emin,p1);
end;
procedure MText_.write_to_DXF(var IO: textfile; layer: string);
begin
inherited;
writeln(IO,40 ,EOL,float_out(h));
writeln(IO,1 ,EOL,textstr);
if hor_align<>0 then
begin
write_DXF_Point(IO,11,align_pt);
writeln(IO,72 ,EOL,hor_align);
end;
end;
{ LWPolyline_ }
function LWPolyline_.closest_vertex(p: Point3D): Point3D;
var
lp1,c : integer;
d1,d2 : double;
begin
d1 := 1E10;
for lp1:=0 to numvertices-1 do
begin
d2 := sq_dist2D(polypoints^[lp1],p);
if d2<d1 then
begin
result := polypoints^[lp1];
d1 := d2;
end;
end;
end;
function LWPolyline_.closest_vertex_square_distance_2D(p: Point3D): double;
var
lp1 : integer;
begin
result := 1E10;
for lp1:=0 to numvertices-1 do
result := dmin(result,sq_dist2D(polypoints^[lp1],p));
end;
procedure LWPolyline_.copy_attribs(p: Polyline_);
var
lp1 : integer;
begin
p.numattrs := numattrs;
for lp1:=0 to numattrs-1 do
p.attribs[lp1] := attribs[lp1];
end;
function LWPolyline_.count_lines: integer;
begin
result := numvertices;
end;
function LWPolyline_.count_points: integer;
begin
result := numvertices;
end;
function LWPolyline_.count_polys_closed: integer;
begin
if closed then
result := 1
else
result := 0;
end;
function LWPolyline_.count_polys_open: integer;
begin
if not closed then
result := 1
else
result := 0;
end;
constructor LWPolyline_.create(OCSaxis: Point3D; numpoints: integer;
points: ppointlist; col: integer; closed_: boolean);
var
lp1 : integer;
begin
inherited create;
init_OCS_WCS_matrix(OCSaxis);
numvertices := numpoints;
if closed_ then
closed := true
else
if p1_eq_p2_3D(points[0], points[numvertices - 1]) then
begin
closed := true;
dec(numvertices);
end
else
closed := false;
polypoints := allocate_points(numvertices);
for lp1:=0 to numvertices-1 do
polypoints^[lp1] := points^[lp1];
fcolor := col;
fLineStyle := 'SOLID';
end;
destructor LWPolyline_.destroy;
begin
deallocate_points(polypoints,numvertices);
inherited destroy;
end;
function LWPolyline_.details: string;
var
lp1 : integer;
t : string;
begin
if OCS_WCS<>nil then
t := 'OCS Axis ' + Point3DToStr(OCS_axis)
else
t := 'WCS';
result := classname + EOL + t;
if closed then
result := result + EOL + 'Closed'
else
result := result + EOL + 'Open';
for lp1:=0 to numvertices-1 do
result := result + EOL + Point3DToStr(polypoints^[lp1]);
end;
procedure LWPolyline_.Draw(acanvas: TCanvas; map_fn: coord_convert;
OCS: pM);
var
PointArray: array[0..max_vertices_per_polyline-1] of TPoint;
lp1,tn: integer;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numvertices-1 do
PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
if not closed then
acanvas.Polyline(Slice(PointArray,numvertices))
else
acanvas.Polygon(Slice(PointArray,numvertices));
end;
procedure LWPolyline_.DrawVertices(acanvas: TCanvas; map_fn: coord_convert;
OCS: pM);
var
po: TPoint;
lp1: integer;
t_matrix: pMatrix;
begin
t_matrix := update_transformations(OCS_WCS,OCS);
with acanvas.Pen do
if Color<>fcolor then
Color:=fcolor;
for lp1:=0 to numvertices-1 do
begin
po := map_fn(polypoints^[lp1],t_matrix);
draw_cross(acanvas,po);
end;
end;
function LWPolyline_.ExportToPowerCad(Cad: TPCDrawing; map_fn: PC_convert; LayerNum: integer; OCS: pM): Tfigure;
var
PointArray : TDoublePointArr;
lp1,tn : integer;
t_matrix : pMatrix;
begin
Result := nil;
//inherited;
SetLength(PointArray, numvertices);
t_matrix := update_transformations(OCS_WCS, OCS);
for lp1 := 0 to numvertices - 1 do
PointArray[lp1] := map_fn(polypoints^[lp1], t_matrix);
// closed := True;
fcolor := DxfColorToColor(fcolor);
Result := Tfigure(cad.PolyLine(layernum, PointArray, 1, ord(psSolid), fcolor, 0, ord(bsClear), 0, closed, false));
end;
function LWPolyline_.get_attrib(i: integer): double;
begin
if i>=numattrs then
result := 0
else
result := attribs[i];
end;
function LWPolyline_.is_point_inside_object2D(p: Point3D): boolean;
var
i,j: integer;
p1_i,p1_j: Point3D;
begin
result := false;
if not closed then
exit;
j := numvertices-1;
for i:=0 to numvertices-1 do with p do
begin
p1_i := polypoints^[i];
p1_j := polypoints^[j];
if ((((p1_i.y<=y) and (y<p1_j.y)) or ((p1_j.y<=y) and (y<p1_i.y))) and
(x<(p1_j.x - p1_i.x)*(y-p1_i.y) / (p1_j.y - p1_i.y) + p1_i.x)) then
result:= not result;
j:=i;
end;
end;
procedure LWPolyline_.max_min_extents(var emax, emin: Point3D);
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
begin
max_bound(emax,polypoints^[lp1]); min_bound(emin,polypoints^[lp1]);
end;
end;
function LWPolyline_.Move_point(p, newpoint: Point3D): boolean;
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
begin
if p1_eq_p2_3D(polypoints^[lp1],p) then
begin
polypoints^[lp1] := newpoint;
result := true;
exit;
end;
end;
result := false;
end;
procedure LWPolyline_.quantize_coords(epsilon: double; mask: byte);
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
begin
if (mask and 1)=1 then
polypoints^[lp1].x := round(polypoints^[lp1].x*epsilon)/epsilon;
if (mask and 2)=2 then
polypoints^[lp1].y := round(polypoints^[lp1].y*epsilon)/epsilon;
if (mask and 4)=4 then
polypoints^[lp1].z := round(polypoints^[lp1].z*epsilon)/epsilon;
end;
end;
procedure LWPolyline_.set_attrib(i: integer; v: double);
begin
if (i+1)>numattrs then
numattrs:=(i+1);
attribs[i] := v;
end;
procedure LWPolyline_.translate(T: Point3D);
var
lp1 : integer;
begin
for lp1:=0 to numvertices-1 do
polypoints^[lp1] := p1_plus_p2(polypoints^[lp1],T);
end;
function LWPolyline_.triangle_centre: Point3D;
var
s,t : integer;
begin
if numvertices<>3 then
raise Exception.Create('Shouldn''t call this for non triangular facets');
s := 1;
t := 2;
result := p1_plus_p2(polypoints^[0],p1_plus_p2(polypoints^[s],polypoints^[t]));
result := p1_x_n(result,1/3);
end;
procedure LWPolyline_.write_to_DXF(var IO: textfile; layer: string);
var
lp1 : integer;
begin
inherited;
if closed then
writeln(IO,70 ,EOL,1+8) // 1+8 = closed+3D
else
writeln(IO,70 ,EOL,8);
writeln(IO, 66, EOL, 1);
writeln(IO, 6, EOL, fLineStyle);
for lp1:=0 to numvertices-1 do
begin
// writeln(IO,0 ,EOL,'VERTEX');
// writeln(IO,70 ,EOL,32); // 3D polyline mesh vertex
write_DXF_Point(IO, 10, polypoints^[lp1]);
end;
writeln(IO,0 ,EOL,'SEQEND');
end;
initialization
entities_in_existence := 0;
Ent_lists_in_existence := 0;
layers_in_existence := 0;
DXF_Obj_in_existence := 0;
end.
Reference in New Issue View Git Blame Copy Permalink