dxf_stru.pas

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

  writeln(IO,39,EOL,thickness);
end;

function Solid_.details : string;
begin
  result := inherited details + EOL +
            'Thickness'#9 + float_out(thickness);
end;

///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polygon MxN grid mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polygon_mesh_.create(numpoints,Mc,Nc:integer; points:ppointlist; closebits,col:integer);
begin
  inherited create(WCS_Z,numpoints,points,col,false);
  M := Mc; N := Nc;
  closeM := (closebits and 1 )=1;
  closeN := (closebits and 32)=32;
end;

function Polygon_mesh_.proper_name : string;
begin
  result := 'POLYLINE';
end;

procedure Polygon_mesh_.write_to_DXF(var IO:textfile; layer:string);
var lp1,flag : integer;
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  writeln(IO,62,EOL,colinx);
  writeln(IO,66,EOL,1);
  flag := 16;
  if closeM then flag := flag+1;
  if closeN then flag := flag+32;
  writeln(IO,70 ,EOL,flag);
  writeln(IO,71 ,EOL,M);
  writeln(IO,72 ,EOL,N);
  for lp1:=0 to numvertices-1 do begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,64);    // polygon mesh vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  writeln(IO,0 ,EOL,'SEQEND');
end;

function Polygon_mesh_.details : string;
var t : string;
begin
  if OCS_WCS<>nil then t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else t := 'WCS';
  result := 'Polyline_ (polygon mesh)' + EOL + t + EOL +
            'Vertices'#9 + IntToStr(numvertices) + EOL +
            'M'#9 + IntToStr(M) + EOL +
            'N'#9 + IntToStr(N) + EOL +
            'Closed M'#9 + BoolToStr(closeM) + EOL +
            'Closed N'#9 + BoolToStr(closeN);
end;

type
  ptarray = array[0..max_vertices_per_polyline-1] of TPoint;
  pptarray = ^ptarray;

procedure Polygon_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray  : array[0..max_vertices_per_polyline-1] of TPoint;
    tp          : TPoint;
    lp1,lp2,inx : integer;
    t_matrix    : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  for lp1:=0 to numvertices-1 do
    PointArray[lp1] := map_fn(polypoints^[lp1],t_matrix);
  // draw the M N-length polylines - we can use the array directly
  if closeN then for lp1:=0 to M-1 do acanvas.Polygon( Slice(pptarray(@PointArray[N*lp1])^,N))
  else           for lp1:=0 to M-1 do acanvas.Polyline(Slice(pptarray(@PointArray[N*lp1])^,N));
  // draw the N M-length polylines - we need to hop along the array in M steps
  for lp1:=0 to N-1 do begin
    acanvas.MoveTo(PointArray[lp1].x,PointArray[lp1].y);
    for lp2:=1 to M-1 do begin
      tp := PointArray[lp2*N+lp1];
      acanvas.LineTo(tp.x,tp.y);
    end;
    if closeM then acanvas.LineTo(PointArray[lp1].x,PointArray[lp1].y);
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Polyline_ (polyface vertex array mesh)
///////////////////////////////////////////////////////////////////////////////
constructor Polyface_mesh_.create(numpoints,nfaces:integer; points:ppointlist; faces:pfacelist; col:integer);
var lp1 : integer;
begin
  DXF_Entity.create; // don't call polyline_constructor
  numvertices := numpoints;
  numfaces    := nfaces;
  polypoints  := allocate_points(numvertices);
  for lp1:=0 to numvertices-1 do polypoints^[lp1] := points^[lp1];
  Getmem(facelist,numfaces*SizeOf(polyface));
  for lp1:=0 to numfaces-1 do facelist^[lp1] := faces^[lp1];
  setcolour_index(col);
end;

destructor Polyface_mesh_.destroy;
begin
  Freemem(facelist,numfaces*SizeOf(polyface));
  inherited destroy;
end;

function Polyface_mesh_.proper_name : string;
begin
  result := 'POLYLINE';
end;

procedure Polyface_mesh_.write_to_DXF(var IO:textfile; layer:string);
var lp1,lp2,inx : integer;
begin
  writeln(IO,0 ,EOL,proper_name);
  writeln(IO,8 ,EOL,layer);
  writeln(IO,62,EOL,colinx);
  writeln(IO,66,EOL,1);
  writeln(IO,70,EOL,64);
  writeln(IO,71,EOL,numvertices);
  writeln(IO,72,EOL,numfaces);
  for lp1:=0 to numvertices-1 do begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,64+128);    // polyface mesh coordinate vertex
    write_DXF_Point(IO, 10, polypoints^[lp1]);
  end;
  for lp1:=0 to numfaces-1 do begin
    writeln(IO,0  ,EOL,'VERTEX');
    writeln(IO,70 ,EOL,128);    // polyface mesh face vertex
    for lp2:=0 to 3 do writeln(IO,71+lp2 ,EOL,facelist^[lp1].nf[lp2]+1);
  end;
  writeln(IO,0 ,EOL,'SEQEND');
end;

function Polyface_mesh_.details : string;
var t : string;
begin
  if OCS_WCS<>nil then t := 'OCS Axis ' + Point3DToStr(OCS_axis)
  else t := 'WCS';
  result := 'Polyline_ (polyface mesh)' + EOL + t + EOL +
            'Vertices'#9 + IntToStr(numvertices) + EOL +
            'Faces'#9 + IntToStr(numfaces);
end;

