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