Updated 2010-11-04 10:52:15 by PZ

Here is the script dxf.tcl from Tcad 2.0b : http://www.neosoft.com/tcl/ftparchive/sorted/packages-7.6/graphics/tdcad2.0b/

If the previous link is broken, try this one: ftp://ftp.uni-hannover.de/pub/mirror/tcl/mirror/ftp.procplace.com/alcatel/code/tdcad2.0b.tar.gz

How to validate dxf files?
    # Program: dxf (an autocad's dxf to tk's canvas converter)
    # Author:  Tuan T. Doan
    # Date:    4/20/93
    # ChangeLog:
    # 2010-11-04: Piotr Zaprawa (_arc: wrong angle calc. corr.)
    # =========================================================================
    # Copyright 1993 Tuan T. Doan
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted,
    # provided that the above copyright notice appear in all copies.  Tuan
    # Doan make no representations about the suitability of this software
    # for any purpose.  It is provided "as is" without express or implied
    # warranty.  If you do use any part of the software, I would like to
    # know about it.  Please send me mail at tdoan@bnr.ca
    #
    # DXF format is copyrighted by Autodesk, Inc.
    # =========================================================================
    
    set auto_path ". $auto_path"
    
    set gvar(unit) p
    set gvar(scale) 1.0
    
    proc _gettuple {fd} {
        #  read in two lines; first line = groupcode, second line = groupvalue
        global gvar
        set gvar(groupcode)  [string trim [gets $fd]]
        set gvar(groupvalue) [string trim [gets $fd]]
        #  puts stdout "$gvar(groupcode) $gvar(groupvalue) - " nonewline
    }
    
    proc _circle {fd} {
        #  we already read: 0,CIRCLE  ; continue to read in circle info until see 0
        #  interested in: 10=xcenter, 20=ycenter, 40=radius
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {return "[expr $x-$r]$gvar(unit) [expr $y-$r]$gvar(unit) [expr $x+$r]$gvar(unit) [expr $y+$r]$gvar(unit) -outline black"}
                {10}  {set x $gvar(groupvalue)}
                {20}  {set y [expr {-1 * $gvar(groupvalue)}]}
                {40}  {set r $gvar(groupvalue)}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _line {fd} {
        #  we already read: 0,LINE  ; continue to read in line info until see 0
        #  interested in: 10=xpoint1, 20=ypoint1, 11=xpoint2, 21=ypoint2
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {return "${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) -fill black"}
                {10}  {set x1 $gvar(groupvalue)}
                {20}  {set y1 [expr {-1 * $gvar(groupvalue)}]}
                {11}  {set x2 $gvar(groupvalue)}
                {21}  {set y2 [expr {-1 * $gvar(groupvalue)}]}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    proc _triangle {fd} {
        #  we already read: 0,3DFACE ; continue to read in surface info until see 0
        #  interested in: 10=xpoint1, 20=ypoint1, 11=xpoint2, 21=ypoint2
        #                 12=xpoint3, 22=ypoint3, 13=xpoint3, 23=ypoint3
        #  if last point 3 is same as point 4, we want only points 1-3
        global gvar
        set x1 ""; set x2 ""; set x3 ""; set x4 ""
        set y1 ""; set y2 ""; set y3 ""; set y4 ""
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {if {$x3==$x4 && $y3==$y4} {
                        puts stdout "3dtri"
                        #               return "polygon ${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) -fill white"
                        return "line ${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) -fill black"
                    } else {
                        puts stdout "3dpoly"
                        #               return "polygon ${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) ${x4}$gvar(unit) ${y4}$gvar(unit) -fill white"
                        return "line ${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) ${x4}$gvar(unit) ${y4}$gvar(unit) -fill black"
                    }
                }
                {10}  {set x1 $gvar(groupvalue)}
                {20}  {set y1 [expr {-1 * $gvar(groupvalue)}]}
                {11}  {set x2 $gvar(groupvalue)}
                {21}  {set y2 [expr {-1 * $gvar(groupvalue)}]}
                {12}  {set x3 $gvar(groupvalue)}
                {22}  {set y3 [expr {-1 * $gvar(groupvalue)}]}
                {13}  {set x4 $gvar(groupvalue)}
                {23}  {set y4 [expr {-1 * $gvar(groupvalue)}]}
                {70}  {puts stdout "Invisible edge: $gvar(groupvalue)"}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _arc {fd} {
        #  we already read: 0,ARC ; continue to read in arc info until see 0
        #  interested in: 10=xcenter, 20=ycenter, 40=radius, 50=startangle, 51=endangle
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {
                    while {$ea<$sa} {
                        set ea [expr $ea+360.0]
                    }
                    return "[expr $x-$r]$gvar(unit) [expr $y-$r]$gvar(unit) [expr $x+$r]$gvar(unit) [expr $y+$r]$gvar(unit) -start $sa -extent [expr $ea-$sa] -style arc -fill black"
                }
                {10}  {set x $gvar(groupvalue)}
                {20}  {set y [expr {-1 * $gvar(groupvalue)}]}
                {40}  {set r $gvar(groupvalue)}
                {50}  {set sa $gvar(groupvalue)}
                {51}  {set ea $gvar(groupvalue)}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _trace {fd} {
        #  we already read: 0,TRACE ; continue to read in thick line info until see 0
        #  interested in: 10=xpoint1, 20=ypoint1, 11=xpoint2, 21=ypoint2
        #                 12=xpoint3, 22=ypoint3, 13=xpoint4, 13=ypoint4
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {return "${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) ${x4}$gvar(unit) ${y4}$gvar(unit) -fill black"}
                {10}  {set x1 $gvar(groupvalue)}
                {20}  {set y1 [expr {-1 * $gvar(groupvalue)}]}
                {11}  {set x2 $gvar(groupvalue)}
                {21}  {set y2 [expr {-1 * $gvar(groupvalue)}]}
                {12}  {set x3 $gvar(groupvalue)}
                {22}  {set y3 [expr {-1 * $gvar(groupvalue)}]}
                {13}  {set x4 $gvar(groupvalue)}
                {23}  {set y4 [expr {-1 * $gvar(groupvalue)}]}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _solid {fd} {
        #  we already read: 0,SOLID ; continue to read in triangle or quad until see 0
        #  interested in: 10=xpoint1, 20=ypoint1, 11=xpoint2, 21=ypoint2
        #                 12=xpoint3, 22=ypoint3, 13=xpoint4, 13=ypoint4
        #  if we get only three points, the 4th pts will be the same as the third pts
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {return "${x1}$gvar(unit) ${y1}$gvar(unit) ${x2}$gvar(unit) ${y2}$gvar(unit) ${x3}$gvar(unit) ${y3}$gvar(unit) ${x4}$gvar(unit) ${y4}$gvar(unit) -fill \"\""}
                {10}  {set x1 $gvar(groupvalue)}
                {20}  {set y1 [expr {-1 * $gvar(groupvalue)}]}
                {11}  {set x2 $gvar(groupvalue)}
                {21}  {set y2 [expr {-1 * $gvar(groupvalue)}]}
                {12}  {set x3 $gvar(groupvalue); set x4 $x3}
                {22}  {set y3 [expr {-1 * $gvar(groupvalue)}]; set y4 $y3}
                {13}  {set x4 $gvar(groupvalue)}
                {23}  {set y4 [expr {-1 * $gvar(groupvalue)}]}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _vertex {fd} {
        #  we already read: 0,VERTEX ; continue to read in point info until see 0
        #  interested in: 10=xpoint, 20=ypoint
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {return "${x}$gvar(unit) ${y}$gvar(unit)"}
                {10}  {set x $gvar(groupvalue)}
                {20}  {set y [expr {-1 * $gvar(groupvalue)}]}
                {70}  {puts stdout "vertex flag = $gvar(groupvalue)"}
                {42}  {puts stdout "vertex bludge = $gvar(groupvalue)"}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _conv2rect {coords} {
        #  check to see if the polyline can be converted to a rectangle; this happen
        #  if we get 4 points and polyflag=1 (indicate closed polygon)
        #  if we get 5 points and the 5th point is the same as the 1st point
        global gvar
        if {$gvar(polyflag)=="1" ||
            ([lindex $coords 0]==[lindex $coords 8] &&
            [lindex $coords 1]==[lindex $coords 9])} {
            puts stdout "rect"
            return "rectangle [lindex $coords 0] [lindex $coords 1] [lindex $coords 4] [lindex $coords 5] -fill \"\""
        } else {
            return "line $coords -fill black"
        }
    }
    
    proc _polyline {fd} {
        #  we already read: 0,POLYLINE ; continue to read in points info (0,VERTEX)
        #  until see 0,SEQEND.  if we see groupcode=70 set polyflag to groupvalue so
        #  that we can later determine if polygon is closed
        global gvar
        set result ""
        set np 0
        set gvar(polyflag) ""
        _gettuple $fd
        while {! [eof $fd]} {
            case $gvar(groupcode) in {
                {0}   {case $gvar(groupvalue) in {
                        {VERTEX}  {incr np; append result " [_vertex $fd]"}
                        {SEQEND}  {if {$np<2} {puts stdout "ERROR: no of pts in polyline is $np"; exit 1}
                            _gettuple $fd
                            if {$gvar(polyflag)==1} {
                                return "polygon $result -fill black"
                            } else {
                                if {$np==4 || $np==5} {
                                    return [_conv2rect $result]
                                } else {
                                    return "line $result -fill black"
                                }
                            }
                        }
                    }
                }
                {70}  {set gvar(polyflag) $gvar(groupvalue)
                    puts stdout "polyflag = $gvar(polyflag)"
                    _gettuple $fd}
                {62}  {set gvar(color)  $gvar(groupvalue); _gettuple $fd}
                {40}  {set gvar(swidth) $gvar(groupvalue); _gettuple $fd}
                {41}  {set gvar(ewidth) $gvar(groupvalue); _gettuple $fd}
                {71}  {set gvar(mcount) $gvar(groupvalue); _gettuple $fd}
                {72}  {set gvar(ncount) $gvar(groupvalue); _gettuple $fd}
                {73}  {set gvar(mdensity) $gvar(groupvalue); _gettuple $fd}
                {74}  {set gvar(ndensity) $gvar(groupvalue); _gettuple $fd}
                default {_gettuple $fd}
            }
        }
    }
    
    proc _text {fd} {
        #  we already read: 0,TEXT ; continue to read in text info
        #  interested in: 10=xpos, 20=ypos, 1=textstring
        global gvar
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}   {
                    if {$x=="0." && $y=="-1.5"} {
                        return "${x}$gvar(unit) ${y}$gvar(unit) -text \"$t\" -fill black"
                    } else {
                        return "${x}$gvar(unit) ${y}$gvar(unit) -text \"$t\" -fill black"
                    }
                }
                {10}  {set x $gvar(groupvalue)}
                {20}  {set y [expr {-1 * $gvar(groupvalue)}]}
                {1}   {set t $gvar(groupvalue)}
                {40}  {set h $gvar(groupvalue)}
                {50}  {set ra $gvar(groupvalue)}
                {51}  {set oa $gvar(groupvalue)}
                {62}  {set gvar(color) $gvar(groupvalue)}
            }
        }
    } 
    
    proc _insert {fd} {
        #  we already read: 0,INSERT ; continue to read in info on what and where to
        #  insert.  each block to be inserted will be encapsulated in a list consisting
        #  of: {block_name xpos ypos xscale yscale angle attr}
        #  currently only interested in:  block_name, xpos, ypos, xscale, yscale
        global gvar
        set bname "";set x "";set y "";set sx 1.;set sy 1.;set ra 0;set attr 0
        while {! [eof $fd]} {
            _gettuple $fd
            case $gvar(groupcode) in {
                {0}  {return [list $bname $x $y $sx $sy $ra $attr]}
                {66} {set attr $gvar(groupvalue)}
                {2}  {set bname $gvar(groupvalue)}
                {10} {set x $gvar(groupvalue)}
                {20} {set y [expr {-1 * $gvar(groupvalue)}]}
                {41} {set sx $gvar(groupvalue)}
                {42} {set sy $gvar(groupvalue)}
                {50} {set ra $gvar(groupvalue)}
                {62} {set gvar(color) $gvar(groupvalue)}
            }
        }
    }
    
    proc _insertblock {{parent}} {
        #  the data for block (grouped-data) are stored in the global array 'block'.
        #  the block name is used as index to 'block' and 'binsert' array.  the
        #  'binsert' array is use to store list of block name associated with that
        #  block.  yep, blocks can be nested.  this procedure will extract and display
        #  the block in a canvas.
        #  example:  block(table1)={{line ...} {circle ...} {text ...} ...}
        #            binsert(table1)={{leg 5 15 .4 .5 0 0} {leg 15 15 .4 .5 0 0} ...}
        #            binsert(leg)={{line ...} {line ...} ...}
        global block binsert
        foreach j $binsert($parent) {
            set n  [lindex $j 0]
            set x  [lindex $j 1]
            set y  [lindex $j 2]
            set sx [lindex $j 3]
            if {$sx < 0.0} {set sx [expr "-1 * $sx"]; puts stdout "-XSCALE"}
            set sy [lindex $j 4]
            if {$sy < 0.0} {set sy [expr "-1 * $sy"]; puts stdout "-YSCALE"}
            if {! [info exists binsert($n)]} {puts stdout "? $j"; return}
            if {$binsert($n)==""} {
                foreach i $block($n) {
                    eval ".c.c create $i -tags \"$parent $parent:insert\""
                    .c.c scale $parent:insert 0.0 0.0 $sx $sy
                    .c.c move $parent:insert $x $y
                    #           .c.c coords $parent:insert $x $y
                }
            } else {
                _insertblock $n
            }
        }
    }
    
    proc _getelement {fd} {
        #  check to see if the already read groupcode,groupvalue is one of the elements
        #  we want to handle.  if we get a 0,VERTEX outside POLYLINE or 0,POINT  we
        #  do a very small circle (OVAL x1 y1 x1 y1).  currently this is used to get
        #  elements in the block.  the only way that this procedure will return is that
        #  it must encounter one of the listed elements.
        global gvar
        while {! [eof $fd]} {
            #     puts stdout "$gvar(groupcode) $gvar(groupvalue)"
            case $gvar(groupcode) in {
                {0}  {case $gvar(groupvalue) in {
                        {LINE}      {return "line [_line $fd]"}
                        {3DLINE}    {return "line [_line $fd]"}
                        {CIRCLE}    {return "oval [_circle $fd]"}
                        {ARC}       {return "arc [_arc $fd]"}
                        {3DFACE}    {return "[_triangle $fd]"}
                        {POLYLINE}  {return "[_polyline $fd]"}
                        {TRACE}     {return "line [_trace $fd]"}
                        {SOLID}     {return "polygon [_solid $fd]"}
                        {POINT}     {set t1 [_vertex $fd]; return "oval $t1 $t1"}
                        {VERTEX}    {set t1 [_vertex $fd]; return "oval $t1 $t1"}
                        {TEXT}      {return "text [_text $fd]"}
                        default     {_gettuple $fd}
                    }
                }
                default {_gettuple $fd}
            }
        }
    }
    
    proc _block {fd} {
        #  we already read: 0,BLOCK ; continue to read in info until 0,ENDBLK
        #  if we see 2,?  it means this is the name of this block
        #  if we see 0,INSERT then build the binsert appropriately
        #  if we see 0,? then extract the element by calling _getelement and add it to
        #  the list to be returned.
        #  if we see 0,ENDBLK we set the global variables: block and binsert
        #  binsert could be an empty list if there is no nested block(s)
        global gvar block binsert
        set r1 {}
        set r2 {}
        _gettuple $fd
        while {! [eof $fd]} {
            #     puts stdout "$gvar(groupcode) $gvar(groupvalue)"
            if {$gvar(groupcode)=="0" && \
                        $gvar(groupvalue)=="INSERT"} {lappend r2 [_insert $fd]}
            case $gvar(groupcode) in {
                {0}  {case $gvar(groupvalue) in {
                        {ENDBLK} {set block($t1) $r1
                            set binsert($t1) $r2
                            #                     puts stdout block($t1)
                            return $t1}
                        default  {lappend r1 [_getelement $fd]}
                    }
                }
                {70} {_gettuple $fd}
                {2}  {set t1 $gvar(groupvalue); set binsert($t1) {}; set r2 {}; _gettuple $fd}
                default {_gettuple $fd}
            }
        }
    }
    
    proc _entities {fd} {
        #  we already read: 0,ENTITIES ; continue to read in info until 0,ENDSEC
        #
        global gvar binsert
        set binsert(main) {}
        _gettuple $fd
        while {! [eof $fd]} {
            #     puts stdout "$gvar(groupcode) $gvar(groupvalue)"
            if {$gvar(groupcode)=="0" && $gvar(groupvalue)=="INSERT"} {
                lappend binsert(main) [_insert $fd]
                #        set binsert(main) [list [_insert $fd]]
                #        _insertblock main
            }
            case $gvar(groupcode) in {
                {0}  {case $gvar(groupvalue) in {
                        {ENDSEC}    {return}
                        {LINE}      {set t5 ".c.c create line [_line $fd]"
                            eval "$t5 -tags obj"
                        }
                        {3DLINE}    {set t5 ".c.c create line [_line $fd]"
                            eval "$t5 -tags obj"
                        }
                        {CIRCLE}    {set t5 ".c.c create oval [_circle $fd]"
                            eval "$t5 -tags obj"
                        }
                        {ARC}       {set t5 ".c.c create arc [_arc $fd]"
                            eval "$t5 -tags obj"
                        }
                        {TRACE}     {set t5 ".c.c create line [_trace $fd]"
                            eval "$t5 -tags obj"
                        }
                        {SOLID}     {set t5 ".c.c create polygon [_solid $fd]"
                            eval "$t5 -tags obj"
                        }
                        {POINT}     {set p1 [_vertex $fd]
                            set t5 ".c.c create oval $p1 $p1"
                            eval "$t5 -tags obj"
                        }
                        {VERTEX}    {set p1 [_vertex $fd]
                            set t5 ".c.c create oval $p1 $p1"
                            eval "$t5 -tags obj"
                        }
                        {3DFACE}    {set t5 ".c.c create [_triangle $fd]"
                            eval "$t5 -tags obj"
                        }
                        {POLYLINE}  {set t5 ".c.c create [_polyline $fd]"
                            eval "$t5 -tags obj"
                        }
                        {TEXT}      {set t5 ".c.c create text [_text $fd]"
                            eval "$t5 -tags obj"
                        }
                        default {_gettuple $fd}
                    }
                }
                default {_gettuple $fd}
            }
        }
    }
    
    proc _drawblock {} {
        global gvar block binsert
        .c.c delete all
        set node [.l.list get [.l.list curselection]]
        puts stdout "$node: $binsert($node)"
        foreach i $block($node) {
            #     puts stdout "   $i"
            eval ".c.c create $i -tags $node"
        }
        if {$binsert($node)!=""} {_insertblock $node}
    }
    
    proc _rscale {sr} {
        global gvar
        puts stderr "SCALING: $sr - $gvar(scale)"
        .c.c scale all 0.0 0.0 $sr $sr
        set gvar(scale) [expr $gvar(scale) * $sr]
        set t1 "[.c.c bbox all]"
        if {$t1!=""} {.c.c configure -scrollregion "$t1"}
    }
    
    proc _dumpobj {c tag} {
        global argv
        set fname [file root [file tail $argv]]
        set fd [open $fname.tkobj w+]
        foreach j [$c find withtag $tag] {
            set opt {}
            foreach i [$c itemconfig $j] {
                if {[llength $i]==5 && [lindex $i 3]!=[lindex $i 4]} {
                    lappend opt [lindex $i 0]
                    lappend opt [lindex $i 4]
                }
            }
            set t1 [concat "$c create [$c type $j]" [$c coords $j] $opt]
            puts $fd "$t1"
            lappend result $t1
        }
        close $fd
    }
    
    wm minsize . 100 100
    frame .c
    canvas    .c.c -scrollregion "-800 -600 700 600" \
            -xscrollcommand ".c.hs set" -yscrollcommand ".c.vs set"
    scrollbar .c.vs -relief sunken -command ".c.c yview"
    scrollbar .c.hs -relief sunken -orient horiz -command ".c.c xview"
    pack append  .c .c.hs {bottom fillx} \
            .c.vs {right filly} \
            .c.c  {expand fill}
    
    frame .l
    listbox   .l.list -relief sunken -xscrollcommand ".l.hs set" -yscrollcommand ".l.vs set" \
            -export 0
    bind .l.list <Double-Button-1> "_drawblock"
    scrollbar .l.hs -command ".l.list xview" -orient horiz -relief sunken
    scrollbar .l.vs -command ".l.list yview" -relief sunken
    pack append .l .l.vs {right filly} \
            .l.hs {bottom fillx} \
            .l.list {left fill expand} \
            
    frame .s
    scale .s.sr -label "SCALE" -from 1 -to 100 -orient horiz \
            -command "_rscale"
    pack append .s .s.sr {top fillx}
    
    frame .com
    button .com.b1 -bd 5 -text "PRINT" -command "_canvasprint .c.c"
    button .com.b2 -bd 5 -text "DUMP"  -command "_dumpobj .c.c all"
    button .com.b3 -bd 5 -text "QUIT"  -command "destroy ."
    button .com.b4 -bd 5 -text "NORMAL" -command {_rscale [expr 1.0/$gvar(scale)]}
    pack append .com .com.b4 {left expand fillx} \
            .com.b1 {left expand fillx} \
            .com.b2 {left expand fillx} \
            .com.b3 {left expand fillx}
    
    pack append  . .c   {fill expand} \
            .l   {fill} \
            .s   {fill} \
            .com {fillx}
    
    set gvar(section) 0
    
    set fd [open "$argv" r]
    set gvar(lineno) 1
    set noblock 0
    while {! [eof $fd]} {
        _gettuple $fd
        case $gvar(groupcode) in {
            {0}  {case $gvar(groupvalue) in {
                    {BLOCK}     {set t1 [_block $fd]
                        .l.list insert end $t1
                        puts stdout "$t1: $binsert($t1)"
                        incr noblock
                        #                     if {$noblock>5} {break}
                    }
                }
            }
            {2}  {case $gvar(groupvalue) in {
                    {ENTITIES}  {_entities $fd; _insertblock main}
                    {HEADER TABLES BLOCKS ENTITIES} {set gvar(sname) $gvar(groupvalue)}
                }
            }
        }
    }
    close $fd
    
    #foreach i [array names block] {
    #   if {$binsert($i)!=""} {_insertblock $i}
    #}