procedure Polyface_mesh_.Draw(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var PointArray  : array[0..3] of TPoint;
    lp1,lp2,inx : integer;
    t_matrix    : pMatrix;
begin
  t_matrix := update_transformations(OCS_WCS,OCS);
  with acanvas.Pen do if Color<>colour then Color:=colour;
  for lp1:=0 to numfaces-1 do begin
    for lp2:=0 to 3 do begin
      inx := facelist^[lp1].nf[lp2];
      if inx<0 then break; // index -> -1 = end of vertices
      PointArray[lp2] := map_fn(polypoints^[inx],t_matrix);
    end;
    acanvas.Polygon(Slice(PointArray,lp2));
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// Entity_List class implementation
///////////////////////////////////////////////////////////////////////////////
constructor Entity_List.create(l_name:string);
begin
  list_name      := l_name;
  entities       := TList.Create;
  inc(Ent_lists_in_existence);
end;

destructor Entity_List.destroy;
var lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do DXF_Entity(entities[lp1]).Free;
  entities.Free;
  dec(Ent_lists_in_existence);
  inherited destroy;
end;

function Entity_List.add_entity_to_list(entity:DXF_Entity) : boolean;
begin
  if sorted then result := insert(entity)
  else           result := add_at_end(entity);
end;

function Entity_List.remove_entity(ent:DXF_Entity) : boolean;
var lp1 : integer;
begin
  result := false;
  for lp1:=0 to (entities.Count-1) do begin
    if entities[lp1]=ent then begin
      entities.remove(ent);
      ent.free;
      result := true;
      exit;
    end;
  end;
end;

function Entity_List.add_at_end(entity:DXF_Entity) : boolean;
begin
  entities.Add(entity);
end;

function Entity_List.insert(entity:DXF_Entity) : boolean;
begin
  entities.Add(entity);
end;

procedure Entity_List.draw_primitives(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1  : integer;
begin
  for lp1:=0 to (entities.Count-1) do begin
    DXF_Entity(entities[lp1]).Draw(acanvas, map_fn,OCS);
  end;
end;

procedure Entity_List.draw_vertices(acanvas:TCanvas; map_fn:coord_convert; OCS:pM);
var lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do
    DXF_Entity(entities[lp1]).DrawVertices(acanvas, map_fn,OCS);
end;

function Entity_List.num_entities : integer;
begin
  result := entities.Count;
end;

function Entity_List.count_points : integer;
var lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_points;
end;

function Entity_List.count_lines : integer;
var lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_lines;
end;

function Entity_List.count_polys_open : integer;
var lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_polys_open;
end;

function Entity_List.count_polys_closed : integer;
var lp1 : integer;
begin
  result := 0;
  for lp1:=0 to (entities.Count-1) do
    result := result + DXF_Entity(entities[lp1]).count_polys_closed;
end;

procedure Entity_List.max_min_extents(var emax,emin:Point3D);
var lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do
    DXF_Entity(entities[lp1]).max_min_extents(emax,emin);
end;

procedure Entity_List.setcolour(col:integer);
var lp1 : integer;
begin
  for lp1:=0 to (entities.Count-1) do
    DXF_Entity(entities[lp1]).colour := col;
end;

function Entity_List.closest_vertex_square_distance_2D(p:Point3D; var cl:DXF_Entity) : double;
var lp1 : integer;
    cl_ : DXF_Entity;
    t   : double;
begin
  result := 1E10;
  for lp1:=0 to (entities.Count-1) do begin
    cl_ := DXF_Entity(entities[lp1]);
    t   := cl_.closest_vertex_square_distance_2D(p);
    if t<result then begin
      cl := cl_;
      result := t;
    end;
  end;
end;

function Entity_List.find_bounding_object(p:Point3D) : DXF_Entity;
var lp1 : integer;
    ent : DXF_Entity;
begin
  result := nil;
  for lp1:=0 to (entities.Count-1) do begin
    ent := DXF_Entity(entities[lp1]);
    if ent.is_point_inside_object2D(p) then begin
      result := ent;
      exit;
    end;
  end;
end;
///////////////////////////////////////////////////////////////////////////////
// DXF_layer class implementation
///////////////////////////////////////////////////////////////////////////////
constructor DXF_Layer.create(l_name:string);
begin
  layer_name   := l_name;
  entity_names := TStringList.Create;
  entity_lists := TList.Create;
  inc(layers_in_existence);
end;

destructor DXF_Layer.destroy;
var lp1 : integer;
    el : Entity_List;
begin
  if num_lists>0 then for lp1:=num_lists-1 downto 0 do begin
    el := Entity_List(entity_lists[lp1]);
    el.Free;
  end;
  entity_names.Free;
  entity_lists.Free;
  dec(layers_in_existence);
  inherited destroy;
end;

procedure DXF_Layer.delete(aname:string; releasemem:boolean);
var lp1 : integer;
    el  : Entity_List;
begin
  for lp1:=num_lists-1 downto 0 do begin
    el := Entity_List(entity_lists[lp1]);
    if el.name=aname then begin
      entity_lists.remove(el);
      if releasemem then el.Free;
      entity_names.delete(lp1);
    end;
  end;
end;

function DXF_Layer.add_entity_to_layer(entity:DXF_Entity) : boolean;
var i  : integer;
    el : Entity_List;
begin
  i := entity_names.IndexOf(entity.ClassName);
  if i=-1 then begin
    el := Entity_List.create(entity.ClassName);
    el.parent_layer := self;
    i  := entity_lists.Add(el);
    if i<>entity_names.Add(entity.ClassName) then
      raise Exception.Create('Entity list ID mismatch');
    // This has never been raised yet, but might as well be sure.
  end;
  Entity_List(entity_lis