Here is a step by step example of how to create a Tcl/Tk extension. In this example we will create the file cmas2d.tcl, so we will be extending the capabilities of the cmas2d problem type. The file cmas2d.tcl has to be placed inside the cdmas2d Problem Type directory.

Note: The cmas2d problem type calculates the center of mass of a 2D surface. This problem type is located inside the Problem Types directory, in the GiD directory.

In this example, the cmas2d.tcl creates a window which appears when the problem type is selected.
Window created in the cmas2d.tcl example file

This window gives information about the location, materials and conditions of the problem type. The window has two buttons: CONTINUE lets you continue working with the cmas2d problem type; RANDOM SURFACE creates a random 2D surface in the plane XY.

What follows is the Tcl code for the example. There are three main procedures in the cmas2d.tcl file:

proc InitGIDProject {dir}

proc InitGIDProject {dir } {
  set materials  [GiD_Info materials] 
  set conditions [GiD_Info conditions over_point] 
  CreateWindow $dir $materials $conditions
}

This is the main procedure. It is executed when the problem type is selected. It calls the CreateWindow procedure.

proc CreateWindow {dir mat cond}

proc CreateWindow {dir mat cond} {  
    if { [GidUtils::AreWindowsDisabled] } {
	return
    }  
    set w .gid.win_example
    InitWindow $w [= "CMAS2D.TCL - Example tcl file"] ExampleCMAS "" "" 1
    if { ![winfo exists $w] } return ;# windows disabled || usemorewindows == 0
    ttk::frame $w.top
    ttk::label $w.top.title_text -text [= "TCL window example for CMAS2D problem type"]   
    ttk::frame $w.information -relief ridge
    ttk::label $w.information.path -text [= "Problem Type path: %s" $dir]
    ttk::label $w.information.materials -text [= "Available materials: %s" $mat]
    ttk::label $w.information.conditions -text [= "Available conditions: %s" $cond] 
    ttk::frame $w.bottom
    ttk::button $w.bottom.start -text [= "Continue"] -command "destroy $w"
    ttk::button $w.bottom.random -text [= "Random surface"] -command "CreateRandomSurface $w"
    grid $w.top.title_text -sticky ew
    grid $w.top -sticky new
    grid $w.information.path -sticky w -padx 6 -pady 6
    grid $w.information.materials -sticky w -padx 6 -pady 6
    grid $w.information.conditions -sticky w -padx 6 -pady 6
    grid $w.information -sticky nsew    
    grid $w.bottom.start $w.bottom.random -padx 6
    grid $w.bottom -sticky sew -padx 6 -pady 6
    if { $::tcl_version >= 8.5 } { grid anchor $w.bottom center }
    grid rowconfigure $w 1 -weight 1
    grid columnconfigure $w 0 -weight 1    
}

This procedure creates the window with information about the path, the materials and the conditions of the project. The window has two buttons: if CONTINUE is pressed the window is dismissed; if RANDOM SURFACE is pressed, it calls the CreateRandomSurface procedure.

proc CreateRandomSurface {w}

proc CreateRandomSurface {w} {
 set ret [tk_dialogRAM $w.dialog [= "Warning"] \
    [= "Warning: this will create a nurbs surface in your current project"] "" 1 [= "Ok"] [= "Cancel"]]
 if {$ret ==0} {
       Create_surface
       destroy $w
  }
}

This procedure is called when the RANDOM SURFACE button is pressed. Before creating the surface, a dialog box asks you to continue with or cancel the creation of the surface. If the surface is to be created, the Create_surface procedure is called. Then, the window is destroyed.

proc Create_surface {} {
    set a_x [expr rand()*10]
    set a_y [expr rand()*10]    
    set b_x [expr $a_x + rand()*10]
    set b_y [expr $a_y + rand()*10]    
    set c_x [expr $b_x + rand()*10]
    set c_y [expr $b_y - rand()*10]    
    if {$a_y < $c_y} {
	set d_y [expr $a_y - rand()*10]
	set d_x [expr $a_x + rand()*10]
    } else {
	set d_y [expr $c_y - rand()*10] 
	set d_x [expr $c_x - rand()*10]
    }        
    GiD_Process escape escape escape geometry create line \
	$a_x,$a_y,0.000000 $b_x,$b_y,0.000000  $c_x,$c_y,0.000000 $d_x,$d_y,0.000000 close     
    GiD_Process escape escape escape escape geometry create NurbsSurface Automatic \
	4 escape    
    GiD_Process 'Zoom Frame escape escape escape escape 
}

A 2D surface (a four-sided 2D polygon) is created. The points of this surface are chosen at random.

Browser not supported