dxf_stru.pas

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

  inherited create(OCSaxis,p,col);
  h := height;
  if ss<>'' then textstr := ss;
  if p1_eq_p2_3D(ap,origin3D) then ap:=p;
  align_pt  := ap;
  hor_align := ha;
end;

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

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

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

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

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

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

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

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

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

procedure Attdef_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  writeln(IO,DXF_text_prompt ,EOL,promptstr);
end;
///////////////////////////////////////////////////////////////////////////////
// Insert
///////////////////////////////////////////////////////////////////////////////
constructor Insert_.create(OCSaxis,p,s_f:Point3D; rot:double; col:integer; numatts:integer; atts:patt_array; block:string);
var lp1 : integer;
begin
  inherited create(OCSaxis,p,col);
  blockname   := block;
  blockptr    := nil;
  scale       := s_f;
  rotation    := DegToRad(rot);
  init_OCS_WCS_matrix(OCSaxis);
  num_attribs := numatts;
  if num_attribs>max_attribs then raise Exception.Create('This version only handles '+IntToStr(max_attribs)+' ATTRIBs');
  for lp1:=0 to num_attribs-1 do attribs[lp1] := atts^[lp1];
end;

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

procedure Insert_.init_OCS_WCS_matrix(OCSaxis:Point3D);
var Ax,Ay : Point3D;
begin
  // inserts always have a transformation matrix - to allow the translation
  // even when the other parameters are defauls
  OCS_axis := OCSaxis;
  OCS_WCS  := allocate_matrix;
  if (abs(OCSaxis.x)<1/64) and (abs(OCSaxis.y)<1/64) then Ax := normalize(cross(WCS_Y,OCSaxis))
  else                                                    Ax := normalize(cross(WCS_Z,OCSaxis));
  Ay       := normalize(cross(OCSaxis,Ax));
  OCS_WCS^ := Identity;
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, ZRotateMatrix(cos(-rotation),sin(-rotation)));
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, ScaleMatrix(scale) );
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, TranslateMatrix(p1) );
  OCS_WCS^ := MatrixMultiply(OCS_WCS^, CreateTransformation(Ax,Ay,OCSaxis) );
end;

procedure Insert_.update_block_links(blist:TObject);
begin
  blocklist := blist;
  if blockname<>'' then block.update_block_links(blist);
end;

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

procedure Insert_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1        : integer;
    t_matrix   : pMatrix;
    TempMatrix : Matrix;
begin
  // we mustn't use the update_transformations call because inserts may be
  // nested inside blocks inside other blocks, and update_transformations uses
  // a temp fixed matrix which will be overwritten.
  if OCS=nil then t_matrix := OCS_WCS
  else if OCS_WCS=nil then t_matrix := OCS
  else begin
    TempMatrix := MatrixMultiply(OCS_WCS^,OCS^);
    t_matrix := @TempMatrix;
  end;
  for lp1:=0 to num_attribs-1 do attribs[lp1].Draw(acanvas,map_fn,t_matrix);
  if blockname<>'' then block.Draw(acanvas,map_fn,t_matrix);
end;

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

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

procedure Insert_.max_min_extents(var emax,emin:Point3D);
begin
  inherited;
end;
///////////////////////////////////////////////////////////////////////////////
// Line
///////////////////////////////////////////////////////////////////////////////
constructor Line_.create(p_1,p_2:Point3D; col:integer);
begin
  inherited create(WCS_Z,p_1,col);
  p2 := p_2;
end;

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

procedure Line_.DrawVertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var po : TPoint;
    t_matrix : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  po := map_fn(p1,t_matrix);
  draw_cross(acanvas,po);
  po := map_fn(p2,t_matrix);
  draw_cross(acanvas,po);
end;

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

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

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

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

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

procedure Line_.write_to_DXF(var IO:textfile; layer:string);
begin
  inherited;
  write_DXF_Point(IO,11,p2);
end;

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

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

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

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

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