dxf_structs.pas

FlexGraphics是一套创建矢量图形的VCL组件

    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;
  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     : 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
  // TODO: ??? DXF_Entity.Create; // don't call polyline_constructor
  raise Exception.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 : 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);
  result := true;
end;

function Entity_List.insert(entity:DXF_Entity) : boolean;
begin
  entities.Add(entity);
  result := true;
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
    en