ezdxfread.pas

来自「很管用的GIS控件」· PAS 代码 · 共 2,285 行 · 第 1/5 页

Var
  lp1: integer;
Begin
  result := -1;
  For lp1 := 0 To DXF_Layers.count - 1 Do
  Begin
    If DXF_Layer( DXF_Layers[lp1] ).name = layername Then
    Begin
      result := lp1;
      exit;
    End;
  End;
End;
{ --------------------------------------------------------------------------- }
{ Entities section
{ --------------------------------------------------------------------------- }

Function DXF_Reader.move_to_entity_section: boolean;
Begin
  result := skip_upto_section( 'ENTITIES' );
End;

Function DXF_Reader.read_entities: boolean;
Var
  Groupcode, layer: integer;
  s: String;
  //DispText         : array[0..255] of char ;
  entity: DXF_Entity;
  canContinue: Boolean;
Begin
  result := false;
  Repeat
    Try
      If Not code_and_string( Groupcode, s ) Then break;
      If ( Groupcode = 0 ) Then
      Begin
        result := read_entity( s, 'ENDSEC', entity, layer );
        // put the entity in the layer...
        If entity <> Nil Then
          DXF_Layer( DXF_Layers[layer] ).add_entity_to_layer( entity );
        If ( getasynckeystate( vk_escape ) ) <> 0 Then
          result := true;
      End;
    Except
      On E: DXF_read_exception Do
      Begin
        //stopped_thinking;
        If Assigned( FGis.OnError ) Then
        Begin
          CanContinue := true;
          FGis.OnError( FGis, E.Message, esImporting, CanContinue );
          If Not CanContinue Then
            Errlist.add( 'User aborted' );
        End;

        //          raise DXF_read_exception.Create('User aborted',-1);

        //Strpcopy(DispText, DXF_FILE+SDXFFileReadingNow);
        //thinking_bar(nil, DispText );
        If fGIS <> Nil Then
          FGIS.UpdateCaption( DXF_FILE + SDXFFileReadingNow );
      End;
      On E: Exception Do
      Begin
        If Assigned( FGis.OnError ) Then
          FGis.OnError( FGIS, E.Message, esImporting, CanContinue );
      End;
    End;
  Until result;
End;
{ --------------------------------------------------------------------------- }
{ Entity reading code
{ --------------------------------------------------------------------------- }

Function DXF_Reader.read_entity_data( ent: abstract_entity ): boolean;
Var
  Groupcode: Integer;
Begin
  ent.OCS_Z := WCS_Z;
  Repeat
    Groupcode := NextGroupCode;
    Case Groupcode Of
      DXF_primary_X: ent.p1.x := Valdbl;
      DXF_primary_Y: ent.p1.y := Valdbl;
      DXF_primary_Z: ent.p1.z := Valdbl;
      DXF_other_X_1: ent.p2.x := Valdbl;
      DXF_other_Y_1: ent.p2.y := Valdbl;
      DXF_other_Z_1: ent.p2.z := Valdbl;
      DXF_other_X_2: ent.p3.x := Valdbl;
      DXF_other_Y_2: ent.p3.y := Valdbl;
      DXF_other_Z_2: ent.p3.z := Valdbl;
      DXF_other_X_3: ent.p4.x := Valdbl;
      DXF_other_Y_3: ent.p4.y := Valdbl;
      DXF_other_Z_3: ent.p4.z := Valdbl;
      DXF_floatval: ent.rad_hgt := Valdbl;
      DXF_floatvals1: ent.fv1 := Valdbl;
      DXF_floatvals2: ent.fv2 := Valdbl;
      DXF_floatvals3: ent.fv3 := Valdbl;
      DXF_angle1: ent.angle1 := Valdbl;
      DXF_angle2: ent.angle2 := Valdbl;
      DXF_thickness: ent.thickness := Valdbl;
      DXF_elevation: ent.elev := Valdbl;
      DXF_70Flag: ent.flag_70 := ValInt;
      DXF_71Flag: ent.flag_71 := ValInt;
      DXF_72Flag: ent.flag_72 := ValInt;
      DXF_73Flag: ent.flag_73 := ValInt;
      DXF_74Flag: ent.flag_74 := ValInt;
      DXF_colornum: ent.colour := ValInt;
      DXF_entities_flg: ent.attflag := ValInt;
      DXF_layer_name: ent.layer := ValStr;
      DXF_name: ent.namestr := ValStr;
      DXF_text_def: ent.tagstr := ValStr;
      DXF_text_prompt: ent.promptstr := ValStr;
      DXF_text_style: ent.text_style := Valstr;
      DXF_line_type: ent.LineStyle := Valstr;
      DXF_extrusionx: ent.OCS_Z.x := Valdbl;
      DXF_extrusiony: ent.OCS_Z.y := Valdbl;
      DXF_extrusionz: ent.OCS_Z.z := Valdbl;
    End;
  Until ( Groupcode <= 0 ); // end or fault;

  If Groupcode < 0 Then
  Begin
    result := false;
    exit;
  End;
  // we need to put the code=0, and valstr back, so the next entity starts
  // with the zero when neccessary
  go_back_to_last( Groupcode, fline );
  ent.OCS_Z := normalize( ent.OCS_Z ); // for safety
  result := true;
End;

//polyline_arc_begin

Function DXF_Reader.read_entity_data14( ent: abstract_entity14 ): boolean;
Var
  Groupcode: integer;
  I, vertices: integer;
  tempvert: Array[0..max_vertices_per_polyline - 1] Of Point3D;
  tempfv: Array[0..max_vertices_per_polyline - 1] Of Point3D;
  ReadCheck: boolean;

Label
  vertex_overflow;

Begin
  ent.OCS_Z := WCS_Z;
  ReadCheck := false;
  Vertices := 0;

  //initialize bulge value
  For i := 0 To max_vertices_per_polyline - 1 Do
  Begin
    tempfv[i].X := 0;
    tempfv[i].Y := 0;
    tempfv[i].Z := 0;
  End;

  Repeat
    Groupcode := NextGroupCode;
    Case Groupcode Of
      DXF_primary_X: ent.p1.x := Valdbl;
      DXF_primary_Y:
        Begin
          ent.p1.y := Valdbl;
          ReadCheck := true;
        End;
      DXF_primary_Z: ent.p1.z := Valdbl;
      DXF_other_X_1: ent.p2.x := Valdbl;
      DXF_other_Y_1: ent.p2.y := Valdbl;
      DXF_other_Z_1: ent.p2.z := Valdbl;
      DXF_other_X_2: ent.p3.x := Valdbl;
      DXF_other_Y_2: ent.p3.y := Valdbl;
      DXF_other_Z_2: ent.p3.z := Valdbl;
      DXF_other_X_3: ent.p4.x := Valdbl;
      DXF_other_Y_3: ent.p4.y := Valdbl;
      DXF_other_Z_3: ent.p4.z := Valdbl;
      DXF_floatval: ent.rad_hgt := Valdbl;
      DXF_floatvals1: ent.fv1 := Valdbl;
      DXF_floatvals2:
        Begin //get polyline's arc bulge value
          ent.fv2 := Valdbl;
          tempfv[vertices - 1].y := ent.fv2;
        End;
      DXF_floatvals3: ent.fv3 := Valdbl;
      DXF_angle1: ent.angle1 := Valdbl;
      DXF_angle2: ent.angle2 := Valdbl;
      DXF_thickness: ent.thickness := Valdbl;
      DXF_elevation: ent.elev := Valdbl;
      DXF_70Flag: ent.flag_70 := ValInt;
      DXF_71Flag: ent.flag_71 := ValInt;
      DXF_72Flag: ent.flag_72 := ValInt;
      DXF_73Flag: ent.flag_73 := ValInt;
      DXF_74Flag: ent.flag_74 := ValInt;
      DXF_colornum: ent.colour := ValInt;
      DXF_entities_flg: ent.attflag := ValInt;
      DXF_layer_name: ent.layer := ValStr;
      DXF_name: ent.namestr := ValStr;
      DXF_text_def: ent.tagstr := ValStr;
      DXF_text_prompt: ent.promptstr := ValStr;
      DXF_text_style: ent.text_style := valstr;
      DXF_extrusionx: ent.OCS_Z.x := Valdbl;
      DXF_extrusiony: ent.OCS_Z.y := Valdbl;
      DXF_extrusionz: ent.OCS_Z.z := Valdbl;
    End;

    If ReadCheck Then
    Begin
      //99.11.18
      ent.p1.z := ent.elev; //货肺洒 眠啊且 何盒.... lwpolyline狼 绊档蔼
      tempvert[vertices] := ent.p1;
      inc( vertices );
      ReadCheck := false;
    End;
  Until ( ( Groupcode <= 0 ) Or ( vertices >= max_vertices_per_polyline ) ); // end or fault;
  If Groupcode < 0 Then
  Begin
    result := false;
    exit;
  End;
  ent.polypoints := @tempvert[0];
  ent.floatvals := @tempfv[0];
  ent.vertices := vertices;
  go_back_to_last( Groupcode, fline );
  ent.OCS_Z := normalize( ent.OCS_Z ); // for safety
  result := true;
  If vertices >= max_vertices_per_polyline Then
    result := false;
End;

//polyline_arc_end

Function DXF_Reader.read_generic( Var layer: integer ): abstract_entity;
Var
  ent: abstract_entity;
Begin
  result := Nil;
  ent := abstract_entity.Create; // set everything to zero EVERY time

  If read_entity_data( ent ) Then
  Begin
    layer := layer_num( ent.layer );
    If layer < 0 Then
      layer := DXF_Layers.Add( DXF_Layer.Create( ent.layer, 7, ent.LineStyle ) );
    result := ent;
  End
  Else
    ent.free;
End;

{ These ones are straightforward, so we'll use a crafty TClass parameter }

Function DXF_Reader.general_purpose_read( obj_type: TClass; Var entity: DXF_Entity; Var layer: integer ): boolean;
Var
  ent: abstract_entity;
  LS: integer;
Begin
  result := false;
  entity := Nil;
  ent := read_generic( layer );
  // to Match correctly for block's Color
  If ent <> Nil Then
  Begin
    If ( ent.colour = 0 ) And ( layer <> -1 ) Then
      ent.Colour := Dxf_layer( dxf_layers[layer] ).colour;
    If ent.LineStyle = '' Then
      LS := DXF_Layer( DXF_Layers[Layer] ).LineStyle // bylayer
    Else
      LS := AcadLineStyle.FindLineStyle( ent.linestyle );
    With ent Do
    Begin
      If obj_type = Point_ Then
        entity := Point_.Create( OCS_Z, p1, colour )
      Else If obj_type = Text_ Then
      Begin
        count_texts := Count_texts + 1;
        entity := Text_.Create( OCS_Z, p1, p2, angle1, tagstr, text_style, rad_hgt, colour, flag_72 );
      End
      Else If obj_type = Line_ Then
        entity := Line_.Create( p1, p2, colour, LS )
      Else If obj_type = Circle_ Then
        entity := Circle_.Create( OCS_Z, p1, rad_hgt, colour, LS )
      Else If obj_type = Arc_ Then
        entity := Arc_.Create( OCS_Z, p1, rad_hgt, angle1, angle2, colour, LS )
          // face3ds and solids can have 3 or 4 points, if 4=3, then 3 used
      Else If obj_type = Face3D_ Then
      Begin
        If p1_eq_p2_3d( p3, p4 ) Then
          entity := Face3D_.Create( 3, @p1, colour, true, LS )
        Else
          entity := Face3D_.Create( 4, @p1, colour, true, LS )
      End
      Else If obj_type = Solid_ Then
      Begin
        If p1_eq_p2_3d( p3, p4 ) Then
          entity := Solid_.Create( OCS_Z, 3, @p1, colour, thickness, LS )
        Else
          entity := Solid_.Create( OCS_Z, 4, @p1, colour, thickness, LS )
      End
      Else If obj_type = Attdef_ Then
        entity := Attdef_.Create( OCS_Z, p1, p2, angle1,
          namestr, text_style, tagstr, promptstr, flag_70, flag_72, rad_hgt, colour )
      Else If obj_type = Attrib_ Then
        entity := Attrib_.Create( OCS_Z, p1, p2, angle1,
          namestr, text_style, tagstr, flag_70, flag_72, rad_hgt, colour );
    End;
    ent.Free;
    result := true;
  End;
End;

{ INSERTs may have ATTRIBs + BLOCKs which makes it a little more complicated }

Function DXF_Reader.read_insert( Var entity: DXF_Entity; Var layer: integer ): boolean;
Var
  ent, ent2: abstract_entity;
  num: integer;
  atts: Array[0..255] Of Attrib_;

  Function checkblockName( Const blockname: String; bel: DXF_Layer ): boolean;
  Var
    bent: dxf_entity;
    lp0: integer;
  Begin
    result := false;
    If bel <> Nil Then
    Begin
      For lp0 := 0 To bel.entities.Count - 1 Do
      Begin
        bent := bel.entities[lp0];
        If block_( bent ).name = blockname Then
        Begin
          result := true;
          break;
        End;
      End;
    End;
  End;

Begin
  result := true;
  entity := Nil;
  num := 0;
  ent := read_generic( layer );
  If ent <> Nil Then
  Begin
    If ent.attflag = 1 Then
    Begin
      Repeat
        result := ( Nextgroupcode = 0 );
        If result And ( ValStr = 'ATTRIB' ) Then
        Begin
          ent2 := read_generic( layer );
          If ent2 <> Nil Then
            With ent2 Do
            Begin
              atts[num] := Attrib_.Create( OCS_Z, p1, p2, Angle1,
                namestr, text_style, tagstr, flag_70, flag_72,
                rad_hgt, colour );
              ent2.Free;
              inc( num );
            End
          Else
            result := false;
        End;
      Until ( Not result ) Or ( ValStr = 'SEQEND' );
      If result Then
        Nextgroupcode; // remove the SEQEND put back
    End;

    // if user inserted block which is non exists or reference block,
    //    if ((Checkblockname(ent.namestr, block_list)=false)or(copy(ent.namestr,1,1)='*')) then begin
    If ( ( Checkblockname( ent.namestr, Blocklayer ) = false ) ) Then
    Begin

      Errlist.add( SDXFUndefBlock + inttostr( line_num ) + ' BlockName: ' + ent.namestr );

      Errlist.add( SDXFWrongBlockInfo );
      Errlist.add( '' );
    End
    Else
    Begin

      // if block exists in block list, define block.
      With ent Do
      Begin
        If fv1 = 0 Then
          fv1 := 1;
        If fv2 = 0 Then
          fv2 := 1;
        If fv3 = 0 Then
          fv3 := 1;
        entity := Insert_.Create( OCS_Z, p1, aPoint3D( fv1, fv2, fv3 ), angle1, colour, num, @atts[0], namestr );
        Try
          Insert_( entity ).update_block_links( Blocklayer );
        Except
          dxf_entity( entity ).Free;
          entity := Nil;
          //        raise DXF_read_exception.Create('Cannot reference an undefined BLOCK'+EOL+EOL+
          //        '(File may not have been saved with BLOCKs)'+EOL,line_num);
        End;
      End;
    End;
    ent.Free;

  End
  Else
    result := false;
End;

//polyline_arc_begin

Const
  IC_ZRO = 1.0E-10;

Function ic_atan2( yy, xx: double ): double;
Var
  dexp, inf: integer;
  absxx, absyy, dmin, fd1, fd2: double;
Begin
  dexp := 300;
  dmin := 1.0E-300;
  inf := 0;

  absxx := abs( xx );
  absyy := abs( yy );

  If ( absxx < dmin ) Then
  Begin
    If ( absyy < dmin ) Then
    Begin
      result := 0; //* Should give error, too */
      exit;
    End;
    inf := 1;
  End
  Else If ( absyy >= dmin ) Then
  Begin
    fd1 := log10( absyy );
    fd2 := log10( absxx );
    If ( fd1 - fd2 > dexp ) Then
      inf := 1;
  End;
  If ( inf = 1 ) Then
  Begin
    If yy > 0.0 Then
      result := PI / 2.0
    Else
      result := -PI / 2.0;
    exit;
  End;
  fd1 := arctan( yy / xx );
  If ( xx < 0.0 ) Then
  Begin
    If yy < 0.0 Then
      fd1 := fd1 + -PI