ezdxfread.pas

很管用的GIS控件

    Else
      fd1 := fd1 + PI;
  End;
  result := fd1;
End;

Function bulge2arc( p0, p1: point3d; bulge: double; Var cc: point3d; Var rr, sa, ea: double ): integer;
Var
  fi1: integer;
  dx, dy, sep, ss: double;
  ara: Array[0..1] Of double;
Begin
  {/*
  **  Given an arc defined by two pts and bulge, determines the CCW arc's
  **  center, radius, starting angle and ending angle.
  **
  **  Returns:
  **       0 : OK
  **      -1 : Points coincident
  **       1 : It's a line
  **    -2 : Non planar arc
  */}
  If ( bulge = 0.0 ) Then
  Begin
    result := 1; //* Line */
    exit;
  End;

  //* Points must be nearly planar */
  If ( abs( p0.z ) <= IC_ZRO ) Then
  Begin
    If ( abs( p1.z ) > IC_ZRO ) Then
    Begin
      result := -2;
      exit;
    End;
  End
  Else If ( abs( ( p0.z / p1.z ) - 1.0 ) > IC_ZRO ) Then
  Begin
    result := -2;
    exit;
  End;

  dx := p1.x - p0.x;
  dy := p1.y - p0.y;

  sep := sqrt( dx * dx + dy * dy );

  If ( sep = 0.0 ) Then
  Begin
    result := -1; //* Coincident */
    exit;
  End;

  rr := abs( sep * ( bulge + 1.0 / bulge ) / 4.0 ); //* Radius */
  ss := ( rr ) * ( rr ) - sep * sep / 4.0;
  If ( ss < 0.0 ) Then
    ss := 0.0; // Should never
  ss := sqrt( ss );

  //* Find center: */
  ara[0] := ss / sep;
  If ( ( bulge < -1.0 ) Or ( ( bulge > 0.0 ) And ( bulge < 1.0 ) ) ) Then //* Step left of midpt */
  Begin
    cc.x := ( p0.x + p1.x ) / 2.0 - ara[0] * dy;
    cc.y := ( p0.y + p1.y ) / 2.0 + ara[0] * dx;
  End
  Else
  Begin //* Step left of midpt */
    cc.x := ( p0.x + p1.x ) / 2.0 + ara[0] * dy;
    cc.y := ( p0.y + p1.y ) / 2.0 - ara[0] * dx;
  End;

  cc.z := p0.z + p1.z;
  cc.z := cc.z * 0.5;

  //* Find starting and ending angles: */
  dx := p0.x - cc.x;
  dy := p0.y - cc.y;
  ara[0] := ic_atan2( dy, dx ); //* Avoid METAWARE bug */
  dx := p1.x - cc.x;
  dy := p1.y - cc.y;
  ara[1] := ic_atan2( dy, dx );

  //* If bulge>=0.0, take starting angle from p0: */
  fi1 := integer( bulge < 0.0 );

  sa := ara[fi1];
  If fi1 = 0 Then
    fi1 := 1
  Else
    fi1 := 0;
  ea := ara[fi1];

  //* Make both 0.0<=ang<EzEntities.TwoPI : */
  If bulge > 0 Then
  Begin
    If ( sa < 0.0 ) Then
      sa := sa + EzEntities.TwoPI;
    If ( ea < 0.0 ) Then
      ea := ea + EzEntities.TwoPI;
  End;
  result := 0;
End;

// R14侩

Function DXF_Reader.read_lwpolyline( Var entity: DXF_Entity; Var layer: integer ): boolean;
Var
  ent1: abstract_entity14;
  closed_poly: boolean;
  i, M, N, mn: integer;
  LS: integer;

  //added for lwpolyarc
  CC: Point3D;
  rr, sa, ea: double; //radius, startangle, endangle
  tempvert2: Array[0..max_vertices_per_polyline - 1] Of Point3D;

