Superellipsoid visualization with VTK and Tcl-Tk

GS The following example shows how to use VTK (Visualization ToolKit) and Tcl/Tk to display and explore a superellipsoid parametric surfaces (vtkParametricSuperToroid) with varying parameters :

N1 : "squareness" parameter along z axis
N2 : "squareness" parameter along x-y plane
X Y Z : scaling factor along the x y z-axis

You can test it easily on Windows without compiling VTK libraries thanks to VTKit (a tclkit extended with VTK library based on VTK5.5 and Tcl/Tk 8.5.7). [L1 ]

You can download VTKit5.5 here [L2 ]


 # superellipsoid-vtk.tcl
 # Author:      Gerard Sookahet
 # Date:        13 April 2019
 # Version:     0.1
 # Description: Superellipsoid parametric surface visualization with VTK and Tcl/Tk with varying
 #              parameters in a GUI  

 # load the VTK Tcl package and load the vtkinteraction package that contains 
 # default bindings for handling mouse and keyboard events for a render widget
 # Default keyboard events are :
 #  e / q / ESC : exit
 #  s : surface rendering
 #  w : wireframe rendering
 #  r : reset camera
 package require vtk
 package require vtkinteraction

 # Flat UI
 option add *Button.relief flat
 option add *Button.foreground white
 option add *Button.background blue
 option add *Button.width 13
 option add *Label.foreground blue
 option add *Label.background orange
 option add *Label.width 13
 option add *Entry.relief flat
 option add *Entry.background lightblue
 option add *Entry.width 2
 option add *Text.foreground lightgreen
 option add *Text.background black
 option add *Scale.relief flat
 option add *Scale.background blue
 option add *Scale.foreground white
 option add *Scale.highlightBackground black

 global color
 global renWin
 set color 1
 set w .sellips
 catch {destroy $w} 
 toplevel $w
 $w config -bg black
 wm title $w "Superellipsoid Surface Visualization"
 wm protocol $w WM_DELETE_WINDOW ::vtk::cb_exit
 # Create render window inside a Tk widget and bind the mouse events
 ::vtk::bind_tk_render_widget [vtkTkRenderWidget $ -width 600 -height 600]
 # Get the render window associated with the widget
 set renWin [$ GetRenderWindow] 
 vtkRenderer ren
 $renWin AddRenderer ren
 # Start VTK pipeline
 # Source -> Mapper -> Actor ->  Renderer
 # Create an instance of a parametric object (vtkParametricSuperEllipsoid) 
 # and Tessellate the parametric function
 vtkParametricSuperEllipsoid p
 vtkParametricFunctionSource obj
 obj SetParametricFunction p

 # Create an instance of vtkPolyDataMapper to map the polygonal data 
 # into graphics primitives and connect the output of the obj source
 # to the input of this mapper 
 vtkPolyDataMapper objMapper
 objMapper SetInputConnection [obj GetOutputPort]

 # Create an actor to represent the obj. The actor coordinates rendering of
 # the graphics primitives for a mapper. We set this actor's mapper to be
 # the mapper which we created above.
 vtkLODActor actor
 actor SetMapper objMapper
 # Assign a blue color to our actor
 [actor GetProperty] SetColor 0 0 1
 # Create the Renderer and add actors to it (ren AddViewProp actor also works) 
 # A renderer is like a viewport. It is part or all of a window on the screen 
 # and it is responsible for drawing the actors it has. 
 ren AddActor actor
 # Set the background color and render
 ren SetBackground 0 0 0
 ren Render
 # prevent the tk window from showing up then start the event loop
 wm withdraw .
 # Set parameters with a scale widget
 # N1 : "squareness" parameter along z axis
 # N2 : "squareness" parameter along x-y plane
 # X Y Z : scaling factor along the x y z-axis

 set f0 [frame $w.f0 -bg black] 
 set f1 [frame $f0.f1 -bg black] 
 set f2 [frame $f0.f2 -bg black] 
 pack $f1 -fill x 
 pack $f2 -fill x
 set sn1 [scale $f1.sn1 \
        -from 0 -to 10 -res .1 \
        -orient horizontal \
        -label "N1" \
        -command SuperellipsoidSetN1]

 set sn2 [scale $f1.sn2 \
        -from 0 -to 10 -res .1 \
        -orient horizontal \
        -label "N2" \
        -command SuperellipsoidSetN2]

 set sx [scale $ \
        -from 0 -to 10 -res .1 \
        -orient horizontal \
        -label "X" \
        -command SuperellipsoidSetX]

 set sy [scale $ \
        -from 0 -to 10 -res .1 \
        -orient horizontal \
        -label "Y" \
        -command SuperellipsoidSetY]

 set sz [scale $ \
        -from 0 -to 10 -res .1 \
        -orient horizontal \
        -label "Z" \
        -command SuperellipsoidSetZ]

 $sn1 set [p GetN1]
 $sn2 set [p GetN2]
 $sx  set [p GetXRadius]
 $sy  set [p GetYRadius]
 $sz  set [p GetZRadius]
 proc SuperellipsoidSetN1 {res} {
     global renWin
  p SetN1 $res
  $renWin Render
 proc SuperellipsoidSetN2 {res} {
     global renWin
  p SetN2 $res
  $renWin Render
 proc SuperellipsoidSetX {res} {
     global renWin
  p SetXRadius $res
  $renWin Render
 proc SuperellipsoidSetY {res} {
     global renWin
  p SetYRadius $res
  $renWin Render
 proc SuperellipsoidSetZ {res} {
     global renWin
  p SetZRadius $res
  $renWin Render
 button $f2.clr -text "Change Color" -command {ChangeColor}
 button $f2.exit -text Quit -command {exit}
 button $f2.about -text About -command {About}

 pack {*}[winfo children $f1] 
 pack {*}[winfo children $f2] -pady 3 -fill x 
 pack $ $f0 -side left
 # Change obj color between red green blue
 proc ChangeColor {} {
     global color
     global renWin
  switch $color {
        0 {
           set rgb "0 0 1"
           set color 1
        1 {
           set rgb "0 1 0"
           set color 2
        2 {
           set rgb "1 0 0"
           set color 0
  for {set i 1} {$i <= 100} {incr i 5} { 
     after 30
     set r [lindex $rgb 0]
     set g [lindex $rgb 1]
     set b [lindex $rgb 2]
     set i100 [expr {$i/100.0}]
     [actor GetProperty] SetColor [expr {$i100*$r}] [expr {$i100*$g}] [expr {$i100*$b}]
     $renWin Render
 proc About {} {
  set w .about
  catch {destroy $w}
  toplevel $w
  .about configure -bg black
  wm title $w "About Superellipsoid"
  set txt "VTK Superellipsoid Surface Visualization \n April 2019 \n Gerard Sookahet"
  message $w.msg -justify left -aspect 250 -relief flat -bg black -fg lightblue -text $txt
  button $w.bquit -text " OK " -command {destroy .about}
  pack $w.msg $w.bquit

See aslo Supertoroid visualization with VTK and Tcl-Tk