cad4tcl Examples
prototype Example
This example is available in the package directory: .../test/cad4tcl___test_00.tcl
cad4tcl: prototype script
########################################################################
#
# cad4tcl___test_00.tcl
# by Manfred ROSENBERGER
#
# (c) Manfred ROSENBERGER 2018/07/04
#
#
set TEST_ROOT_Dir [file normalize [file dirname [lindex $argv0]]]
#
set TEST_Library_Dir [file dirname [file dirname $TEST_ROOT_Dir]]
#
set TEST_Sample_Dir [file join $TEST_ROOT_Dir _sample]
#
set TEST_Export_Dir [file join $TEST_ROOT_Dir _export]
#
#
puts " -> \$TEST_ROOT_Dir ...... $TEST_ROOT_Dir"
puts " -> \$TEST_Library_Dir ... $TEST_Library_Dir"
puts " -> \$TEST_Sample_Dir .... $TEST_Sample_Dir"
puts " -> \$TEST_Export_Dir .... $TEST_Export_Dir"
#
#
lappend auto_path [file dirname $TEST_ROOT_Dir]
lappend auto_path "$TEST_Library_Dir"
lappend auto_path [file join $TEST_Library_Dir __ext_Libraries]
#
foreach dir $tcl_library {
puts " -> tcl_library $dir"
}
#
foreach dir $auto_path {
puts " -> auto_path $dir"
}
#
#
package require Tk
package require cad4tcl 0.07
#
#
# cad4tcl::canvasType
# ... 1 use tkpath if available
# ... 0 use tk::canvas, dont search for tkpath
#
set cad4tcl::canvasType 1
#
#
set cvObject [cad4tcl::new . 800 600 A4 1.0 30]
set cv_scale [$cvObject configure Canvas Scale]
#
puts " -> \$cvObject $cvObject"
puts " -> \$cv_scale $cv_scale"
#
#
frame .bf
pack .bf -fill x
#
#
button .bf.btFit -text "fit" -width 10 -command [list fit_Board]
pack .bf.btFit -side left
proc fit_Board {} {
variable cvObject
variable cv_scale
puts "-> fit_Board: $cvObject "
puts " -> cv_scale: $cv_scale"
set cv_scale [$cvObject fit]
}
#
button .bf.btScale- -text "scale -" -width 10 -command [list scale_Board 0.5]
pack .bf.btScale- -side left
button .bf.btScale+ -text "scale +" -width 10 -command [list scale_Board 2.0]
pack .bf.btScale+ -side left
proc scale_Board {scale} {
variable cvObject
variable cv_scale
set cv_Scale [$cvObject configure Canvas Scale]
puts " -> scale_Board: $cvObject"
puts " -> cv_scale: $cv_scale"
set cv_scale [$cvObject center [expr {$scale * $cv_scale}]]
}
#
button .bf.btCreate -text "create Content" -width 15 -command [list create_Content]
pack .bf.btCreate -side left
proc create_Content {} {
variable cvObject
variable cv_scale
puts " -> create_Content: $cvObject"
puts " -> cv_scale: $cv_scale"
#
# $cvObject deleteContent
#
set systemTime [clock seconds]
set timeString [clock format $systemTime -format {%Y.%d.%m %H:%M:%S}]
set description [package versions cad4tcl]
#
$cvObject create draftFrame \
{} \
-label "cad4tcl___test_00" \
-title "Drafting Frame" \
-date $timeString \
-descr $description
#
$cvObject create circle \
{30 175} \
-tags {circle_01} \
-radius 10 \
-fill lightgray \
-outline red
$cvObject create oval \
{60 185 100 165} \
-tags {oval_01} \
-fill lightgray \
-outline red
#
$cvObject create rectangle \
{20 125 100 155} \
-tags {rectangle_01} \
-fill lightgray \
-outline red
#
$cvObject create polygon \
{ 20 90 50 90 90 100 90 110 50 110 35 105 20 105} \
-tags {polygon_01} \
-fill lightgray \
-outline red
$cvObject create polyline \
{110 80 140 80 180 90 180 100 130 100 125 95 110 95} \
-tags {line_01} \
-fill lightgray \
-outline blue
$cvObject create line \
{200 70 230 70 270 80 270 90 220 90 215 85 200 85} \
-tags {line_02} \
-fill lightgray \
-outline orange
#
$cvObject create centerLine \
{120 130 170 130 260 100} \
-tags {centerLine_01} \
-outline blue
#
#
$cvObject create vectorText \
{20 50} \
-text "vectorText abcdefghijklmnopqrstuvexyz 0123456789 °" \
-tags {vectorText_01}
$cvObject create vectorText \
{20 40} \
-text "vectorText ABCDEFGHIJKLMNOPQRSTUVEXYZ 0123456789 °" \
-tags {vectorText_02}
#
$cvObject create circle \
{150 150} \
-tags {dim_01} \
-radius 1 \
-fill lightgray \
-outline red
$cvObject create circle \
{130 170} \
-tags {dim_01} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create circle \
{165 165} \
-tags {dim_01} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create line \
{130 170 150 150 165 165} \
-tags {dim_01} \
-fill lightgray \
-outline gray20 \
-width 0.75
$cvObject create dimensionAngle \
{{150 150} {165 165} {130 170}} \
40 \
0 \
darkred
#
#
$cvObject create circle \
{225 140} \
-tags {dim_02} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create circle \
{200 155} \
-tags {dim_02} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create line \
{225 140 200 155} \
-tags {dim_02} \
-fill lightgray \
-outline gray20 \
-width 0.75
$cvObject create dimensionLength \
{{225 140} {200 155}} \
horizontal \
35 \
0 \
darkblue
$cvObject create dimensionLength \
{{200 155} {225 140}} \
vertical \
10 \
0 \
darkblue
#
$cvObject create circle \
{275 130} \
-tags {dim_03} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create circle \
{250 145} \
-tags {dim_03} \
-radius 0.75 \
-fill lightgray \
-outline red
$cvObject create line \
{275 130 250 145} \
-tags {dim_03} \
-fill lightgray \
-outline gray20 \
-width 0.75
$cvObject create dimensionLength \
{{275 130} {250 145}} \
aligned \
20 \
0 \
darkorange
$cvObject create dimensionRadius \
{{275 130} {250 145}} \
45 \
0 \
darkgreen
#
}
#
button .bf.btClear -text "delete Content" -width 15 -command [list $cvObject deleteContent]
pack .bf.btClear -side left
#
#
button .bf.btImpSVG -text "import SVG" -width 10 -command [list importSVG {145 105}]
pack .bf.btImpSVG -side left
proc importSVG {{pos {}} {angle 0}} {
variable cvObject
variable cv_scale
variable TEST_Sample_Dir
puts " -> create_Content: $cvObject"
puts " -> cv_scale: $cv_scale"
set fileName [tk_getOpenFile -initialdir $TEST_Sample_Dir]
if {$pos eq {}} {
set pos {0 0}
}
if {$fileName eq {}} {
return
} else {
puts " ... $fileName"
}
set dragObj [$cvObject create svg $pos -svgFile $fileName -angle $angle]
puts " -> \$dragObj $dragObj"
$cvObject registerDragObject $dragObj [list [namespace current]::reportDragObject]
}
proc reportDragObject {args} {
# puts " -> reportDragObject: $args"
}
#
button .bf.btExpSVG -text "export SVG" -width 10 -command [list exportSVG]
pack .bf.btExpSVG -side left
proc exportSVG {} {
variable cvObject
variable TEST_Export_Dir
set exportFile [file join $TEST_Export_Dir _test_00.svg]
$cvObject export SVG $exportFile
tk_messageBox -message "cad4tcl: content exported to: \n $exportFile"
}
#
provided Tests
Please check the package directory of cad4tcl. Here you will find a directory test.
This directory contains test scripts and svg-example-files in several directories.
Feel free to dive into cad4tcl ...
cad4tcl
├───pkgIndex.tcl ......... package cad4tcl
├───cad4tcl.tcl .......... package cad4tcl
├───app
│ ├───etc
│ │ └───icon
│ ├───simplifySVG
│ └───viewSVG
├───etc
├───font
├───image
├───lib
├───svg
└───test
├───etc
├───_export
├───_sample
├───app_simplifySVG.tcl
├───cad4tcl__030_items_00.tcl
├───cad4tcl_ChainWheel.tcl
├───cad4tcl_Dimension.tcl
├───cad4tcl_dragObject.tcl
├───cad4tcl_StageContent.tcl
├───test_Env.tcl
├───tkcanvas_dash.tcl
└───tkpcanvas_dash.tcl