Label
  vertex_overflow;

  Function CheckBulge: boolean;
  Var
    i: integer;
  Begin
    result := false;
    For i := 0 To ent1.vertices Do
      If ent1.floatvals[i].y <> 0 Then
      Begin //check vertex 42 value. 41=x, 42=y, 43=z
        result := true;
        break;
      End;
  End;

  Procedure arc( xcenter, ycenter, Zvalue, radius, starttheta, endtheta, bulge: double;
    Var VertNo: integer );
  Var
    i, j: integer;
    se, ea: double;
    x, y: Array[0..65] Of double;
    dtheta, dcos, dsin, num: double;
  Begin
    num := 32;
    If ( starttheta < endtheta ) Then
    Begin
      se := endtheta;
      ea := starttheta;
      dtheta := ( ea - Se ) / num;
      dcos := cos( dtheta );
      dsin := sin( dtheta );
      x[0] := radius * cos( Se );
      y[0] := radius * sin( Se );
      For i := 0 To trunc( num ) - 1 Do
      Begin
        x[i + 1] := x[i] * dcos - y[i] * dsin;
        y[i + 1] := x[i] * dsin + y[i] * dCos;
      End;
      If bulge > 0 Then
      Begin
        j := 0;
        For i := trunc( num ) - 1 Downto 0 Do
        Begin
          TempVert2[VertNo + j].x := xcenter + x[i];
          TempVert2[VertNo + j].y := ycenter + y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End
      Else
      Begin
        j := 0;
        For i := 0 To trunc( num ) - 1 Do
        Begin
          TempVert2[VertNo + j].x := xcenter + x[i];
          TempVert2[VertNo + j].y := ycenter + y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End;
    End
    Else
    Begin
      se := starttheta;
      ea := endtheta;
      ea := ea + pi;
      Se := Se - pi;
      dtheta := ( ea - Se ) / num;

      dcos := cos( dtheta );
      dsin := sin( dtheta );

      x[0] := radius * cos( Se );
      y[0] := radius * sin( Se );
      For i := 0 To trunc( num ) - 1 Do
      Begin
        x[i + 1] := x[i] * dcos - y[i] * dsin;
        y[i + 1] := x[i] * dsin + y[i] * dCos;
      End;
      If bulge < 0 Then
      Begin
        j := 0;
        For i := trunc( num ) - 1 Downto 0 Do
        Begin
          TempVert2[VertNo + j].x := xcenter - x[i];
          TempVert2[VertNo + j].y := ycenter - y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End
      Else
      Begin
        j := 0;
        For i := 0 To trunc( num ) - 1 Do
        Begin
          TempVert2[VertNo + j].x := xcenter - x[i];
          TempVert2[VertNo + j].y := ycenter - y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End;
    End;
    vertno := vertno + trunc( num );
  End;

Begin
  result := false;
  closed_poly := false;
  entity := Nil;

  ent1 := abstract_entity14.Create;
  If Not read_entity_data14( ent1 ) Then
    Goto Vertex_overflow;
  layer := layer_num( ent1.layer );

  If ( ent1.colour = 0 ) And ( layer <> -1 ) Then
    ent1.Colour := Dxf_layer( dxf_layers[layer] ).colour;
  If ( layer = -1 ) Then
    layer := DXF_Layers.Add( DXF_Layer.Create( ent1.layer, ent1.colour, ent1.LineStyle ) );

  // THIS IS A NORMAL LWPOLYLINE
  // this should set result to true, because 0 SEQEND is next
  LS := 1;
  If ( ent1.flag_70 And ( 64 + 16 ) ) = 0 Then
  Begin
    result := true;
    If ( ( ent1.flag_70 ) And 1 ) = 1 Then
      closed_poly := true;
    If ent1.LineStyle = '' Then
      LS := DXF_Layer( DXF_Layers[Layer] ).LineStyle // bylayer
    Else
      LS := AcadLineStyle.FindLineStyle( ent1.linestyle );

    entity := Nil;
    If Checkbulge = false Then
      entity := Polyline_.Create( ent1.OCS_Z, ent1.vertices, ent1.polypoints, ent1.colour, closed_poly, LS )
    Else
    Begin
      m := 0; //泅犁 痢谅钎蔼 汗荤困摹...
      For i := 0 To ent1.vertices - 1 Do
        If ent1.floatvals^[i].Y <> 0 Then
        Begin
          //滴痢苞 酒农甫 积己...
          If ( i < ( ent1.vertices - 1 ) ) Then
          Begin
            If bulge2arc( ent1.polypoints^[i], ent1.polypoints^[i + 1], ent1.floatvals^[i].Y, cc, rr, sa, ea ) = 0 Then
            Begin
              tempvert2[m] := ent1.polypoints^[i];
              inc( m );
              Arc( cc.x, cc.y, ent1.polypoints^[i].z, rr, sa, ea, ent1.floatvals^[i].Y, m );
            End;
          End
          Else
          Begin
            If closed_poly Then
            Begin
              If bulge2arc( ent1.polypoints^[i], ent1.polypoints^[0], ent1.floatvals^[i].Y, cc, rr, sa, ea ) = 0 Then
              Begin
                tempvert2[m] := ent1.polypoints^[i];
                inc( m );
                Arc( cc.x, cc.y, ent1.polypoints^[i].z, rr, sa, ea, ent1.floatvals^[i].Y, m );
              End;
            End
            Else
            Begin
              tempvert2[m] := ent1.polypoints^[i];
              inc( m );
            End;
          End
        End
        Else
        Begin
          tempvert2[m] := ent1.polypoints^[i];
          inc( m );
        End;
      If m > 0 Then
      Begin
        entity := Polyline_.Create( ent1.OCS_Z, m, @tempvert2[0], ent1.colour, closed_poly, LS );
      End;
    End;
  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;
    result := true;
    If mn <> M * N Then
    Begin
      ent1.Free;
      exit;
    End; // error
    entity := Polygon_mesh_.Create( ent1.vertices, M, N, ent1.polypoints, ent1.flag_70, ent1.colour, LS );
  End;
  ent1.Free;
  exit; // next bit only when vertices overflow

  vertex_overflow:
  ent1.Free;
  Errlist.Add( Format( SDXFLWPolylineBad, [max_vertices_per_polyline, line_num] ) );
