JBR - March 2009
Here is a very simple namespace of commands to write ASCII CAD DXF files. When building a structured output file I like the technique of nesting code in the same way as the output file sections. I used the same method in Using Perl to get Excel, but the code there is woefully out of date. Here is another snippet to write c39 barcode in dxf.
This example is pared down from my actual application:
dxf::write stdout {
dxf::code 999 "Mask to DXF"
dxf::section HEADER {
dxf::code 9 \$ACADVER 1 AC1006
dxf::code 9 \$INSBASE 10 0.0 20 0.0 30 0.0
dxf::code 9 \$EXTMIN 10 $XMIN 20 $YMAX
dxf::code 9 \$EXTMAX 10 $XMAX 20 $YMAX
dxf::code 9 \$LIMMIN 10 $XMIN 20 $YMAX
dxf::code 9 \$LIMMAX 10 $XMAX 20 $YMAX
}
dxf::section TABLES {
dxf::table LTYPE 2 {
dxf::ltype 0
}
dxf::table LAYER 5 {
dxf::layer 0
dxf::layer label 0 green
dxf::layer holes 0 cyan
dxf::layer outline 0 blue
dxf::layer slits 0 red
}
}
dxf::section ENTITIES {
dxf::set-ltype 0
dxf::set-layer slits
dxf::rect 1 2 3 4
}
}
}
DXF library Code:
namespace eval dxf {
variable colors
variable ltype 0
variable layer 0
variable file
array set colors {
red 1
yellow 2
green 3
cyan 4
blue 5
magenta 6
black 7
gray 8
lt-gray 9
}
proc code { args } {
variable file
foreach { code value } $args { puts $file "[format %3d $code]\n$value" }
}
proc write { f body } {
variable file $f
uplevel $body
code 0 EOF
}
proc section { name body } {
code 0 SECTION 2 $name
uplevel $body
code 0 ENDSEC
}
proc table { type max body } {
code 0 TABLE 2 $type 70 $max
uplevel $body
code 0 ENDTAB
}
proc ltype { name { flags 0 } } {
code 0 LTYPE 2 $name
code 70 $flags 3 $name 72 65 73 0 40 0.0000
}
proc layer { { name 0 } { flags 0 } { color 7 } { ltype 0 } } {
catch { set color [set ::dxf::colors($color)] }
code 0 LAYER 2 $name
code 70 $flags 6 $ltype 62 $color
}
proc set-layer { l } { variable layer; set layer $l }
proc set-ltype { l } { variable ltype; set ltype $l }
proc item { item args } {
variable layer
variable ltype
code 0 $item 8 $layer 6 $ltype {*}$args
}
proc line { x1 y1 x2 y2 } { item LINE 10 $x1 20 $y1 11 $x2 21 $y2 }
proc text { x y text { height .5 } } { item TEXT 10 $x 20 $y 40 $height 1 $text }
proc circ { x y r } { item CIRCLE 10 $x 20 $y 40 $r }
proc solid { x1 y1 x2 y2 x3 y3 x4 y4 } {
item SOLID 10 $x1 20 $y1 11 $x2 21 $y2
code 12 $x4 22 $y4
code 13 $x3 23 $y3
}
proc solidbox { x1 y1 x2 y2 { color 256 } } {
solid $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1
}
proc polyline { args } {
set x0 [lindex $args 0]
set y0 [lindex $args 1]
foreach { x y } [lrange $args 2 end] {
line $x0 $y0 $x $y
set x0 $x
set y0 $y
}
}
proc polygon { args } {
polyline {*}$args [lindex $args 0] [lindex $args 1]
}
proc box { x1 y1 x2 y2 } {
polygon $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1
}
proc rect { x y w h { t 0 } { o 0 } } {
set sin_t [expr sin($t * (3.14159265358979323846 * 2 / 360))]
set cos_t [expr cos($t * (3.14159265358979323846 * 2 / 360))]
set wdx [expr $w / 2.0 * $cos_t]
set wdy [expr $w / 2.0 * $sin_t]
set hdx [expr $h / 2.0 * $sin_t]
set hdy [expr $h / 2.0 * $cos_t]
set odx [expr $o * $sin_t]
set ody [expr $o * $cos_t]
set x1 [expr $x - $wdx - $hdx - $odx]
set y1 [expr $y - $wdy + $hdy - $ody]
set x2 [expr $x - $wdx + $hdx + $odx]
set y2 [expr $y - $wdy - $hdy + $ody]
set x3 [expr $x + $wdx + $hdx + $odx]
set y3 [expr $y + $wdy - $hdy + $ody]
set x4 [expr $x + $wdx - $hdx - $odx]
set y4 [expr $y + $wdy + $hdy - $ody]
polygon $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4
}
}LWS - 2021-06-25 23:10:59
This piece of code has really helped me out: thanks! I used documentation at this link to fill in a few of my knowledge gaps.