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.
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
}
}
}
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
}
}| enter categories here |
|---|