0025570: New Tcl sample scripts created for CAD Assistant

Three new sample scripts created during development of CAD Assistant for Android added in samples/tcl:

- Penrose.tcl: creation of Penrose triangle made of boxes resembling ones from OCC logo
- pencil.tcl: creation of colored pencil model
- snowflake.tcl: creation of 2d drawing of snowflake

samples/tcl/Penrose.tcl

@@ -0,0 +1,85 @@
+# Generate set of boxes resembling OCC logo and arranged in the shape of 
+# Penrose triangle on perspective view.
+# The sample shows how the viewer can be manipulated to produce required 
+# visual effect
+
+#Category: Visualization
+#Title: Penrose triangle on perspective view
+
+pload MODELING VISUALIZATION 
+
+# procedure to define box dimensions
+set scale 1.
+set ratio 0.94
+proc defbox {} { 
+  global scale ratio
+  set scale [expr $scale * $ratio]
+  return [list 1.8*$scale 1.8*$scale 1.3*$scale]
+}
+
+# make set of boxes
+eval box b1 0 0 0 [defbox] 
+eval box b2 2 0 0 [defbox]
+eval box b3 4 0 0 [defbox] 
+eval box b4 6 0 0 [defbox] 
+eval box b5 6 -1.5 0 [defbox] 
+eval box b6 6 -3 0 [defbox] 
+eval box b7 6 -4.5 0 [defbox] 
+eval box b8 6 -6 0 [defbox] 
+eval box b9 6 -6 1 [defbox]
+eval box b10 6 -6 2 [defbox]
+
+# cut last box by prisms created from the first two to make impression
+# that it is overlapped by these on selected view (see vviewparams below)
+explode b1 f
+explode b2 f
+prism p0 b1_5 12.3 -14 6.8
+bcut bx b10 p0
+prism p1 b2_3 12 -14 6.8
+bcut bxx bx p1
+tcopy bxx b10
+
+# make some boxes hollow
+for {set i 1} {$i <= 1} {incr i} {
+  set dim [boundingstr b$i]
+  set dx [expr [lindex $dim 3] - [lindex $dim 0]]
+  set x1 [expr [lindex $dim 0] + 0.1 * $dx]
+  set x2 [expr [lindex $dim 1] + 0.1 * $dx]
+  set x3 [expr [lindex $dim 2] + 0.1 * $dx]
+  box bc $x1 $x2 $x3 0.8*$dx 0.8*$dx $dx
+  bcut bb b$i bc
+  tcopy bb b$i
+}
+
+# prepare a view
+vinit Penrose w=1024 h=512
+vsetcolorbg 255 255 255
+vrenderparams -rayTrace -fsaa on -reflections off -shadows off
+
+# set camera position and adjust lights
+vcamera -persp -fovy 25
+vviewparams -eye 14 -14 6.8 -up 0 0 1 -at 4 -4 0 -scale 70
+vsetdispmode 1
+vlight def
+vlight add directional direction 1 -2 -10 head 1 color white
+vlight add directional direction 0 -10 0 head 1 color white
+
+# display boxes
+vdisplay b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
+
+# set colors like in boxes of on OCC logo
+vsetcolor b1 0.8671875 0 0.16015625
+vsetcolor b2 0.96484375 0.8671875 0
+vsetcolor b3 0.609375 0.97734375 0.09375
+vsetcolor b4 0.90234375 0 0.48046875
+vsetcolor b5 0 0.48046875 0.73828125
+vsetcolor b6 0.578125 0 0.48046875
+vsetcolor b7 0.93359375 0.609375 0
+vsetcolor b8 0 0.70703125 0.9296875
+vsetcolor b9 0 0.64453125 0.48046875
+vsetcolor b10 0 0.48046875 0.73828125
+
+# set material to plastic for better look
+for {set i 1} {$i <= 10} {incr i} {vsetmaterial b$i plastic}
+
+vdrawtext "Which\nbox\nis\ncloser\nto\nyou?" 0 -6 -2 0 0 0 left top 0 0 40  Bold