End;

//polyline_arc_end

Function Dxf_Reader.Findlayer( Const name: String; Var dxflayer: dxf_layer ): boolean;
Var
  i: integer;
Begin
  Result := false;
  dxfLayer := Nil;
  For i := 0 To dxf_layers.Count - 1 Do
    If dxf_layer( dxf_layers[i] ).layer_name = name Then
    Begin
      result := true;
      DXFLayer := dxf_layers[i];
      break;
    End;
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.

//polyline_arc_begin

Function DXF_Reader.read_polyline( Var entity: DXF_Entity; Var layer: integer ): boolean;
Var
  ent1, ent2: abstract_entity;
  vertices: integer;
  faces: integer;
  tempvert: Array[0..max_vertices_per_polyline - 1] Of Point3D;
  LS: Integer;

  //polyline arc variable begin
  tempfv: Array[0..max_vertices_per_polyline - 1] Of double;
  tempvert2: Array[0..max_vertices_per_polyline - 1] Of Point3D;
  CC: Point3D;
  rr, sa, ea: double; //radius, startangle, endangle
  //end

  tempface: Array[0..4095] Of polyface;
  closed_poly: boolean;
  M, N, mn, i: integer;

Label
  vertex_overflow;

  Function CheckBulge: boolean;
  Var
    i: integer;
  Begin
    result := false;
    For i := 0 To vertices Do
      If tempfv[i] <> 0 Then
      Begin
        result := true;
        break;
      End;
  End;

  Procedure arc( xcenter, ycenter, Zvalue, radius, starttheta, endtheta, bulge: double; Var VertNo: integer );
  Var
    i, j: integer;
    se, ea: double;
    x, y: Array[0..65] Of double;
    dtheta, dcos, dsin, num: double;
  Begin
    num := 32;
    If ( starttheta < endtheta ) Then
    Begin
      se := endtheta;
      ea := starttheta;
      dtheta := ( ea - Se ) / num;
      dcos := cos( dtheta );
      dsin := sin( dtheta );
      x[0] := radius * cos( Se );
      y[0] := radius * sin( Se );
      For i := 0 To trunc( num ) - 1 Do
      Begin
        x[i + 1] := x[i] * dcos - y[i] * dsin;
        y[i + 1] := x[i] * dsin + y[i] * dCos;
      End;
      If bulge > 0 Then
      Begin
        j := 0;
        For i := trunc( num ) - 1 Downto 0 Do
        Begin
          TempVert2[VertNo + j].x := xcenter + x[i];
          TempVert2[VertNo + j].y := ycenter + y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End
      Else
      Begin
        j := 0;
        For i := 0 To trunc( num ) - 1 Do
        Begin
          TempVert2[VertNo + j].x := xcenter + x[i];
          TempVert2[VertNo + j].y := ycenter + y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;
      End;
    End
    Else
    Begin
      se := starttheta;
      ea := endtheta;
      ea := ea + pi;
      Se := Se - pi;
      dtheta := ( ea - Se ) / num;
      dcos := cos( dtheta );
      dsin := sin( dtheta );
      x[0] := radius * cos( Se );
      y[0] := radius * sin( Se );
      For i := 0 To trunc( num ) - 1 Do
      Begin
        x[i + 1] := x[i] * dcos - y[i] * dsin;
        y[i + 1] := x[i] * dsin + y[i] * dCos;
      End;
      If bulge < 0 Then
      Begin
        j := 0;
        For i := trunc( num ) - 1 Downto 0 Do
        Begin
          TempVert2[VertNo + j].x := xcenter - x[i];
          TempVert2[VertNo + j].y := ycenter - y[i];
          TempVert2[VertNo + j].z := Zvalue;
          inc( j );
        End;