dxf_stru.pas

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

    p_1.z := p_1.z/numvertices;
    for lp1:=0 to numvertices-1 do d := d + dist3D(polypoints^[lp1],p_1);
    d := d/numvertices;
  end;
  inherited create(ent1.OCS_axis,p_1,ent1.colinx);
  radius := d;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

procedure Face3D_.write_to_DXF(var IO:textfile; layer:string);
var lp1 : integer;
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  writeln(IO,62,EOL,colinx);
  for lp1:=0 to numvertices-1 do
    write_DXF_Point(IO, 10 + lp1, polypoints^[lp1]);
  if numvertices=3 then begin // 4th point is same as third
    lp1 := 3;
    write_DXF_Point(IO, 10 + lp1, polypoints^[lp1-1]);
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Solid_
///////////////////////////////////////////////////////////////////////////////
constructor Solid_.create(OCSaxis:Point3D; numpoints:integer; points:ppointlist; col:integer; t:double);
begin
  inherited create(numpoints,points,col,true);
  thickness := t;
  init_OCS_WCS_matrix(OCSaxis);
end;

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

procedure Solid_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;