samples/tcl/pencil.tcl

@@ -0,0 +1,64 @@
+# Sample demonstrating assignment of colors to faces in XDE
+
+#Category: Data Exchange
+#Title: Assignment of colors to faces
+
+pload MODELING VISUALIZATION OCAF XDE
+
+box b 0 -20 -10 100 40 20
+compound b b b a
+explode a
+trotate a_1 0 0 0 1 0 0 60
+trotate a_2 0 0 0 1 0 0 -60
+bcommon b a a_1
+bcommon b b a_2
+
+pcylinder c 4 100
+trotate c 0 0 0 0 1 0 90
+
+psphere s 1.4
+ttranslate s 99.2 0 0
+bfuse cx c s
+
+pcone e 60 0.5 101
+trotate e 0 0 0 0 1 0 90
+
+bcommon body b e
+bcut body body c
+bcommon core cx e
+
+text2brep text "CAD Assistant" Times 10
+ttranslate text 10 -4 10
+prism tr text 0 0 -1
+bfuse body body tr
+
+donly body core
+
+#vdisplay body core
+#vsetcolor body yellow
+#vsetcolor core red
+
+explode body so
+explode body_1 f
+explode core so
+
+NewDocument D
+XAddShape D body_1
+XAddShape D core_1
+
+#XSetColor D body_1   0. 0. 1.
+for {set i 1} {$i <= 26} {incr i} {XSetColor D body_1_$i 0. 0. 1.}
+XSetColor D body_1_1 0.9 0.5 0.4
+XSetColor D body_1_9 0.9 0.5 0.4
+for {set i 10} {$i <= 22} {incr i} {XSetColor D body_1_$i 0.6 0.7 0.0}
+XSetColor D core_1 0.1 0.1 1.
+foreach ff [explode core_1 f] { XSetColor D $ff 0.1 0.1 1. ; puts "set color $ff" }
+
+XShow D
+
+vfit
+vsetdispmode 1
+vsetcolorbg 255 255 255
+
+#param write.iges.brep.mode 1
+#WriteIges D d:/pencil3.igs

samples/tcl/snowflake.tcl

@@ -0,0 +1,130 @@
+# Creation of 2d drawing
+
+#Category: Modeling 
+#Title: Snowflake - creation of 2d geometry
+
+pload MODELING AISV
+
+# make circular elements
+circle c11 5 5 0 5
+circle c12 5 5 0 3
+circle c21 18 7 0 7
+circle c22 18 7 0 5
+circle c31 28.5 5 0 5
+circle c32 28.5 5 0 3
+trim c21 c21 pi/4 -pi/4
+trim c22 c22 pi/4 -pi/4
+trim c31 c31 pi/4 -pi/4
+trim c32 c32 pi/4 -pi/4
+line l21 18 7 0 1 1 0
+line l22 18 7 0 1 -1 0
+line l31 28.5 5 0 1 1 0
+line l32 28.5 5 0 1 -1 0
+trim l21 l21 5 7
+trim l22 l22 5 7
+trim l31 l31 3 5
+trim l32 l32 3 5
+line l1 -6 0 0 0.86602540378443864 0.5 0
+line l2 -6 1 0 1 0 0
+trim l1 l1 0 30
+trim l2 l2 0 45
+mkedge c11 c11
+mkedge c12 c12
+mkedge c21 c21
+mkedge c22 c22
+mkedge c31 c31
+mkedge c32 c32
+mkedge l21 l21
+mkedge l22 l22
+mkedge l31 l31
+mkedge l32 l32
+mkedge l1 l1
+mkedge l2 l2
+wire b11 c11
+wire b12 c12
+orientation b12 R
+
+# build one ray
+plane p -6 0 0 0 0 1
+mkface f1 p b11
+add b12 f1
+wire b2 c21 l21 c22 l22
+mkface f2 p b2
+wire b3 c31 l31 c32 l32
+mkface f3 p b3
+prism f5 l1 -5 8.6602540378443864 0
+prism f4 l2 0 -1 0
+compound f1 f2 f3 bc
+bfuse r bc f4
+explode r Sh
+renamevar r_1 r
+bcut r r f5
+explode r Sh
+renamevar r_1 r
+explode r e
+wire w r_4 r_1 r_7 r_8 r_9 r_10 r_11 r_12 r_13 r_14 r_22 r_23 r_24 r_25 r_19 r_20 r_21 r_26 r_35 r_31 r_32 r_33 r_34 r_36 r_37
+tcopy w w1
+tmirror w1 -6 0 0 0 1 0
+wire w w w1
+mkface w p w
+donly w
+
+# construct complete snowflake
+tcopy w w1
+tcopy w w2
+tcopy w w3
+tcopy w w4
+tcopy w w5
+trotate w1 -6 0 0 0 0 1 60
+trotate w2 -6 0 0 0 0 1 120
+trotate w3 -6 0 0 0 0 1 180
+trotate w4 -6 0 0 0 0 1 240
+trotate w5 -6 0 0 0 0 1 300
+bfuse w w w1
+bfuse w w w2
+bfuse w w w3
+bfuse w w w4
+bfuse w w w5
+unifysamedom r w
+
+# keep only wires in compound
+eval compound [explode r w] snowflake
+tscale snowflake -6 0 0 1.5
+
+# draw frame loosely following GOST 2.104-68
+polyline frame -100 -100 0 172 -100 0 172 100 0 -100 100 0 -100 -100 0
+polyline t1 52 -100 0 52 -45 0 172 -45 0
+polyline t2 52 -60 0 172 -60 0
+polyline t3 52 -85  0 172 -85 0
+polyline t4 122 -100 0 122 -60 0
+polyline t5 122 -80 0 172 -80 0
+polyline t6 122 -65 0 172 -65 0
+polyline t7 142 -80 0 142 -85 0
+polyline t8 137 -80 0 137 -60 0
+polyline t9 154 -80 0 154 -60 0
+compound frame t1 t2 t3 t4 t5 t6 t7 t8 t9 lines
+
+# add text
+text2brep sample "SAMPLE" Arial 10 x=90 y=-55 bolditalic
+text2brep occ "Open CASCADE" Times 6 x=125 y=-95 
+text2brep name "Snowflake" Courier 7 x=65 y=-75 italic
+text2brep material "Ice" Courier 7 x=75 y=-95 italic
+text2brep sheets "Sheets 1" Courier 3.5 x=145 y=-83 italic
+text2brep scale "Scale\n\n1:100" Courier 3.5 x=157 y=-63 italic
+text2brep mass "Mass\n\n1 mg" Courier 3.5 x=140 y=-63 italic
+eval compound [explode sample w] sample
+eval compound [explode occ w] occ
+eval compound [explode name w] name
+eval compound [explode material w] material
+eval compound [explode sheets w] sheets
+eval compound [explode scale w] scale
+eval compound [explode mass w] mass
+compound sample occ name material sheets scale mass text
+
+compound snowflake frame text drawing
+
+# display in 3d view
+vinit Driver1/Viewer1/View1 w=1024 h=768
+vdisplay snowflake lines text
+vtop
+vfit

tests/demo/samples/pencil

@@ -0,0 +1,9 @@
+# test for generating funny shape 
+source $env(CASROOT)/samples/tcl/pencil.tcl
+
+# check shape validity and make a snapshot
+XGetOneShape res D
+checkshape res
+vdump $imagedir/${test_image}.png
+
+puts "TEST COMPLETED"

tests/demo/samples/penrose

@@ -0,0 +1,7 @@
+# test for generating funny shape 
+source $env(CASROOT)/samples/tcl/Penrose.tcl
+
+# make a snapshot
+vdump $imagedir/${test_image}.png
+
+puts "TEST COMPLETED"

tests/demo/samples/snowflake

@@ -0,0 +1,7 @@
+# test for generating funny shape 
+source $env(CASROOT)/samples/tcl/snowflake.tcl
+
+# make a snapshot
+vdump $imagedir/${test_image}.png
+
+puts "TEST COMPLETED"