
# This code creates the user interface for the mesh editor.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# $Revision: 871416 $ on $Date: 2015-12-11 12:55:05 +0100 (Fr, 11. Dez 2015) $
# This file contains special comments of the form ## html ... which are
# used to automatically generate documentation

## <h3>Geometry functions</h3>
## These functions manipulate the geometric data which is loaded in from
## the <b>tetin</b> file.  Geometric entities are referenced by type and
## name.  For every entity of a given type there is a unique name, and
## every entity is in a given family which is generally transfered to
## the mesh that is created from the geometry.  The types are:
## <ul>
## <li> <b>surface</b>: surfaces, which may be either trimmed NURBS surfaces
## or faceted (from STL or other triangular formats).  Surfaces
## correspond to regions of triangles or quads in the mesh, and nodes in
## the mesh that fall on a surface have a dimension of 2.
## <li> <b>curve</b>: either NURBS curves or piecewise linear paths.  Curves
## correspond to bar elements and nodes with dimension 1.
## <li> <b>point</b>: prescribed points.  These correspond to NODE elements
## in the mesh and nodes with dimension 0.
## <li> <b>material</b>: material points.  These define connected regions
## where all volume elements get the family of the material point.
## <li> <b>loop</b>: a loop is a list of curves which define a closed loop,
## which is used by the <b>Quad</b> surface mesher.
## <li> <b>density</b>: a density polygon is a set of points that define
## a convex hull, in which the size of the tetra elements must be no
## greater than a specified value.
## </ul>

## Load the specified tetin files.  The full path names must be given.
## If the <em>tri_tolerance</em> is given that becomes the new triangulation
## tolerance for the file, overriding what is specified.<br>
## <b>Notes:  </b>
## <ul>
## <li> The tetin file will be merged with any existing geometry already
##      loaded.  See also <a href="#ic_unload_tetin">ic_unload_tetin</a>.
## <li> On Windows use the "/" character as the path delimiter instead of
##        the backslash "\" character.  For example
## <pre>
##     ic_load_tetin c:/speed_racer/mach5.tin
## </pre>
## </ul>
proc ic_load_tetin {filenames {tri_tolerance 0} {keep_model_params 1} {blanks 0} {quiet 0}} {
#
#  Last Modified ---
#    04/29/05 - VG - Set pickability of dormant as "dormant visible"
#    01/16/02 - AWM - Added check for missing input file
#    09/07/01 - JKA - Tested successfully with "display_update geom"
#
    global tetin_keep_model_params load_tetin_triangle_tolerance
    global tetin_try_binary batch_mode
    global projlib_no_read_boco_file
    global geom_optimize_speed tdv_native_display_lists env

    # This turns out to be not a big help in most cases
    set geom_optimize_speed 0
    # This increases speed 50% but is a *huge* memory hog ...  But that depends on
    # the opengl implementation and the graphics card.
    # set tdv_native_display_lists 0

    set load_tetin_triangle_tolerance $tri_tolerance
    set tetin_try_binary 0
    set tetin_keep_model_params [expr $keep_model_params && [ic_geo_num_objects all]]
    set projlib_no_read_boco_file 0

    # Note that this function will *not* read in the family_boco data.
    # That gets done in the ic_boco_load function.

    set status 0
    ic_undo_suspend
    busy 1
    if $blanks {
        if ![file exists $filenames] {
            return -code error "Error opening file, $filenames"
        }
        if {!$quiet && $batch_mode} { mess "Loading geometry file \"$filenames\"\n" }
        set status [expr $status || [make_projlib $filenames 1 1 1 1 1 1 $quiet]]
    } else {
        foreach file $filenames {
            if ![file exists $file] {
                return -code error "Error opening file, $file"
            }
            if {!$quiet && $batch_mode} { mess "Loading geometry file \"$file\"\n" }
            set status [expr $status || [make_projlib $file 1 1 1 1 1 1 $quiet]]
        }
    }
    ic_undo_resume
    if !$status {busy 0; return $status}

# ---
	#Dormant entities may be -pickable only if -dormant (visible) !!!
	global projlib
	foreach type {point curve} {
		foreach name [ic_geo_get_dormant $type] {
			set obj [$projlib get_object_by_name $type $name]
			set vis [$obj get -dormant]
			$obj configure -pickable $vis
		}
	}
# ---

    # This is a hack.  update_geom_visible "knows" that certain families are
    # already displayed when it's loading multiple tetin files so it doesn't
    # update them for the ones after the first.  Force it to redraw.
    #update_geom_visible all a 0 1

    if !$batch_mode {
        display_update geom
        # Call update_fam_window once to update all the mesh/other families
        update_fam_window "" 1
    }

    ic_csystem_set_current global
    ic_geo_set_modified 0
    
    busy 0
    if [ic_wb2_input_parameter_mode] {
        ic_wb2_update_parameters input
    }
    return $status
}

## Create an empty geometry database.

proc ic_empty_tetin {} {
    global projlib batch_mode
    
    make_projlib ""
    if !$batch_mode {
        display_update geom 1
    }
    if {$projlib != ""} {
        $projlib configure -modified 1
    }
}

## Save the current geometry data to the given file name.  The full path name
## must be given.  If <em>only_visible</em> is 1 then only the visible data
## will be saved.  If <em>v4</em> is 1 then the tetin file will be saved in icemcfd 4.x
## compatibility mode.<br>
## <b>Notes:  </b>
## <ul>
## <li> On Windows use the "/" character as the path delimiter instead of
##        the backslash "\" character.  For example
## <pre>
##     ic_save_tetin c:/speed_racer/mach5.tin
## </pre>
## </ul>
proc ic_save_tetin {file {only_visible 0} {v4 0} {only_fams ""} {only_ents ""} {v10 0} \
    {quiet 0} {clear_undo 1}} {
#
#  Last modified ---
#    08/16/01 - AWM - tested successfully
#
    global whoami projlib tetin_file undo_redo

    if {![info exists projlib] || ($projlib == "")} {
	user_error "No geometry data is available to save"
	return
    }

    # Note that this function will *not* write out the family_boco file,
    # and the read_family_boco does not show up in the tetin file any more.

    if {!$quiet} {mess "Writing tetin file $file ...\n"}
    if $only_visible { mess "Only saving visible tetin data!\n" red }
    busy 1

    # First make a backup copy.
    if [file exists $file] {
	set backup $file.__ICEM__BACKUP__
	if [catch {
	    file delete $backup
	    file rename $file $backup
	}] { unset backup }
    }
    if [catch {$projlib save_model $file $whoami $only_visible $v4 $only_fams $only_ents $v10 $quiet} res] {
	if [info exists backup] {
	    catch {file delete $file}
	    file rename $backup $file
	}
	user_error "Problem saving tetin file: $res"
	puts [list $projlib save_model $file $whoami $only_visible $v4 $only_fams $only_ents $v10 $quiet]
    } else {
	# Saved okay - delete the backup
	if [info exists backup] { file delete $backup }
    }

    $projlib configure -modified 0 -surface_file $file
    set tetin_file $file
    if $clear_undo { ic_undo_clear }
    busy 0
    if {!$quiet} {mess "Done saving tetin file.\n"}
}

## Unload the current geometry data.
proc ic_unload_tetin {{quiet 0}} {
#
#  Last modified ---
#    08/16/01 - AWM - tested successfully
#
    global tetin_file projlib undo_redo batch_mode

    delete_projlib
    set tetin_file ""
    fam_delete_unused_on_unload $quiet
    if !$batch_mode {
        display_update geom 0
    }
    ic_undo_clear
}

## Import a mesh file and create a tetin database.  Surface elements are
## turned into surfaces (by family), bar elements to curves, node elements
## to prescribed points, and one volume element per family to material points.
## If domains is "" then it will import from the currently loaded
## unstructured mesh.
## If <b>do_seg</b> is 1 then the curves and surfaces will be segmented by
## connectivity, otherwise they will be kept as one object per family.
## if <b>no_orfn</b> is 1 then any elements that were in the ORFN (0)
## family will be moved to a new family called <tt>MOVED_ORFN</tt>.

proc ic_geo_import_mesh {{domains ""} {do_seg 1} {no_orfn 1} {do_merge 1}} {
    global uns_cur

    if {$domains == ""} {
	if {$uns_cur == ""} { error "No mesh is loaded" }
	set nn [geo_import_from_uns $uns_cur [expr !$do_seg] [expr !$do_merge]]
	mess "From current mesh, imported [lindex $nn 0] surfaces,\
		[lindex $nn 1] curves, [lindex $nn 2] points,\
		[lindex $nn 3] materials\n"
    } else {
	foreach file $domains {
	    if ![file exists $file] {
		mess "Error: $file doesn't exist\n" red
		continue
	    }
	    set uns [uns_mesh]
	    ic_undo_suspend
	    $uns load_domain_geom $file 3 domain_put_info 0
	    ic_undo_resume

	    if {[$uns count_in_family ORFN] && $no_orfn} {
		set ofam MOVED_ORFN
		set num 0
		foreach f [$uns list_families] {
		    if [regsub ^${ofam}(\[0-9\]+\\Z) $f {\1} n] {
			set num [expr {$num > $n ? $num : $n}]
		    }
		}
		set ofam $ofam[incr num]
		mess "Moving ORFN elements to $ofam\n"
		$uns move_family_elements 0 $ofam
	    }
	    
            if {![$uns count TRI_3] && ![$uns count QUAD_4]} {
                make_standard_maps $uns
                set map [$uns get_map All]
		set refine 1
		set keep_interf 0
		$map change_type_quadratic_linear $refine $keep_interf
                set fam SURFACE
                $uns create_family $fam -1
                $map fix_uncovered $fam 0
            }
	    
	    set nn [geo_import_from_uns $uns [expr !$do_seg] [expr !$do_merge]]
	    mess "From file $file, imported [lindex $nn 0] surfaces,\
		[lindex $nn 1] curves, [lindex $nn 2] points,\
		[lindex $nn 3] materials\n"
	    ic_undo_suspend
	    $uns delete
    	    ic_undo_resume
	}
    }
}

##   update_surface_display
##
##   utility to update display of surface and related edges, vertices
proc update_surface_display {obj} {
    global projlib
    set nb [$projlib get_number surface $obj]
    set nb [define_geom_object surface $nb]
    update_geom_visible_obj $nb
    lappend srfNames $obj
    set edges [ic_geo_get_srf_edges $obj]
    foreach crv $edges {
        set eb [$projlib get_number curve $crv]
        set eb [define_geom_object curve $eb]
        update_geom_visible_obj $eb
        if [catch {ic_geo_crv_get_end $crv 0} endPt] {
        } else {
            set pb [$projlib get_number point $endPt]
            set pb [define_geom_object point $pb]
            update_geom_visible_obj $pb
        }
        if [catch {ic_geo_crv_get_end $crv 1} endPt] {
        } else {
           set pb [$projlib get_number point $endPt]
           set pb [define_geom_object point $pb]
           update_geom_visible_obj $pb
        }
    }
}

## Copy the current geometry into the mesh database.  This is the opposite
## of </b>ic_geo_import_mesh</b> - surfaces will get turned into families
## of triangles, etc.  If <b>merge</b> is 1 then all surfaces, etc will keep
## their families, and if if 0 then the geometric objects will each
## get mapped to a separate family in the mesh.

proc ic_geo_export_to_mesh {merge {fams ""} {quiet 0}} {
    global batch_mode
    global tdv_default
    
    set uns [make_new_uns_mesh ""]
    if {$uns == ""} { busy 0; return }
    $uns initialize_mesh

    set nn [geo_export_to_uns $uns [expr !$merge] $fams]
    if !$quiet {
        mess "Exported [lindex $nn 0] surfaces,\
            [lindex $nn 1] curves, [lindex $nn 2] points,\
            [lindex $nn 3] materials\n"
    }
    make_standard_maps $uns
    domain_after_load_mesh

    if !$batch_mode {
	foreach im [$uns list_maps] {
	    $im set_pid_colors
	    $tdv_default add_image $im
	}
    }
}

## Run either DDN or a DDN GPL application.
## <dl>
## <dt><em>type</em> 
## <dd><em>type</em> may be <b>ddn</b>,
##     <b>mif</b>, <b>input</b>, or <b>frontal</b>.  
## <dt> <em>partname</em> and <em>partdir</em> 
## <dd> The <em>partname</em> and <em>partdir</em> arguments map to the DDN <b>pn</b> and 
##      <b>db</b> command line arguments
## <dt><em>extra_cmds</em> 
## <dd><em>extra_cmds</em> is a list of lines that will go into the input file
##     after the commands to start up the GPL application.  
## <dt><b>batch</b>
## <dd>If <b>batch</b> is 1  (the default) then DDN will be run without graphics.
## </dl>
##
## <b>Notes:</b>
## <ul>
## <li> This command is currently broken in MED 4.2 08/16/01
## </ul>
proc ic_ddn_app {type partname partdir extra_cmds {batch 1}} {
#
#  Last modified ---
#    08/16/01 - AWM - Test failed -- ddn_run command is not found.
#
#   ddn_run is in the gui interpreter -- needs to be moved into the
#   batch interpreter and the calls from the gui probably need to be
#   routed through ic_ddn_app
#   
    ddn_run $type $partname $partdir $extra_cmds $batch 0
}

## Update the DDDN directory file
## <table border>
## <tr><td><b>dir</b>	</td><td> name of parts directory </td></tr>
## <tr><td><b>update</b> </td><td>1 = update the directory</td></tr>
## <tr><td><b>return</b></td><td> List of DDN parts  </td></tr>
## </table>

proc ic_list_ddn_parts {dir update} {
    set ddndir [get_program bin ddndir]
    if [file exists $dir/.ddn_directory] {
	set is_writable [file writable $dir/.ddn_directory]
	if !$is_writable {
	    mess "No write permission for $dir/.ddn_directory.\n" red
	    return ""
	}
    }
    if $update {
	cmd_rm $dir/.ddn_directory
	set stuff [exec $ddndir -w $dir]
    } elseif [file exists $dir/.ddn_directory] {
	set stuff [exec $ddndir -r $dir]
    } else {
	set stuff [exec $ddndir -w $dir]
    }
    return $stuff
}
set dont_record_command(ic_list_ddn_parts) 1

## Print a summary of the geometry in the message window.
proc ic_geo_summary {} {
#
#  Last modified ---
#    08/16/01 - AWM - tested successfully
    geom_summary
}
set dont_record_command(ic_geo_summary) 1

## Get the internal numeric id (pid) of this family.  This is not a safe
## function to use in general because the pid is not guaranteed to stay the
## same between one invocation of the program and the next, and no
## scripting commands use it as an argument.

proc ic_geo_lookup_family_pid {fam} {
#
#  Last modified ---
#    08/16/01 - AWM - Tested successfully
#
    global projlib
    if {$projlib == ""} { return "" }
    set fam_id [$projlib lookup_family_pid $fam]
    return $fam_id
}

set dont_record_command(ic_geo_lookup_family_pid) 1

## See if any geometry is loaded.

proc ic_geo_is_loaded {} {
#
#  Last modified ---
#    08/16/01 - AWM - Tested successfully
#
    global projlib
    return [expr {[info exists projlib] && ($projlib != "") && [$projlib num_objects all]}]
}
set dont_record_command(ic_geo_is_loaded) 1

## See if the current geometry has been modified since the last save.

proc ic_geo_is_modified {} {
#
#  Last modified ---
#    08/16/01 - AWM - Tested successfully
#
    global projlib
    return [expr {[ic_geo_is_loaded] && [$projlib get -modified]}]
}
set dont_record_command(ic_geo_is_modified) 1

## Change a name into a valid family/entity name

proc ic_geo_valid_name {name no_colon} {
    set maxlen [ic_geo_get_valid_namelen]
    if {[string len $name] > $maxlen} {
        mess "Part name too long; max $maxlen characters allowed\n" red
        return ""
    }
    set n [string toupper [get_valid_name $name]]
    if $no_colon {
        regsub -all : $n _ n
        # ! and ^ create problems in tcl if used in part names
        regsub -all ! $n _ n
        regsub -all \\^ $n _ n
        regsub -all " " $n _ n
    }
    return $n
}
set dont_record_command(ic_geo_valid_name) 1

## Set the modified flag for the current geometry.  This shouldn't be used
## for most operations since they set this flag themselves.

proc ic_geo_set_modified {on} {
    global projlib
    if {[info exists projlib] && ($projlib != "")} {
	$projlib configure -modified $on
    }
}

## Check whether a family exists.

proc ic_geo_check_family {name} {
#
#  Last modified ---
#    08/16/01 - AWM - Tested successfully
#
    global projlib
    if {$projlib == ""} { return 0 }
    if {[$projlib lookup_family_pid $name] == ""} {
	return 0
    } else {
	return 1
    }
}
set dont_record_command(ic_geo_check_family) 1

## Check whether a part exists.

proc ic_geo_check_part {name} {
    global projlib
    if {$projlib == ""} { return 0 }
    if {[$projlib lookup_family_pid $name] != ""} { return 1 }
    foreach ff [$projlib list_families 0] {
	if [string match $name:* $ff] { return 1 }
    }
    return 0
}
set dont_record_command(ic_geo_check_part) 1

## Create a new family if it's not already there.  Return 1 if a new family
## was created, or 0 if it already existed.<br>
##
## <b>Note:</b>
## <ul>
## <li> The newly created family will not appear in the interactive
##      family list unless you issue the <i>update_family_display</I>
##      command interactively.
## </ul>
##
proc ic_geo_new_family {name {do_update 1}} {
#
#  Last modified ---
#    08/16/01 - AWM - Tested successfully
#
    global projlib batch_mode
    if {$name == ""} {
        error "Zero length name not allowed"
    }
    if [scan $name %d dummy] {
     	error "Part name $name is not valid; cannot begin with a numeral."
    }
    if {$projlib == ""} {
        make_projlib ""
    }
    set new_fam [$projlib new_family $name]
    if $new_fam {
        # If we create a new family in the geometry db it may also need to be
        # created in the mesh
        ic_uns_new_family $name
    }
    if {$new_fam && !$batch_mode && $do_update} {
        update_fam_window
    }
    return $new_fam
}

## Create a new, unused name for an entity in a family.

proc ic_geo_new_name {type prefix} {
    global projlib
    return [$projlib new_name $type $prefix 0]
}
set dont_record_command(ic_geo_new_name) 1

## Create a new unused part or family name

proc ic_geo_get_unused_part {prefix {no_first_num 0}} {
    global projlib
    # bug 12466 -fifi
    if { "$projlib" == "" } { return $prefix }
    foreach p [$projlib list_families 0] {
	set used($p) 1
	set used([lindex [split $p /] end]) 1
    }
    if {$no_first_num && ![info exists used($prefix)]} {return $prefix}
    for {set i 1} {[info exists used($prefix.$i)]} {incr i} {}
    return $prefix.$i
}
set dont_record_command(ic_geo_get_unused_part) 1

## Delete a family, or a list of families.

proc ic_geo_delete_family {names} {
    global projlib
    if {$projlib != ""} {
	foreach n $names {
	    $projlib delete_family $n
	}
    }
}

## Blank those entities that have some meshing parameters already defined.
## If reset == 1 then the entities blanked entities are unblanked

proc ic_geo_params_blank_done {type {reset 0}} {
    global projlib geo_params_blanked

    if ![info exists geo_params_blanked($type)] {
        set geo_params_blanked($type) ""
    }

    if $reset {
        foreach name $geo_params_blanked($type) {
            set obj [$projlib get_object_by_name $type $name]
            if {$obj != ""} { update_geom_visible_obj $obj }
        }
        set geo_params_blanked($type) ""
        return
    }

    set enums [$projlib params_blank_done $type]
    set names ""
    foreach n $enums {
        set name  [$projlib get_name $type $n]
        lappend names [$projlib get_name $type $n]
    }

    set geo_params_blanked($type) $names
    return $names
}

## Return the names of the objects that match a given pattern

proc ic_geo_match_name {type pat} {
    global projlib
    if {$projlib == ""} { return "" }
    set snames ""
    foreach s [$projlib list_objects $type] {
	set name [$projlib get_name $type $s]
	if [string match $pat $name] {
	    lappend snames $name
	}
    }
    return $snames
}
set dont_record_command(ic_geo_match_name) 1

## Change the visibility so that only objects with the given families and type
## are visible or not, depending on the <b>visible</b> option.
## If vis_fams is <tt>*skip*</tt> then keep them the same and just look
## at the type.  If a family is not listed in the family list then leave
## it alone.

proc ic_geo_update_visibility {type vis_fams visible} {
    global projlib
    if {("" == $projlib) || ![$projlib num_objects all]} return
    if {$vis_fams == "*skip*"} {
	set vis_fams ""
    } else {
	set vis_fams [concat + $vis_fams]
    }
    $projlib update_visibility $type $vis_fams $visible
}
set dont_record_command(ic_geo_update_visibility) 1

## Return whether an object is visible or not

proc ic_geo_get_visibility {type name} {
    global projlib
    if {$projlib == ""} { return 0 }
    set bsp [$projlib get_object_by_name $type $name]
    if {$bsp == ""} { error "no such $type $name" }
    return [$bsp get -visible]
}
set dont_record_command(ic_geo_get_visibility) 1

## Set or unset the visible_override flag.  If this flag is set for an object
## then it is always visible no matter what types and families are turned on.
## This is needed for geometry subsets.

proc ic_geo_set_visible_override {type name val} {
    global projlib
    if {$projlib == ""} return
    set bsp [$projlib get_object_by_name $type $name]
    if {$bsp == ""} { error "no such $type $name" }
    $bsp configure -visible_override $val
    $bsp signal_change 0
}
set dont_record_command(ic_geo_set_visible_override) 1

## Temporarily blank or unblank an object.  This will not go away when the user
## changes anything larger scale.  If objects is all then all will be blanked or
## unblanked

proc ic_geo_temporary_visible {type objects vis {force 0}} {
    global projlib
    if {$projlib == ""} return

    set ims ""
    if {$type == "entity"} {
	    if {$objects == "all"} {
	        foreach tt {point curve surface material loop density body} {
		        foreach c [$projlib list_objects $tt] {
		            lappend ims [$projlib get_object $tt $c]
		        }
	        }
	    } else {
	        foreach ee $objects {
		        set bsp [$projlib get_object_by_name [lindex $ee 0] [lindex $ee 1]]
		        if {$bsp == ""} { error "no such $ee" }
		        lappend ims $bsp
	        }
	    }
    } else {
	    if {$objects == "all"} {
	        foreach c [$projlib list_objects $type even_if_dormant] {
		        lappend ims [$projlib get_object $type $c]
	        }
	    } else {
	        foreach name $objects {
		        set bsp [$projlib get_object_by_name $type $name]
		        if {$bsp == ""} { error "no such $type $name" }
		        lappend ims $bsp
	        }
	    }
    }
    set blank [expr !$vis]
    foreach bsp $ims {
        if {$bsp == ""} continue
	    if {[$bsp get -user_blanked] != $blank || $force} {
	        show_geo_selected $bsp 0
	        if $force {
	            $bsp configure -visible $vis
	        } else {
		        # If the object is already blanked then don't user-blank it again
		        if {$vis == [$bsp cget -visible]} {
		            continue
		        }
	            $bsp configure -user_blanked $blank -visible $vis
	        }
	        $bsp signal_change 0
	    }
    }
}
set dont_record_command(ic_geo_temporary_visible) 1

## Get the temporarily blanked entities.  Returns a list "type name" or an empty list, 
## if no entity was blanked.  Type can be entity (for all types), point, curve or surface
## ic_geo_get_temporary_invisible [type]

proc ic_geo_get_temporary_invisible {{type entity}} {
    global projlib
    
    if {$projlib == ""} return ""
    set ims ""
    set names ""
    set invis ""
    if {$type == "entity"} {
	    foreach tt {point curve surface} {
		     foreach c [$projlib list_objects $tt] {
		        set im [$projlib get_object $tt $c]
		        if {$im != ""} {
		            lappend ims  $im
		            lappend names "$tt [$projlib get_name $tt $c]"
		        }
	        }
	    }
    } else {
	    foreach c [$projlib list_objects $type even_if_dormant] {
	        set im [$projlib get_object $type $c]
	        if {$im != ""} {
		        lappend ims [$projlib get_object $type $c]
		        lappend names "$type [$projlib get_name $type $c]"
		    }
	    }
    }
    set idx 0
    set blank 0
    foreach bsp $ims {
	    if {[$bsp get -user_blanked] == $blank} {
	        incr idx
	        continue
	    }
        lappend invis [lindex $names $idx]
        incr idx
    }
    return $invis
}
set dont_record_command(ic_geo_get_temporary_invisible) 1

## This is a helper function that sets the visible_override flag for all
## objects in some families and types, and clears it for all others.
## Note that after calling this function all the visible flags on the non-
## override families will be off so you should call

proc ic_geo_set_visible_override_families_and_types {fams types} {
    global projlib

    foreach f $fams { set ok($f) 1 }
    foreach t $types {
		foreach obj [$projlib list_bsp_objects $t] {
			set vis [info exists ok([$obj get -family])]
	$obj configure -visible_override $vis -visible $vis
    }
}
}
set dont_record_command(ic_geo_set_visible_override_families_and_types) 1

## This redraws the geometry in case something changed

proc ic_redraw_geometry {type name} {
    global projlib
    set num [$projlib get_number $type $name]
    if {$num < 0} return
    set obj [$projlib get_object $type $num]
    if {$obj != ""} {
        update_geom_object $obj
        $obj signal_change 1
    } else {
        define_geom_object $type $num
    }
}
set dont_record_command(ic_redraw_geometry) 1

## Return what objects of higher dimensionality are incident to this one.
## Surfaces are incident to curves and curves are incident to points.

proc ic_geo_incident {type names {even_if_dormant 0}} {
    global projlib
    if ($even_if_dormant) {
        set dormant "even_if_dormant"
    } else {
        set dormant ""
    }
    set objs ""
    foreach name $names {
	set obj [$projlib get_object_by_name $type $name]
	if {$obj != ""} { set objs [concat $objs [$obj incident $dormant]] }
    }
    return $objs
}

## Returns a list of objects associated to a surface.

proc ic_geo_surface_get_objects {surface {type "embedded_points"}} {
    global projlib
    return [$projlib geo_surface_get_objects $surface $type]
}
set dont_record_command(ic_geo_surface_get_objects) 1

## Returns a list of objects associated to a loop.

proc ic_geo_loop_get_objects {loop {type "surface"}} {
    global projlib
    if {$type == "curve"} {
      return [ic_geo_boundary loop $loop]
    } else {
      return [$projlib geo_loop_get_objects $loop $type]
    }
}
set dont_record_command(ic_geo_loop_get_objects) 1

proc ic_geo_face_surface_mesh_type { name { type "" } } {
	global projlib
	set obj [ $projlib get_object_by_name surface $name ]
	if { $type == "" } {
		return [ $obj mesh_type ]
	} else {
		$obj mesh_type $type
	}
}

set dont_record_command(ic_geo_incident) 1

## Return what edges in a triangulated surface are incident to a given curve.

proc ic_geo_surface_edges_incident_to_curve {surfname curvename} {
    global projlib
    set surfno [$projlib get_number_by_name surface $surfname]
    set curveno [$projlib get_number_by_name curve $curvename]
    return [$projlib surface_edges_incident_to_curve $surfno $curveno]
}
set dont_record_command(ic_geo_surface_edges_incident_to_curve) 1

## Reorient the normals of surfaces in a model wrt the given reference
## surface <em>refsurfname</em> in direction given <em>outward</em> [0|1].
## If there is no material point, outward, means reverse reference surface
## before reorienting wrt it.

proc ic_geo_surface_normals_orient {{refsurfname ""} {outward 1}} {
    global projlib
    
    if {"" != $refsurfname} {
	set refsurfno [$projlib get_number_by_name surface $refsurfname]
    } else { set refsurfno -1 }

    return [$projlib orient_surface_normals $refsurfno $outward]
}

## Returns a list of surfaces whose normal of magnitude <em>tol</em> does not
## intersect another surface

proc ic_geo_get_side_surfaces {tol how {list ""}} {
    global projlib

    switch $how {
	all {
	    set snames [$projlib list_bsp_objects surface names]
	}
	names { set snames $list }
	families {
            set snames ""
	    foreach f $list {
                set p [$projlib lookup_family_pid $f]
                foreach s [$projlib get_objects_in_family surface $p] {
                    lappend snames [$projlib get_name surface $s]
                }
	    }
	}
        default { error "how must be either names, all, or families" }
    }
    return [$projlib get_side_surfaces $tol $snames]
}
set dont_record_command(ic_geo_get_side_surfaces) 1

## Return what objects of lower dimensionality are the boundary of this one.
## Points are the boundary of curves and curves are the boundary of surfaces
## and loops. The list returned has a sublist foreach element in <em>names</em>
## such that {{c00 c01} {c10 c11} ...}, unless names is one elment, in which
## case the returned list goes as: "c00 c01".
## <i>names</i> may be one name, or a list of names
## <i>outer</i> may be 0 or 1, indicating what kind of boundaries
## <i>even_if_dormant</i> may be 0 or 1, indicating which additional boundaries
## <i>embedded</i> may be 0 or 1, indicating which additional boundaries

proc ic_geo_boundary {type {names ""} {outer 0} {even_if_dormant 0} {embedded 0}} {
    global projlib

    if {"" == $names} { set names [ic_geo_get_objects $type ""] }
    set bnds ""
    set nn [llength $names]
    foreach n $names {
        set obj [$projlib get_object_by_name $type $n]
        if {"" == $obj} { continue }
        if 0 { set bnd [$obj boundary] } else {
            set bnd [boundary_of_image $obj $outer $even_if_dormant $embedded]
        }
        # this prints too many messages for some examples
        #if {"" == $bnd} { mess "Couldn't get boundary for $type $n\n" red }
        if {1 == $nn} {
            return $bnd
        } elseif {"" != $bnd} { lappend bnds $bnd }
    }
    return $bnds

}
set dont_record_command(ic_geo_boundary) 1

## Change the visibility of a specific object or objects.  The <b>visible</b>
## argument is 0 or 1.

proc ic_geo_object_visible {type names visible} {
    global projlib batch_mode
    if !$batch_mode {
        foreach name $names {
            set obj [$projlib get_object_by_name $type $name]
	    if { $obj != "" } {
            	$obj configure -visible $visible
	    }
        }
    }
}
set dont_record_command(ic_geo_object_visible) 1

## Configure the attributes of all the visible objects of a given type.  The
## arguments are:
## <ul>
## <li><b>simp</b> : the level of simplification.  0 shows the full detail
## of the object, and higher values simplify them more: 5 is very simple.
## In the case of facetted geometry this value is 1/20 of the angle that is used
## to extract internal curves
## <li><b>shade</b> : how to draw the objects: one of <tt>wire, solid,
## solid/wire,</tt> or <tt>hidden</tt>.
## <li><b>st</b> : if 1 show sizes appropriate for Tetra.
## <li><b>sp</b> : if 1 show sizes appropriate for Prism.
## <li><b>sh</b> : if 1 show sizes appropriate for Hexa.
## <li><b>sq</b> : if 1 show sizes appropriate for Quad.
## <li><b>names</b> : if 1 show the names of the objects.
## <li><b>wide</b> : draw wide lines.  This value plus 1 is the line thickness.
## <li><b>dnodes</b> : if 1 display the nodes of the object.
## <li><b>count</b> : if 1 show curves in different colors:
## <ul>
## <li> <b>green</b>: no surfaces are adjacent to this curve
## <li> <b>yellow</b>: just one surface is adjacent to this curve
## <li> <b>red</b>: two surfaces are adjacent to this curve
## <li> <b>blue</b>: more than two surfaces are adjacent to this curve
## </ul>
## <li><b>nnum</b> : draw node numbers (internal to the surface or curve,
## useful for debugging)
## <li><b>tnum</b> : draw triangle or segment numbers (internal to the
## surface or curve, useful for debugging)
## <li><b>tnum</b> : draw normals of non-mesh surfaces
## <li><b>comp</b> : show composite curves
## </ul>

proc ic_geo_configure_objects {type simp shade st sp sh sq \
				   names wide dnodes count nnum tnum norms thickness \
				   lshow lfull lst lsq {comp 0} {grey_scale 0} \
				   {transparent 0} {count_quad 0} {dormant 0} {protect 0}} {
    global projlib
    if {$projlib == ""} { return "" }
    $projlib configure_objects $type $simp $shade $st $sp $sh $sq \
	$names [expr 1 + 2 * $wide] $dnodes $count $nnum $tnum $norms $thickness \
	$lshow $lfull $lst $lsq $comp $grey_scale $transparent $count_quad $dormant $protect
}
set dont_record_command(ic_geo_configure_objects) 1

## Configure one atribute of a whole type

proc ic_geo_configure_one_attribute {type what val} {
    global projlib
    
    if ![ic_geo_is_loaded] return

    foreach obj [$projlib list_bsp_objects $type] {
		$obj configure -$what $val
    }
}

## Configure the attributes of one object.

proc ic_geo_configure_one_object {type name what {val -}} {
    global projlib
    set bsp [$projlib get_object_by_name $type $name] 
	if ![llength $bsp] return 
    if {$val == "-"} {
		set res [catch "$bsp configure -$what" cnf]
		if $res return
		return [lindex $cnf end]
    }
	set res [catch "$bsp configure -$what $val" cnf]
	if $res return
	return $val
}

# since this is just for display don't record in the replay file.
set dont_record_command(ic_geo_configure_one_object) 1

## List the current families used by geometry objects.  If <b>only_material</b>
## is 1 then limit the listing to families used by materials.
## If <b>non_empty</b> is 1 then list only families with stuff in them

proc ic_geo_list_families {{only_material 0} {non_empty 0}} {
    global projlib
    
    if {$projlib == ""} { return "" }
    if $only_material {
        return [lsort -unique [$projlib list_material_families]]
    } else {
        return [$projlib list_families $non_empty]
    }
}
set dont_record_command(ic_geo_list_families) 1

## List the current parts.

proc ic_geo_list_parts {{prefix ""} {non_empty 0}} {
    global projlib

    if {$projlib == ""} { return "" }
    foreach ff [$projlib list_families $non_empty] {
        set p [lindex [split $ff :] 0]
        if {($prefix == "") || [string match $prefix* $p]} {
            set found($p) 1
        }
    }
    return [array names found]
}
set dont_record_command(ic_geo_list_parts) 1

## Check if a part exists

proc ic_geo_check_part {name} {
    global projlib
    
    if {$projlib == ""} { return "" }
    foreach ff [$projlib list_families 0] {
        set p [lindex [split $ff :] 0]
        if {$p == $name} { return 1 }
    }
    return 0
}
set dont_record_command(ic_geo_check_part) 1

## List the current families in a part.

proc ic_geo_list_families_in_part {part} {
    global projlib
    
    if {$projlib == ""} { return "" }
    set ret ""
    foreach ff [$projlib list_families 0] {
        if {($ff == $part) || [string match $part:* $ff]} {
            lappend ret $ff
        }
    }
    return $ret
}
set dont_record_command(ic_geo_list_families_in_part) 1

## List the families in a group

proc ic_geo_list_families_with_group {gname} {
    set ret ""
    foreach fam [ic_geo_list_families] {
        if [lmember [split $fam :] $gname] {
            lappend ret $fam
        }
    }
    return $ret
}
set dont_record_command(ic_geo_list_families_with_group) 1

## List the parts that have some family in a group

proc ic_geo_list_parts_with_group {gname} {
    foreach f [ic_geo_list_families_with_group $gname] {
        set found([lindex [split $f :] 0]) 1
    }
    return [array names found]
}
set dont_record_command(ic_geo_list_parts_with_group) 1

## Return whether or not the family is empty of entities

proc ic_geo_family_is_empty {fam} {
    global projlib
    if {$projlib == ""} { return 1 }
    set p [$projlib lookup_family_pid $fam]
    if {"" == $p} { return 1 }
    if {[$projlib get_objects_in_family "" $p even_if_dormant] != ""} {
        return 0
    }
    return 1
}
set dont_record_command(ic_geo_family_is_empty) 1

## Return whether or not the family contains only dormant entities

proc ic_geo_family_is_empty_except_dormant {fam} {
    global projlib
    if {$projlib == ""} { return 0 }
    set p [$projlib lookup_family_pid $fam]
    if {$p == ""} { return 0 }
    if {[$projlib get_objects_in_family "" $p] == ""} {
        if {[$projlib get_objects_in_family "" $p only_if_dormant] != ""} {
	    return 1
	}
    }
    return 0
}
set dont_record_command(ic_geo_family_is_empty_except_dormant) 1

## List all the non-empty families
## Note this doesn't check whether there are directives

proc ic_geo_non_empty_families {} {
    return [ic_geo_list_families 0 1]
    
    this is the old way
    set ret ""
    foreach f [ic_geo_list_families] {
	if ![ic_geo_family_is_empty $f] { lappend ret $f }
    }
    return $ret
}
set dont_record_command(ic_geo_non_empty_families) 1

## List all the families containing only dormant entities
## Note this doesn't check whether there are directives

proc ic_geo_non_empty_families_except_dormant {} {
    set ret ""
    foreach f [ic_geo_list_families] {
	if [ic_geo_family_is_empty_except_dormant $f] { lappend ret $f }
    }
    return $ret
}
set dont_record_command(ic_geo_non_empty_families_except_dormant) 1

## Return the number of objects of the given type.

proc ic_geo_num_objects {type} {
# for body using: "list_bsp_objects $type number"
# "num_objects" has some specific "types", e.g. "all" 
    global projlib
    if {$projlib == ""} { return 0 }
    if {$type == "body"} {
		return [$projlib list_bsp_objects $type number]
	}
    return [$projlib num_objects $type]
}
set dont_record_command(ic_geo_num_objects) 1

## Return the number of visible objects of the given type.

proc ic_geo_list_visible_objects {type {even_if_dormant 1}} {
# This is useful for point and curves. For other types duplicated funtionality
    global projlib
    if {$projlib == ""} { return 0 }
    if {$type == "entity"} {
	set type "point curve surface material loop density body"
    }
    set list ""
    foreach t $type {
		if $even_if_dormant {
			set c [$projlib list_bsp_objects $t names only_if_visible even_if_dormant]
		} else {
			set c [$projlib list_bsp_objects $t names only_if_visible]
		}
		if {$c != ""} {
			append list $c " "
		}
	}

    return $list
}
set dont_record_command(ic_geo_list_visible_objects) 1

## Return the number of visible objects of the given type.  If any is 1 then
## just say whether that number is more than 0

proc ic_geo_num_visible_objects {type {any 0}} {
    global projlib
    if {$projlib == ""} { return 0 }
    if {$type == "entity"} {
	set type "point curve surface material loop density body"
    }
    set nv 0
    foreach t $type {
			set n [$projlib list_bsp_objects $t number only_if_visible]
			if {$any && $n} {return 1}
			incr nv $n
    }
    return $nv
}
set dont_record_command(ic_geo_num_visible_objects) 1

## Return the number of triangles or bars, and nodes in this object.

proc ic_geo_num_segments {type name} {
    global projlib
    switch $type {
	surface {
	    set surfno [$projlib get_number_by_name surface $name]
	    return [$projlib surface_num_tris $surfno]
	}
	default {
	    return "0 0"
	}
    }
}
set dont_record_command(ic_geo_num_segments) 1

## Change the geometry with the given type and name to family <b>newfam</b>.
## The first argument tells the type of geometry objects:
## surface, curve, material, point, density, or loop.
## The second argument is the new family name tobe set.
## The third argument tells how to select the
## objects and the fourth is the list of object specifiers.  <b>how</b> can be:
## <ul>
## <li> <b>names</b> : a list of the names of the objects
## <li> <b>numbers</b> : a list of the internal numbers (not for general
## consumption)
## <li> <b>patterns</b> : a list of glob-patterns that match the names of
## the objects
## <li> <b>families</b> : a list of the families to select
## <li> <b>all</b> : all objects of that type (the objects list is ignored)
## <li> <b>visible</b> : all visible objects of that type
## (the objects list is ignored)
## <li> <b>rename</b> : if 1, change the name of the object to match the new
## family, if appropriate.  Note that if this function is called as part of
## a larger script, this renaming might break things if other parts of the code
## think they know the names of the objects they are dealing with and those
## names change beneath them.
## </ul>

proc ic_geo_set_family {type newfam how objs {rename 1}} {
    global projlib batch_mode

    set maxlen [ic_geo_get_valid_namelen]
    if {[string len $newfam] > $maxlen} {
        mess "Part name too long; max $maxlen characters allowed\n" red
        return ""
    }
    set ta [tdv_active 0]
    set new_obj_names ""    
    set objs [geo_lookup $type $how $objs 0 1]
    set new_family [ic_geo_new_family $newfam]
    foreach obj $objs {
	    set name [$obj get -name]
		set new_name $name
	    set fam [ic_geo_get_family $type $name]
		if {$newfam == $fam} continue
	    if $rename {
		# if old style name ("fam/name") replace any fam
		# if new style name (any_text.any_text) replace only if name starts from family
			set n [string first "/" $name]
			if {$n < 0} {
				set n [string first ${fam}. $name]
				if {$n == 0} {
				    incr n [string length $fam]
				} else {
					set n -1
				}
			}
			if {$n > 0} {
			    set new_name ${newfam}[string range $name $n end]
			    set new_name [ic_geo_set_name $type $name $new_name 0 1]			 
	        }
	    }
        set num [$projlib get_number_by_name $type $new_name]
	    $projlib set_family $type $num $newfam
	    update_geom_object $obj
	    update_geom_visible_obj $obj
	    lappend new_obj_names $new_name
    }
    tdv_active $ta
    return $new_obj_names
}

## Move stuff from one part to a new one.  This has to create the new part name
## and copy the bc's if necessary so that the other groups in the family are not
## disturbed

proc ic_geo_set_part {type names newpart {rename_part 1}} {
    set maxlen [ic_geo_get_valid_namelen]
    if {[string len $newpart] > $maxlen} {
        mess "Part name too long; max $maxlen characters allowed\n" red
        return
    }
    set ta [tdv_active 0]
    foreach name $names {
        set oldfam [ic_geo_get_family $type $name]
	    set newfam [ic_boco_change_part $oldfam $newpart]
        if [ic_geo_new_family $newfam] {
            ic_boco_set $newfam [ic_boco_get $oldfam]
        }
        ic_geo_set_family $type $newfam names [list $name] $rename_part	
	    ic_boco_add_or_remove_bc_icons $oldfam 0 [list $type $name]
	    ic_boco_add_or_remove_bc_icons $newfam 1 [list $type $name]
    }
    tdv_active $ta
}

## Change the geometry with the given type and name to name <b>newname</b>.
## If <b>make_new</b> is 1 then an unused name that starts with <b>newname</b>
## is used and this value is returned from the function.  If possible
## <b>newname</b> is used without modification.
## <p>If <b>make_new</b> is 0 then any objects of that same type and name
## that already exist will be deleted first.

proc ic_geo_set_name {type name newname {make_new 0} {warn 1}} {
    global projlib

    set num [$projlib get_number $type $name]
    if {$num == -1} {
		mess "No such $type $name" red
		return ""
	}
    set obj [$projlib get_object $type $num]
    if !$make_new {
		set newnum [$projlib get_number $type $newname]
		if {$newnum >= 0} {
	        if $warn {
		        mess "Warning: \"$newname\" was already taken - new name used instead\n" red
	        }
			set make_new 1
		}
	}
    if $make_new {
		set newname [$projlib new_name $type $newname 1]
    }  
    $obj configure -name $newname
    $projlib rename_entity $type $num $newname
    return $newname
}

proc ic_geo_get_valid_namelen {} {
    return [get_valid_family_namelen]
}
set dont_record_command(ic_geo_get_valid_namelen) 1

## Rename the family.  All objects in <b>fam</b> will now be in <b>nfam</b>.
## If "rename_ents" is set, family entities will be renamed

proc ic_geo_rename_family {fam newfam {rename_ents 1}} {
    global projlib famboco_obj uns_families_have_dimension
    
    # HACK - USED IN THE BOCO EDITING CODE - SHOULD CHANGE
    catch { unset uns_families_have_dimension }    
    if {$projlib == ""} return   
    set maxlen [ic_geo_get_valid_namelen]
    if {[string len $newfam] > $maxlen} {
        mess "Part name too long; max $maxlen characters allowed\n" red
        return
    }
    if {[llength $fam] > 1} {
        foreach f $fam {
            ic_geo_rename_family $f $newfam $rename_ents
        }
        return
    }
    set objs [geo_lookup all families $fam]
    if {$projlib != ""} {
        $projlib rename_family $fam $newfam
        foreach obj $objs {
            set name [$obj get -name]
	        set num [$obj get -number]
            set type [$obj get -type]
            $projlib set_family $type $num $newfam
            if $rename_ents {
                foreach t {/ .} {
                    if [regexp $t $name dummy dummy] {
                        set new_name [string tolower $newfam]
                        append new_name $t
                        append new_name [join [lrange [split $name $t] 1 end] $t]
                        if {[$projlib get_number $type $new_name] != -1} {
                            set new_name [ic_geo_set_name $type $name $new_name 1 0]
                        } else {
                            set new_name [ic_geo_set_name $type $name $new_name 0 0]
                        }
                        break
                    }
                }
	        }
	        if {$famboco_obj != ""} {
		        $famboco_obj change_family_bc_icons $fam $newfam
	        }
            update_geom_object $obj
	    }
    }
}

## For two geometry entities of <b>type</b>, the first, of name <b>e1name</b>,
## will be replaced by the second, of name <b>e2name</b>, as well as being put
## into the family of the first entity and having the meshing parameters 
## copied from the first to the second. The name of the first entity
## is appended with _OLD and put into the family ORFN.

proc ic_geo_replace_entity {type e1name e2name } {    
    #- (Cf. Bug#: 2880 in Bugzilla)
    
    #- copy all meshing parameters from e1 to e2
    set e1params [ic_set_meshing_params $type $e1name]
    foreach {name val} $e1params {
	ic_set_meshing_params $type $e2name $name $val
    }
    
    set e1fam [ic_geo_get_family $type $e1name]
    set e2fam [ic_geo_get_family $type $e2name]
    if {$e1fam != $e2fam} { ic_geo_set_family $type $e1fam names $e2name }
    
    #- remove entity name from e1 (put it into family ORFN)
    set trash_name ${e1name}_OLD
    ic_geo_set_name $type $e1name $trash_name
    set trash_fam ORFN
    ic_geo_set_family $type $trash_fam names $trash_name
    
    #- give original name of e1 to e2
    ic_geo_set_name $type $e2name $e1name
}

## Get the reference mesh size.  This is used to scale all meshing parameter
## values for display to the user.

proc ic_geo_get_ref_size {} {
    global projlib
    return [$projlib get_ref_size]
}
set dont_record_command(ic_geo_get_ref_size) 1

## Set or get the meshing parameters associated with the model or the geometry.
## The <i>type</i> and <i>num</i> arguments define what the parameters are
## being defined for.  The remaining arguments are name/value pairs, so
## that the function call might look like
## <br><b>ic_set_meshing_params surface 2 emax 10 erat 13</b><br>
## The <i>num</i> argument can also be a name.
## <p>
## Any or all of the meshing parameters can be specified, and the ones
## not given are not modified.  Note that all the sizes are in absolute
## units, not factors of the reference size.  This is different from what
## the user sees in the GUI.
## <p>
## <i>type</i> can be one of:
## <ul>
## <li> <b>global</b> : set or get the global parameters like natural size,
## etc.  The <i>num</i> argument is ignored.  The parameters that are accepted
## are:
## <ul>
## <li> <b>gref</b> : the reference size for the model
## <li> <b>gmax</b> : the maximum size of any element in the mesh
## <li> <b>gnat</b> : the natural size value
## <li> <b>gnatref</b> : the natural size refinement factor
## <li> <b>gedgec</b> : the edge criterion
## <li> <b>gcgap</b> : the number of cells allowed in a gap
## <li> <b>gttol</b> : the triangularization tolerance
## <li> <b>gfast</b> : if the value is 1 then set fast transition
## <li> <b>igwall</b> : if the value is 1 then ignore wall thickness
## <li> <b>grat</b> : the growth ratio value
## </ul>
## <li> <b>curve</b> : set or get the parameters on curve <i>num</i>
## The parameters that are accepted are:
## <ul>
## <li> <b>emax</b> : the maximum element size
## <li> <b>ehgt</b> : the maximum height
## <li> <b>erat</b> : the size expansion ratio
## <li> <b>ewid</b> : the number of layers of tetrahedra of the same size
## that should surround a surface
## <li> <b>nlay</b> : the number of quad offset layers
## <li> <b>emin</b> : the minimum size
## <li> <b>edev</b> : the deviation value
## </ul>
## <li> <b>surface</b> : set or get the parameters on surface <i>num</i>
## The parameters that are accepted are:
## <ul>
## <li> <b>emax</b> : the maximum element size
## <li> <b>ehgt</b> : the maximum height
## <li> <b>erat</b> : the size expansion ratio
## <li> <b>hrat</b> : the height expansion ratio
## <li> <b>ewid</b> : the number of layers of tetrahedra of the same size
## that should surround a surface
## <li> <b>nlay</b> : the number of prism layers
## <li> <b>emin</b> : the minimum size
## <li> <b>edev</b> : the deviation value
## </ul>
## <li> <b>point</b> : set or get the parameters on prescribed point <i>num</i>
## The parameters that are accepted are:
## <ul>
## <li> <b>ehgt</b> : the maximum height
## <li> <b>erat</b> : the size expansion ratio
## <li> <b>hrat</b> : the height expansion ratio
## </ul>
## <li> <b>density</b> : set or get the parameters on density volume <i>num</i>
## The parameters that are accepted are:
## <ul>
## <li> <b>emax</b> : the maximum element size
## </ul>
## <li> <b>loop</b> : set or get the parameters on loop <i>num</i>
## The parameters that are accepted are:
## <ul>
## <li> <b>etyp</b> : the element type
## </ul>
## <li> <b>curve_fam, surface_fam, point_fam</b> :
## set or get the parameters on all objects of the family <i>num</i>
## (in this case <i>num</i> is not a number but a family name).  The accepted
## parameters are the same as the ones listed above for individual objects.
## </ul>
## The return value of this function is a list of names and values in the
## same format as the arguments, which are the values after the modification.
## Therefore to get the current values you can just call
## <br><b>ic_set_meshing_params</b> <i>type</i> <i>num</i><br>
## with no other arguments.
## <p>
## Note that if you give a family instead of a number then you will get the
## parameters only for one of the objects in that family.

proc ic_set_meshing_params {type num args} {
    global projlib env

    if {$projlib == ""} { error "No tetin database is available" }
    if {[ic_wb2_input_parameter_mode] && [llength $num] == 1} {
        if {($args != "") && ($type == "global" || $type == "surface_global" || $type == "prism" || $type == "variable" || $type == "curve" || $type == "surface" || $type == "density")} {
            set args2 ""
            foreach "n v" $args {
                if [ic_wb2_is_input_meshing_param_set $n $type $num] continue
                lappend args2 $n $v
            }
            set args $args2
        }
    }
    if {[llength $num] > 1} {
        foreach n $num {
            eval ic_set_meshing_params $type $n $args
        }
        return
    }
    set type0 [lindex [split $type _] 0]
    set type1 [lindex [split $type _] 1]
    if {$type0 == "curve" && $args != ""} {
        set argsn ""
        foreach {n v} $args {
            if {$n == "hrat"} {set hrat $v; continue}
            if {$n == "erat"} {set erat $v; continue}
            lappend argsn $n $v
        }
        if [info exists hrat] {
            lappend argsn erat $hrat
        } elseif [info exists erat] {
            lappend argsn erat $erat
        }
        set args $argsn
    }
    if {$type1 == "fam"} {
        set pid [$projlib lookup_family_pid $num]
        if {$pid == ""} { error "no such family $num" }
        if {$pid == 0} return ;# don't like to set this for orfn

        # First set it for the family and then for all the objects in
        # the family.
        eval $projlib set_meshing_params $type $pid $args

        set type type0
        set num [$projlib get_objects_in_family $type $pid]
        if {$num == ""} { return "" }
    } elseif {$type1 == "all"} {
        set num ""
        foreach fam [$projlib list_families 0] {
            set pid [$projlib lookup_family_pid $fam]
            if {$pid == 0} continue ;# don't like to set this for orfn
            set type $type0
            set ff [$projlib get_objects_in_family $type $pid]
            if {$ff == ""} continue

            # First set it for the family and then for all the objects in
            # the family.
            eval $projlib set_meshing_params $type $pid $args
            set num [concat $num $ff]
        }
        if {$num == ""} { return "" }
    } elseif {$type == "global" || $type == "surface_global" ||
               $type == "prism" || $type == "variable"} {
        set num 0
    } else {
        if {"" == [ic_geo_check_objects_exist $type $num]} {
            return
        } elseif {![regexp {^[0-9]+$} $num dummy]} {
            set num [$projlib get_number $type $num]
        }
    }
    foreach n $num {
        if {$n < 0} { error "no such $type found" }
        set ret [eval $projlib set_meshing_params $type $n $args]
        if {($args != "") && ($type != "global" && $type != "surface_global" &&
             $type != "prism" && $type != "variable")} {
            set obj [$projlib get_object $type $n]
            if {$obj != ""} {
                $obj signal_change 0
            }
        }
    }
    if {$args != ""} {
        $projlib configure -modified 1
    }
    if {$type == "curve"} {
        set i [lsearch $ret erat]
        if {$i > -1} {set ret [lreplace $ret $i $i hrat]}
    }
    return $ret
}

## Get mesh growth ratio.
proc ic_get_mesh_growth_ratio {} {
    set curVals [ ic_get_meshing_params global 0 ]
    array set valArray $curVals
    return $valArray(grat)
}
set dont_record_command(ic_get_mesh_growth_ratio) 1

## Get the meshing parameters.  This has the advantage over
## ic_set_meshing_params that it is not recorded in the replay file.

proc ic_get_meshing_params {type num} { 
    #if [ic_wb2_is_running] { ic_wb2_update_parameters input }
    return [ic_set_meshing_params $type $num]
}
set dont_record_command(ic_get_meshing_params) 1

## Scale the meshing parameters on geometric entities of <b>types</b>
## by a <b>factor</b>. If <i>types</i> is <i>all</i> then rescales
## entities of types "surface curve point material density loop"

proc ic_geo_scale_meshing_params {types factor} {
    set ofact [ic_geo_get_ref_size]
    if {$factor == $ofact} return

    #if {"all" == $types} { set types "surface curve point material density loop" }

    # scale volume family params for Hexa-Core
    if {"all" == $types} {
        foreach fam [concat [ic_geo_list_families 1] [ic_hex_list_block_families]] {
            set v [ic_geo_get_family_param $fam emax]
            if {$v != ""} {
                set v [expr $v / $ofact * $factor]
                ic_geo_set_family_params $fam emax $v
            }
        }
    }

    if {"all" == $types} { set types [ic_geo_get_types] }
    foreach type $types {
        foreach name [ic_geo_get_objects $type] {
            set params [ic_set_meshing_params $type $name]
            set nparams ""
            foreach {n v} $params {
                if {($n == "emax") || ($n == "emin") || ($n == "edev")} {
                    set v [expr $v / $ofact * $factor]
                }
                lappend nparams $n $v
            }
            if {$nparams != ""} {
                eval ic_set_meshing_params $type \"$name\" $nparams
            }
        }
    }
}

## set curve bunching
proc ic_geo_set_curve_bunching {curves args} {
    global projlib

    foreach curve $curves {
	set stat [eval $projlib set_curve_bunching $curve [join $args]]
    }
    $projlib configure -modified 1
}

## get curve bunching
proc ic_geo_get_curve_bunching {name} {
    global projlib

    set cnum [$projlib get_number curve $name]
    set res [eval $projlib get_curve_bunching $cnum]
    return $res
}
set dont_record_command(ic_geo_get_curve_bunching) 1


## Create new surfaces by segmenting an existing one.  The <b>name</b>
## argument is the name of the existing surface.  The <b>how</b> argument
## describes how to do the segmentation:
## <ul>
## <li> <b>angle</b> : split the surface where the angle exceeds the given
## value (see below)
## <li> <b>curve</b> : split the surface at the named curves (see below)
## <li> <b>plane</b> : split the surface at the given plane (see below)
## <li> <b>connect</b> : split the surface by connectivity
## </ul>
## The remaining optional arguments are:
## <ul>
## <li> <b>angle</b> : the angle to use for splitting
## <li> <b>mintri</b> : the smallest number of triangles to allow in a surface
## <li> <b>curves</b> : a list of curve names to use for splitting
## <li> <b>plane_p</b> : the point to define the plane (in the current LCS)
## <li> <b>plane_n</b> : the normal to define the plane
## <li> <b>keep_old</b> : if 1 then keep the old surface after segmentation.
## The default is 0
## </ul>
## The return value is a list of numbers which are the newly created surfaces.

proc ic_geo_create_surface_segment {name how args} {
    global projlib
    
    set angle 0
    set mintri 0
    set curves ""
    set plane_p "0 0 0"
    set plane_n "0 0 0"
    set keep_old 0
    
    foreach {a v} $args { set $a $v }
    set bsp [$projlib get_number surface $name]
    if {$bsp == "-1"} { return "" }
    # exists, but empty -> med crash
    if {[lindex [ic_geo_num_segments surface $name] 0] == "0"} { return "" }
    
    set obj [$projlib get_object surface $bsp]
    set plane_p [coords_into_global $plane_p]
    switch $how {
	angle {
	    set new [$projlib segment_surface_angle $bsp $angle $mintri]
	}
	curve {
		set fac_crvs ""
		set fac_new ""
		foreach crv $curves {
			set bsp [$projlib get_object_by_name curve $crv]
			if {$bsp == ""} continue
			if {[$bsp get_object_type] == "mesh"} {
				lappend fac_crvs $crv
			} else {
				lappend fac_new [ic_facetize_geometry curve $crv]
			}
		}
	    set new_names [eval $projlib segment_surface_curve $name "$fac_crvs $fac_new"]
	    ic_delete_geometry curve names $fac_new 0
	    set new ""
	    foreach i $new_names {
            lappend new [$projlib get_number surface $i]
	    }
	}
	plane {
	    set tol [expr [$projlib smallest_surface_triangle $bsp] * 0.001]
	    set new [$projlib segment_surface_plane $bsp $plane_p $plane_n]
	    foreach n $new {
            # The segmentation can create small gaps so we want to merge
            # the nodes using the old tolerance ...
            $projlib merge_surface_nodes_tol $n $tol
	    }
	}
	connect {
	    set new [$projlib segment_surface_connect $bsp]
	}
    }
    foreach n $new {
        set nb [define_geom_object surface $n]
        update_geom_visible_obj $nb
    }
    if {[llength $new] && !$keep_old} {
        set n [$obj get -bspline]
        delete_geom_object $obj
        $projlib delete_surface $n
    }

    set new_names ""
    foreach n $new {
        lappend new_names [$projlib get_name surface $n]
    }

    return $new_names
}

## Create new curves by segmenting an existing one.  The <b>name</b>
## argument is the name of the existing curve.  The <b>how</b> argument
## describes how to do the segmentation:
## <ul>
## <li> <b>angle</b> : split the curve where the angle exceeds the given
## value (see below)
## <li> <b>plane</b> : split the curve at the given plane (see below)
## <li> <b>connect</b> : split the curve by connectivity
## </ul>
## The remaining optional arguments are:
## <ul>
## <li> <b>angle</b> : the angle to use for splitting
## <li> <b>minedge</b> : the smallest number of edges to allow in a curve
## <li> <b>point</b> : point for splitting
## <li> <b>plane_p</b> : the point to define the plane
## <li> <b>plane_n</b> : the normal to define the plane
## <li> <b>keep_old</b> : if 1 then keep the old curve after segmentation.
## The default is 0
## </ul>
## The return value is a list of numbers which are the newly created curves.

proc ic_geo_create_curve_segment {name how args} {
    global projlib

    set angle 0
    set mintri 0
    set minedge 0
    set point "0 0 0"
    set plane_p "0 0 0"
    set plane_n "0 0 0"
    set keep_old 0
    
    foreach {a v} $args {
        set $a $v
    }
    if {[llength $point] == 1} {
#
#       Hopefully a point entity
        if [catch {ic_geo_get_point_location $point} coords]  {
            return -code error "Error parsing point data"
        } else {
            set point $coords
        }
    }

    if {[llength $plane_p] == 1} {
#
#       Hopefully a point entity
        if [catch {ic_geo_get_point_location $plane_p} coords]  {
            return -code error "Error parsing point data"
        } else {
            set plane_p $coords
        }
    }

    set bsp [$projlib get_number curve $name]
    set obj [$projlib get_object curve $bsp]
    
    switch $how {
        angle {
            set new [$projlib segment_curve_angle $bsp \
                         $angle $minedge]
        }
        point {
            set new [$projlib segment_curve_point $bsp $point]
        }
        plane {
            set new [$projlib segment_curve_plane $bsp \
                         $plane_p $plane_n]
        }
        connect {
            set new [$projlib segment_curve_connect $bsp]
        }
    }
    #   the segmentation returns proj integer id's
    set crv_out {}
    foreach n $new {
        set nb [define_geom_object curve $n]
        if {[ic_geo_crv_length [$nb get -name]] == 0} {
            delete_geom_object $nb
            $projlib delete_curve $n
        } else {
            update_geom_visible_obj $nb
            lappend crv_out [$nb get -name]
        }
    }
    if {[llength $new] && !$keep_old} {
        set n [$obj get -bspline]
        delete_geom_object $obj
        $projlib delete_curve $n
    }
    return $crv_out
}

## <table border>
## <tr><td><b>curve</b>	</td><td> name of the curve. </td></tr>
## <tr><td><b>points</b> </td><td>list of points </td></tr>
## <tr><td><b>return</b></td><td> Names of curve segments </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> This splits the curve in the specified order of the points
## </ul>
proc ic_geo_split_curve {curve points} {
    set curves $curve
    foreach point $points {
        set mindist 10000
        foreach crv $curves {
            set projpt [ic_geo_project_point curve $crv $point]
            set dist [ic_geo_pnt_dist $point $projpt]
            if {$dist < $mindist} {
                set mindist $dist
                set curve $crv
            }
        }
        if [catch {ic_geo_split_curve_at_point $curve $point} ret] {
            mess "Error: couldn't split curve: $curve at point: $point\n" red
            return  -code error "$ret"
        } else {
        }
        set index [lsearch $curves $curve]	
        set curves [join [lreplace $curves $index $index $ret]]
    }
    return $curves
}

## Split a curve at a point.
## <table border>
## <tr><td><b>curve</b>	</td><td> name of the curve. </td></tr>
## <tr><td><b>point</b> </td><td> may be a prescribed point name or {xyz} coordinates.</td></tr>
## <tr><td><b>tol  </b> </td><td> optional <i>on curve</i> tolerance</td></tr>
## <tr><td><b>return</b></td><td> Names of curve segments (usually 2)  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the trim operation does not segment the curve (e.g.
##	trim at curve endpoint), the result string will be empty.
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_split_curve_at_point.tcl">ic_geo_split_curve_at_point.tcl</a>.
## </ul>
proc ic_geo_split_curve_at_point {curve point {tol 0}} {
    global projlib
#
#   History---
#   08/08/02 -- AWM -- Modified error handling

    set pt_created_local 0
    if {[llength $point] > 1} {
        set fam [ic_geo_get_family curve $curve]
        set name [ic_geo_new_name point $fam. ]
        set point [ic_geo_cre_pnt $fam $name $point]
        set pt_created_local 1
    }

    set bsp [$projlib get_object_by_name curve $curve]
    if [catch {$bsp split $point $tol} new_curves] {
        # Delete construction geometry -- only do this on error
	    if {$pt_created_local} {
	        mess "Error: $new_curves\n" red
	        #mess "point $name deleted\n" blue
	        ic_delete_geometry point names $name
        }
        return -code error "$new_curves"
    }
    set ret ""
    if {$new_curves != ""} {
        delete_geom_object $bsp
        foreach n $new_curves {
            set nbsp [define_geom_object curve $n]
	        update_geom_visible_obj $nbsp
            #mess "New curve: name [$nbsp get -name], family [$nbsp get -family]\n"
	        lappend ret [$nbsp get -name]
        }
    }
    return $ret
}

## Create a loop with the given name and family using the specified
## curves.  If <b>how</b> is <b>names</b> then <b>curves</b> is a list of
## the names of the curves to use, and if it's <b>families</b> then it's a
## list of family names.  If <b>all_separate</b> is 1 then all the curves
## are considered individually and if it is 0 then they are all taken
## together to create the loop.  Surfaces are associated to the loop if
## a list <b>surfs</b> of names of surfaces is given. Optionally the loops
## can be set to the families in the list <b>fams</b> in order, in the case of
## <b>all_separate</b> is 1.  Points can be added to a loop if
## a list <b>points</b> of names of points is given.

proc ic_geo_create_loop {name fam how curves all_separate surfs {fams ""} {pts ""} {crs ""}} {
    global projlib batch_mode
    global tdv_default
    
    switch $how {
        all {
            set cnames [$projlib list_bsp_objects curve names]
		}
        names {
		 set cnames $curves 
		 }
        families {
            set cnames ""
            foreach f $curves {
                set p [$projlib lookup_family_pid $f]
                foreach c [$projlib get_objects_in_family curve $p] {
                    lappend cnames [$projlib get_name curve $c]
                }
            }
        }
        default { error "how must be either names, all, or families" }
    }
    if {$fam != "" && [ic_geo_new_family $fam] && !$batch_mode} {
        update_fam_window
    }
    set loops ""
    if $all_separate {
        foreach cn $cnames sn $surfs fn $fams {
            if {$fam == "" && $fn != ""} {
                set loop_family $fn
            } else {
                set loop_family $fam
            }
            if {$cn != ""} {
                set new [$projlib create_face_surface $name $loop_family $cn $sn $pts $crs]
                set bsp [define_geom_object loop $new]
                lappend loops [$bsp get -name]
                if !$batch_mode {
                     update_geom_visible_obj $bsp
                }
            } else {
                ic_mess "Can't create loop without boundary\n" red
            }
        }
    } else {
        if {$cnames != ""} {
            set new [$projlib create_face_surface $name $fam $cnames $surfs $pts $crs]
            set bsp [define_geom_object loop $new]
            lappend loops [$bsp get -name]
            if !$batch_mode {
                update_geom_visible_obj $bsp
            }
        } else {
            ic_mess "Can't create loop without boundary\n" red
        }
    }
    return $loops
}

## Modify 1 loop with the given name using the specified curves, 
## points and surfaces.  A list of names of <b>curves</b> must be 
## given.  Surfaces are associated to the loop if a list <b>surfs</b> 
## of names of surfaces is given. Points/corners can be added to a 
## loop if a list <b>points</b> of names of points/corners is given.

proc ic_geo_modify_loop {name curves {surfs ""} {pts ""} {crs ""}} {    
    set fam [ic_geo_get_family loop $name]
    ic_delete_geometry loop names $name
    return [ic_geo_create_loop $name $fam names $curves 0 $surfs "" $pts $crs]
} 

## Select a geometric entity on the screen.  Arguments are:
## <ul>
## <li> <b>line</b> <i>{{x y z} {x y z}}</i> : the line in model space
## <li> <b>type</b> <i>type</i> : one of: entity, surface, curve, point,
## material, loop, or density
## </ul>
## The return value is a list that contains the type, name, and location
## on the object.

proc ic_geo_pick_location {args} {
	global tdv_default
    set line ""
    set type entity
    foreach {n v} $args {
		switch $n {
	line { set $n $v }
	type { lappend $n $v }
	default { error "Unknown option $n $v" }
    }
    }
    if {$line == ""} { error "Must specify a line as pt1 pt2 in space" }
    
    set ret [$tdv_default pick_model [lindex $line 0] [lindex $line 1] \
		 "" geom_$type]
    if {$ret == ""} { return "" }
    set type [[lindex $ret 0] get -type]
    set name [[lindex $ret 0] get -name]
    set pos [lindex $ret 2]
    return [list $type $name $pos]
}
set dont_record_command(ic_geo_pick_location) 1

## Say whether an object is type <b>param</b> (a trimmed NURBS curve or
## surface) or <b>mesh</b> (a faceted surface or piecewise linear curve).
## If both types are present in the list of names <b>mixed</b> is returned.

proc ic_geo_get_object_type {type names} {
    global projlib

    set faceted 0
    set nonfaceted 0
    foreach name $names {
	set obj [$projlib get_object_by_name $type $name]
	if {[$obj get_object_type] == "mesh"} {
	    set faceted 1
	} else {
	    set nonfaceted 1
	}
    }
    if {$faceted && !$nonfaceted} {
	return "mesh"
    } elseif {!$faceted && $nonfaceted} {
	return "param"
    } else {
	return "mixed"
    }
}
set dont_record_command(ic_geo_get_object_type) 1

## Trim the surface by the curves.  This creates a new surface with the name
## of the old surface followed by <b>.cut.$n</b>.
proc ic_geo_trim_surface {surf curves {build_topo 1}} {
# Last mod 03/28/06: optional build_topo - delete curves, points if build_topo = 0
# Move to projlib
    global projlib batch_mode
    
    set check_deleted ""
    foreach crv [ic_geo_boundary surface $surf] {
	    lappend check_deleted [$projlib get_object_by_name curve $crv]
    }
    set smrf_type [ic_geo_get_object_type surface $surf]
    set unused ${surf}____unused____name____
    ic_geo_duplicate surface $surf $unused
    set new_entities [eval $projlib trim_surface $surf $curves]
    if {[ic_geo_check_objects_exist surface $surf] == ""} {
        ic_geo_duplicate surface $unused $surf
    }
    if {[ic_geo_check_objects_exist surface $unused] != ""} {
        ic_delete_geometry surface names $unused
    }
    foreach i $new_entities {
        set type [ lindex $i 0 ]
        if {$type == "surface"} {
            define_geom_objects2 $type [ lindex $i 1 ]
        }
        if { $type == "point" || $type == "curve"} {
            if $build_topo {
                define_geom_objects2 $type [ lindex $i 1 ]
            } else {
                foreach na [ lindex $i 1 ] {
                    set n [$projlib get_number $type $na]
                    $projlib delete_$type $n
                }
            }
        }
    }
    if {$smrf_type != "mesh"} {
	    #  mesh surfaces were getting deleted 
	    set command [$projlib get_object_by_name surface $surf]
	    if {$command != ""} {
            $command signal_change 1
        } else {
            mess "Can not get_object_by_name for surface $surf\n"
        }
    } 
    # Remove deleted curves from graphics
    if !$batch_mode {
	    foreach obj $check_deleted {
	        if {[info command $obj] == ""} {
		    # object doesn't exist anymore
		    continue
	    }
	        if {[$projlib get_number curve [$obj get -name]] < 0} {
		        delete_geom_object $obj
	        }
	    }
    }
    return $new_entities
}

## Intersect the surfaces and create new intersection curves in the
## given family.
## <table border>
## <tr><td><b>family	</b></td><td> family containing surface   </td></tr>
## <tr><td><b>surfs	</b></td><td> list of surfaces            </td></tr>
## <tr><td><b>bsp_flag	</b></td><td> == "use_bsp"   - create curves as b-spline   </td></tr>
## <tr><td><b>multi_flag</b></td><td> == "multi_crv" - create multiple curves      </td></tr>
## <tr><td><b>return    </b></td><td> names of created curves	  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> When multi_flag is set to "multi_crv", the function will produce 1 curve
##	for each connected component of the intersection.  When multi_flag
##	is set to "", the function will produce 1 unstructured curve.
## <li> Setting the bsp_flag to "use_bsp" implies setting the multi_flag
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_intersect_surfaces.tcl">ic_geo_intersect_surfaces.tcl</a>.
## </ul>
# This the new version from Matt Middleton
proc ic_geo_intersect_surfaces {fam surfs {bsp_flag ""} {multi_flag ""}} {
    global projlib
    if {$projlib == ""} { return -code error "ProjLib is not initialized" }

    set crv_name [ $projlib new_name curve $fam/ 0 ]
    if [catch {eval $projlib intersect_surfs $crv_name family \
	    ORFN $surfs no_self $bsp_flag $multi_flag} crv_list] {
	return -code error "$crv_list"
    } else {
	set crv_out ""
	if {$crv_list != ""} {
	    if [catch {ic_geo_new_family $fam} res] {
		return -code error "$res"
	    }
	}
	#   the intersector returns proj integer id's
	foreach crv_no $crv_list {
	    set nb [define_geom_object curve $crv_no]
	    $projlib set_family curve $crv_no $fam
	    lappend crv_out [$projlib get_name curve $crv_no]
	    update_geom_object $nb
	    update_geom_visible_obj $nb
	}
    }
    return $crv_out
}

# This function is from Matt Middleton
## Intersect surface groups.
## <br><b>groups </b> can be a list of two forms:
## <br>
## <ul><li>{srf1 srf2 srf3 ...}
## <li>{{srf1 srf2 srf3 ...} {srf4 srf5 srf6 ...} {srf7 srf8 srf9 ...} ...}
## </ul>
## In the first form, every surface is intersected with each other,
## but curves created from each surface pair intersection will be separate.
## In the second form, each set is intersected with every other set.
## Surfaces within each set will not be intersected with each other.  Separate
## curves are still generated from each surface pair intersection.

proc ic_geo_intersect_surfs_by_groups {groups {fam ""} {bsp_flag ""} {multi_flag ""}} {
    set ret_crvs {}
    set i 0
    if {[llength $groups] < 2} return
    if {$fam == ""} {
	set srf1 [lindex $groups 0]
	if {[llength $srf1] >1} {set srf1 [lindex $srf1 0]}
	set fam [ic_geo_get_family surface $srf1]
    }

    foreach set1 [lrange $groups 0 end-1] {
	incr i
	foreach set2 [lrange $groups $i end] {
	    set subset {}
	    foreach srf2 $set2 {
		if {[lsearch -exact $set1 $srf2] >= 0} {lappend subset $srf2}
	    }
	    foreach srf1 $set1 {
		if {[lsearch -exact $subset $srf1] >= 0} {set in_subset 1} \
		else {set in_subset 0}
		foreach srf2 $set2 {
		    if {$in_subset && ([lsearch -exact $subset $srf2] >= 0)} continue
		    if [catch {ic_geo_intersect_surfaces $fam "$srf1 $srf2" $bsp_flag $multi_flag} res] {
			return -code error "$res"
		    } else {eval lappend ret_crvs $res}
		}
	    }
	}
    }
    return $ret_crvs
}

## Create a piecewise linear curve from the points.  This curve is given
## the specified name and family.  <i>pts</i> is a list of triples of floating
## point numbers or list of prescribed point names and they are connected 
## in order.The points are in the current local coordinate system.

proc ic_geo_create_unstruct_curve_from_points {name fam pts} {
    global projlib
    
    create_empty_tetin_if_needed

    set new_fam [ic_geo_new_family $fam]
    
    set npts ""
    foreach p $pts {
	#Check if pts were passed by name
	if { [llength $p] == 1 } { 
	    set p [ic_geo_get_point_location $p] 
	    lappend npts $p
	} else {
	    lappend npts [coords_into_global $p]
	}
    }

    set cnum [$projlib create_unstruct_curve_from_points $name $fam $npts]
    set bsp [define_geom_object curve $cnum]
    $bsp configure -visible 1 
    display_update geo $new_fam   	
    $projlib configure -modified 1
    return [$bsp get -name]
}

## Create a surface from 4 points, with the given name and family.
## <i>pts</i> is a list of 4 triples of floating point numbers or 
## list prescribed point names and 2 triangles are created to make
## a rectangular surface. The points are in the current local 
## coordinate system.

proc ic_geo_create_unstruct_surface_from_points {name fam pts} {
    global projlib

    create_empty_tetin_if_needed

    set npts ""
    foreach p $pts {
	#Check if pts were passed by name
	if { [llength $p] == 1 } {
	    set p [ic_geo_get_point_location $p]
	    lappend npts $p
	} else {
	    lappend npts [coords_into_global $p]
	}
    }

    set cnum [eval $projlib create_unstruct_surface_from_points \"$name\" \
		  $fam $npts]
    set bsp [define_geom_object surface $cnum]
    update_geom_visible_obj $bsp
    return [$bsp get -name]
}

## Create an empty surface, with the given name and family.

proc ic_geo_create_empty_unstruct_surface {name fam} {
    global projlib

    create_empty_tetin_if_needed
    if {$name == ""} {
	set name [ic_geo_new_name surface "$fam."]
    }
    set cnum [eval $projlib create_unstruct_surface \"$name\" \
		  $fam 0 0 0 0 0]
    set bsp [define_geom_object surface $cnum]
    update_geom_visible_obj $bsp
    return [$bsp get -name]
}

## Create an empty curve, with the given name and family.

proc ic_geo_create_empty_unstruct_curve {name fam} {
    global projlib
    
    create_empty_tetin_if_needed
    if {$name == ""} {
	set name [ic_geo_new_name curve "$fam."]
    }
    set cnum [eval $projlib create_unstruct_curve \"$name\" \
		  $fam 0 0 0 0]
    set bsp [define_geom_object curve $cnum]
    update_geom_visible_obj $bsp
    return [$bsp get -name]
}

##  Create points at the ends of the named curve.
## <table border>
## <tr><td><b>names	</b></td><td> names of curve		</td></tr>
## <tr><td><b>return	</b></td><td> Names of created points	</td></tr>
## </table>
##  Note:  Function creates new points at curve endpoints as needed.
##  See also <a href="#ic_geo_mod_crv_set_end">ic_geo_mod_crv_set_end</a>
proc ic_geo_create_curve_ends {names} {
    global projlib
    if {$projlib == ""} { return -code error "ProjLib is not initialized" }   
    set npts ""
    foreach name $names {
    if {[$projlib get_number curve $name] < 0} continue
	set pts [$projlib create_curve_ends $name]
	foreach pt $pts {
	    if {[$projlib get_number point $pt] != -1} {
		define_geom_objects2 point $pt
		lappend npts $pt
	    }
	}
    }
    return $npts
}

## Set Curve end
## <table border>
## <tr><td><b>crv	</b></td><td> name of curve		</td></tr>
## <tr><td><b>pnt	</b></td><td> name of prescribed point	</td></tr>
## <tr><td><b>crvend	</b></td><td> curve end indicator	</td></tr>
## <tr><td><b>tol	</b></td><td> merge tolerance    	</td></tr>
## <tr><td><b>return	</b></td><td> Name of curve vertex	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The curve end parameter, crv1end, takes the values
##	<table>
##      <tr><td> start point      </td><td> 0 </td></tr>
##      <tr><td>   end point      </td><td> 1 </td></tr>
##      </table>
## <li> If the curve end is already associated, the function
##	will take no action.  The name of the curve end will
##	be returned in any case.
## <li> If the merge tolerance is set negative, the tolerance
##	will default to the triangulation tolerance.
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_mod_crv_set_end.tcl">ic_geo_mod_crv_set_end.tcl</a>.
## </ul>
proc ic_geo_mod_crv_set_end {crv pnt crvend {tol -1}} {
    global projlib
#
#   History---
#   05/26/02 -- AWM
#	     -- Created
    
    if [catch {$projlib get_number_by_name curve $crv} crvNum] {
	return -code error "$crvNum, $crv"
    }
    if [catch {$projlib get_number_by_name point $pnt} pntNum] {
	return -code error "$pntNum, $pnt"
    }

    if [catch {gk_mod_crv_set_end $crvNum $pntNum $crvend $tol} res] {
        return -code error $res
    } else {
        return $res
    }
}

## Get Curve end
## <table border>
## <tr><td><b>crv	</b></td><td> name of curve		</td></tr>
## <tr><td><b>crvend	</b></td><td> curve end indicator	</td></tr>
## <tr><td><b>return	</b></td><td> Name of curve vertex	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The curve end parameter, crv1end, takes the values
##	<table>
##      <tr><td> start point      </td><td> 0 </td></tr>
##      <tr><td>   end point      </td><td> 1 </td></tr>
##      </table>
## <li> If the curve end not already associated, the function
## will return an error which needs to be caught.
## </ul>
proc ic_geo_crv_get_end {crv crvend} {
    global projlib
#
#   History---
#   05/26/02 -- AWM
#	     -- Created
    
    if [catch {$projlib get_number_by_name curve $crv} crvNum] {
	return -code error "$crvNum, $crv"
    }

    if [catch {gk_crv_get_end $crvNum $crvend} res] {
        return -code error $res
    } else {
        return $res
    }
}
set dont_record_command(ic_geo_crv_get_end) 1

## Create points at the intersection of curves.
## <i>curves</i> is a list of curves to intersect.  

proc ic_geo_create_points_curveinter {curves tol fam {name ""}} {
    global projlib

    if {$name == ""} {set name ${fam}/}
    set curvenums ""
    foreach c $curves {
	lappend curvenums curve:[$projlib get_number curve $c]
    }
    
    set pts [$projlib intersect_curves $curvenums $tol ]
    set npts ""
    foreach pt $pts {
	lappend npts [ic_geo_cre_pnt $fam $name $pt 0]
    }
    return $npts
}

## This function has been replaced by <b>ic_geo_cre_pnt</b>

proc ic_geo_create_point_location {fam pt {in_lcs 1}} {
    global projlib
    set name [$projlib new_name point $fam/ 0]
    return [ic_geo_cre_pnt $fam $name $pt $in_lcs]
    
    
    
    not used
    
    if $in_lcs { set pt [coords_into_global $pt] }

    set name [$projlib new_name point $fam/ 0]
    set new [$projlib create_point $name $fam $pt]
    
    set bsp [define_geom_object point $new]
# the newly created point should be visible
    $bsp configure -visible 1

    mess "New point: name [$bsp get -name], family [$bsp get -family]\n"
    return [$bsp get -name]
}

## This function has been replaced by <b>ic_geo_cre_mat</b>

proc ic_geo_create_material_location {fam pt} {
    global projlib
    set name [$projlib new_name material $fam/ 0]
    return [ic_geo_cre_mat $fam $name $pt 1]



    not used

    set pt [coords_into_global $pt]

    if {$pt == "outside"} {
	set bb [ic_geo_bounding_box all]
	set min [lindex $bb 0]
	set max [lindex $bb 1]
	set pt ""
	foreach i {0 1 2} {
	    lappend pt [expr 2 * [lindex $min $i] -  [lindex $max $i]]
	}
    }

    ic_uns_new_family $fam
    ic_geo_new_family $fam

    set name [$projlib new_name material $fam/ 0]
    set new [$projlib create_material $name $fam $pt]

    set bsp [define_geom_object material $new]
    update_geom_visible_obj $bsp
    mess "New material: name [$bsp get -name], family [$bsp get -family]\n"
    return [$bsp get -name]
}

##  Create a density polygon from a set of points.  It is given the specified
##  name and tetra size. Stretch factor with direction may be specified
##  optionally.
##  <table border>
##  <tr><td> name </td><td> Name of polygon</td></tr>
##  <tr><td> size </td><td> tetra size (must be &gt; 0)</td></tr>
##  <tr><td> pts  </td><td> list of points (must have 4 or more)</td></tr>
##  <tr><td> width </td><td> size of constant spacing layer </td></tr>
##  <tr><td> ratio </td><td> expansion rate</td></tr>
##  <tr><td> strfac </td><td> stretch factor </td></tr>
##  <tr><td> strvec </td><td> stretch direction </td></tr>
##  </table>
##
##  Note:
##  <ul>
##  <li> Points may be passed either as 3-tuples or as names of prescribed
##	 points
##  </ul>

proc ic_geo_create_density {name size pts {width 0.0} {ratio 0.0} \
                            {strfac 1.0} {strvec ""}} {
    global projlib batch_mode

    create_empty_tetin_if_needed

    if { $name == "" } {
	set name [ic_geo_new_name density "density."]
    }

    if { $size <= 0 } {
	mess "Error: Size, $size, must be positive\n" red
        return ""
    }

    set pts2 ""
    #Check if pts were passed by name
    foreach p $pts {
	if { [llength $p] == 1 } {
	    set p [ic_geo_get_point_location $p]
	    lappend pts2 $p
	} else {
	    lappend pts2 [coords_into_global $p]
	}
    }

    set new [eval $projlib create_density \"$name\" $size \
	    $width $ratio $strfac \"$strvec\" $pts2]
    set bsp [define_geom_object density $new]
    set clr [$projlib get -density_color]
    if {$clr != ""} {$bsp configure -color $clr}

    if !$batch_mode {
        update_geom_visible_obj $bsp
	display_update geo
    }
    return $name
}

proc ic_geo_get_density_color {{get_default_color 0}} {
    global projlib
    if {$projlib == "" || $get_default_color} {
        set clr \#ff8000
    } else {
        set clr [$projlib get -density_color]
        if {$clr == ""} {set clr \#ff8000}
    }
    return $clr
}
set dont_record_command(ic_geo_get_density_color) 1

proc ic_geo_set_density_color {clr} {
    global projlib
    if {$projlib != ""} {
        $projlib configure -density_color $clr
        ic_geo_configure_one_attribute density color $clr
    }
}

## Extract points from curves based on the angle between adjacent segments
## in degrees.

proc ic_geo_extract_points {names angle} {
    global projlib

    set ret ""
    foreach name $names {
	set bsp [$projlib get_number_by_name curve $name]
	set new [$projlib extract_points $bsp $angle]
	foreach n $new {
	    set bsp [define_geom_object point $n]
	    update_geom_visible_obj $bsp
	    lappend ret [$bsp get -name]
	}
    }
    return $ret
}

## Extract curves from mesh surfaces.
## If <b>bound</b> is 1 then only the boundary
## of the surface is extracted.  If it is 0 then the angle is used to
## determine feature lines.  The <b>minedge</b> argument determines what
## the smallest curve that will be extracted is.

proc ic_geo_extract_curves {names bound angle minedge} {
    global projlib

    set new_crvs ""
    foreach name $names {
	set surf [$projlib get_number_by_name surface $name]
		if [catch "$projlib extract_curve $surf $bound $angle $minedge" new_nums] {
			return
		}
	foreach n $new_nums {
		set name [ $projlib get_name curve $n ]
		lappend new_crvs $name
	}
    }
    define_geom_objects2 curve $new_crvs
    return $new_crvs
}

## Create curves based on the edges of a surface.
# for parametric surfaces
proc ic_geo_create_surface_edges {names} {
    global projlib

    set new_crvs [eval $projlib create_surface_edges $names]
    define_geom_objects2 curve $new_crvs
    return $new_crvs
}

## Get any curves associated as edges to a surface.
proc ic_geo_get_srf_edges {srf} {
    global projlib
    set edges ""
    if [catch {$projlib get_number_by_name surface $srf} res] {
        return -code error $res
    } else {
	if [catch {gk_get_srf_edges $res} edges] {
	    return -code error $res
	}
    }
    return $edges
}
set dont_record_command(ic_geo_get_srf_edges) 1

## Return some statistics about the object.  This is a human-readable
## string that says what the type is, how many triangles, nodes, etc.

proc ic_geo_stats {type name} {
    global projlib
    set num [$projlib get_number_by_name $type $name]
    return [$projlib ${type}_stats $num]
}
set dont_record_command(ic_geo_stats) 1

## Given the name of a point, return its location.

proc ic_geo_get_point_location {name} {
    global projlib

    if [ic_is_triplet $name] {return $name}
    if {[$projlib get_object_by_name point $name] == ""} { return ""}
    set num [$projlib get_number_by_name point $name]
    return [$projlib get_point_loc $num]
}
set dont_record_command(ic_geo_get_point_location) 1

# backward compatibility ...
proc ic_get_point_location {name} { return [ic_geo_get_point_location $name] }

## Given the name of a material point, return its location.

proc ic_geo_get_material_location {name} {
    global projlib
    set num [$projlib get_number_by_name material $name]
    return [$projlib get_material_loc $num]
}
set dont_record_command(ic_geo_get_material_location) 1

# backward compatibility ...
proc ic_get_material_location {name} { return [ic_geo_get_material_location $name] }

proc ic_geo_get_body_location {name} {
    global projlib
    set num [$projlib get_number_by_name body $name]
    return [$projlib get_material_loc $num]
}
set dont_record_command(ic_geo_get_body_location) 1

## Set the location of a point or points.  The names and locations must
## come in pairs.

proc ic_set_point_location {args} {
    global projlib batch_mode
    foreach {name pt} $args {
	set num [$projlib get_number_by_name point $name]
	$projlib set_point_loc $num $pt
	if !$batch_mode {
	    set bsp [$projlib get_object point $num]
	    $bsp signal_change 1
	}
    }
}

## Set the location of one or more material points.  The names and locations
## must come in pairs.

proc ic_set_material_location {args} {
    global projlib batch_mode
    foreach {name pt} $args {
	set num [$projlib get_number_by_name material $name]
	$projlib set_material_loc $num $pt
	if !$batch_mode {
	    set bsp [$projlib get_object material $num]
	    $bsp signal_change 1
	}
    }
}

proc ic_create_material {names} {
    global projlib
    set added 0
    foreach mtl $names {
	set num [$projlib get_number_by_name material $mtl]
        set bsp [$projlib get_object material $num]
        if {$bsp == ""} {
            set bsp [define_geom_object material $num]
            update_geom_visible_obj $bsp
            incr added
        }
    }
    if $added {display_update geo}
}

## delete a material
 
proc ic_delete_material {names} {
    global projlib
    set removed 0
    foreach mtl $names {
	if ![catch {$projlib get_number_by_name material $mtl} num] {
            set bsp [$projlib get_object material $num]
            if {$bsp != ""} {
                delete_geom_object $bsp
                incr removed
            }
            $projlib delete_material $num
        }
    }
    if $removed {display_update geo}
}

## This function checks to make sure the objects exist - it returns the
## list of names that were found.  If no objects with the given type and
## names were found it returns an empty list.

proc ic_geo_check_objects_exist {type args} {
    global projlib
    set found ""
    foreach name $args {
	if [catch {set obj [$projlib get_object_by_name $type $name]} res] {
	    #mess "$res\n" red
	} elseif {$obj != ""} {
	    lappend found $name
	}
    }
    return $found
}
set dont_record_command(ic_geo_check_objects_exist) 1

## This function returns all the objects of the given type and family.
## If the family doesn't exist it returns an empty list, and if it is
## "" then it returns all objects of all families.

proc ic_geo_get_objects {types {fams ""} {even_if_dormant 0}} {
    global projlib

    if {$projlib == ""} { return "" }

    set pre_type 0
    if {$types == "all"} {
        set types [ic_geo_get_types]
        set pre_type 1
    }

    set names ""
    if ($even_if_dormant) {
        set dormant "even_if_dormant"
     } else {
        set dormant ""
    }
    foreach type $types {
        if {$fams == ""} {
            foreach n [$projlib list_objects $type $dormant] {
                set nam [$projlib get_name $type $n]
                if $pre_type {
                    lappend names [list $type $nam]
                } else {
                    lappend names $nam
                }
            }
        } else {
            foreach fam $fams {
                set pid [$projlib lookup_family_pid $fam]
                if {$pid < 0} continue
                foreach i [$projlib get_objects_in_family $type $pid $dormant] {
                    set nam [$projlib get_name $type $i]
                    if $pre_type {
                        lappend names $type $nam
                    } else {
                        lappend names $nam
                    }
                }
            }
        }
    }
    return $names
}
set dont_record_command(ic_geo_get_objects) 1

## How many objects are there of the given type in the given family.

proc ic_geo_count_in_family {types fams} {
    global projlib

    if {$projlib == ""} { return 0 }

    if {$types == "all"} { set types [ic_geo_get_types] }

    set num 0
    foreach type $types {
	foreach fam $fams {
	    set pid [$projlib lookup_family_pid $fam]
	    if {$pid < 0} continue
	    incr num [llength [$projlib get_objects_in_family $type $pid]]
	}
    }
    return $num
}
set dont_record_command(ic_geo_count_in_family) 1

## Get a list of objects in the given family name

proc ic_geo_objects_in_family {types fams} {
    global projlib

    if {$projlib == ""} { return "" }

    if {$types == "all"} { set types [ic_geo_get_types] }

    set objects ""
    foreach type $types {
	foreach fam $fams {
	    set pid [$projlib lookup_family_pid $fam]
	    if {$pid < 0} continue
	    foreach s [$projlib get_objects_in_family $type $pid] {
		lappend objects [$projlib get_name $type $s]
	    }
	}
    }
    return $objects
}
set dont_record_command(ic_geo_objects_in_family) 1

## Get a list of objects (type/name pairs) in the given parts

proc ic_geo_objects_in_parts {types parts} {
    foreach p $parts {
	foreach o [ic_geo_objects_in_family $types [ic_geo_list_families_in_part $p]] {
	    set got($o) 1
	}
    }
    set ret ""
    foreach o [array names got] {
	lappend ret [$o get -type] [$o get -name]
    }
    return $ret
}
set dont_record_command(ic_geo_objects_in_parts) 1

## This is a bit of a back door.  Return the internal object associated with a name

proc ic_geo_get_internal_object {type name} {
    global projlib
    if {$projlib == ""} { return "" }
    return [$projlib get_object_by_name $type $name]
}
set dont_record_command(ic_geo_get_internal_object) 1

## This is a bit of a back door.  Return the name of an internal object

proc ic_geo_get_name_of_internal_object {obj} {
    return [$obj get -name]
}
set dont_record_command(ic_geo_get_name_of_internal_object) 1

## Get the text point LIST for an object, specified by type and name. The list is:
## "{xloc yloc zloc} {xdir ydir zdir}"

proc ic_geo_get_text_point {type name} {
    global projlib

    if {$projlib == ""} { return "" }

    if [catch {$projlib get_number_by_name $type $name} num] {
	mess "Warning: could not get \"$type\" object by name of \"$name\"\n" red
	return ""
    }

    return [$projlib text_point $type $num]
}
set dont_record_command(ic_geo_get_text_point) 1

## Get the centroid for an object, specified by type and name. The return is:
## "{xloc yloc zloc}" FIXME. This function only works for curves thus far. FIXME

proc ic_geo_get_centroid {type name} {
    global projlib

    if {$projlib == ""} { return "" }
    
    if [catch {$projlib get_number_by_name $type $name} num] {
	mess "Warning: could not get \"$type\" object by name of \"$name\"\n" red
	return ""
    }
    
    return [$projlib centroid $type $num]
}
set dont_record_command(ic_geo_get_centroid) 1

## How many segments or triangles are there in the object.  This returns
## 2 numbers - how many segments and how many nodes.

proc ic_geo_num_segments {type name} {
    global projlib
    
    if {$projlib == ""} { return "" }
    
    set n [$projlib get_number_by_name $type $name]
    switch $type {
	surface  { return [$projlib count_surface_triangles $n] }
	curve    { return [$projlib count_curve_bars $n] }
	default  { return "" }
    }
}
set dont_record_command(ic_geo_num_segments) 1

## returns number of nodes in the object

proc ic_geo_num_nodes {type name} {
    global projlib

    if {$projlib == ""} { return "" }

    set n [$projlib get_number_by_name $type $name]
    switch $type {
	surface  { return [lindex [$projlib count_surface_triangles $n] 1] }
	curve    { return [lindex [$projlib count_curve_bars $n] 1] }
        density  { return [$projlib count_density_nodes $n] }
	default  { return "" }
    }
}
set dont_record_command(ic_geo_num_nodes) 1

## Get a node in a mesh curve, surface or density polygon.

proc ic_geo_get_node {type name num} {
    global projlib
    
    if {$projlib == ""} { return "" }
    if {$name == ""} { return "" }
    if {$num == ""} { return "" }
    set n [$projlib get_number_by_name $type $name]
    if {$n == ""} { return "" }
    switch $type {
	surface  { return [$projlib get_surface_node $n $num] }
	curve    { return [$projlib get_curve_node $n $num] }
	density  { return [$projlib get_density_node $n $num] }
	default  { return "" }
    }
}
set dont_record_command(ic_geo_get_node) 1

## Interactively drag nodes in surfaces and curves.

proc ic_geo_drag_nodes {type name ptnums startpts startmouse spos svec how} {
    global projlib
    
    if {$projlib == ""} { return "" }
    
    set n [$projlib get_number_by_name $type $name]
    
    foreach p $ptnums sp $startpts {
	$projlib drag_${type}_node $n $p $sp \
	    $startmouse $spos $svec $how
    }
    [$projlib get_object_by_name $type $name] signal_change 1
    $projlib configure -modified 1
}

## Interactively drag prescribed points.

proc ic_geo_drag_point {name startpt startmouse spos svec} {
    global projlib
    
    if {$projlib == ""} { return "" }
    set n [$projlib get_number_by_name point $name]
    $projlib drag_point $n $startpt $startmouse $spos $svec
    [$projlib get_object_by_name point $name] signal_change 1
    $projlib configure -modified 1
}

## Interactively drag material points.

proc ic_geo_drag_material {name startpt startmouse spos svec} {
    global projlib
    
    if {$projlib == ""} { return "" }
    set n [$projlib get_number_by_name material $name]
    $projlib drag_material $n $startpt $startmouse $spos $svec
    [$projlib get_object_by_name material $name] signal_change 1
    $projlib configure -modified 1
}

## Interactively drag body points.

proc ic_geo_drag_body {name startpt startmouse spos svec} {
    global projlib
    
    if {$projlib == ""} { return "" }
    set n [$projlib get_number_by_name body $name]
    $projlib drag_material $n $startpt $startmouse $spos $svec
    [$projlib get_object_by_name body $name] signal_change 1
    $projlib configure -modified 1
}

## Project a point to a set of objects.  <b>dir</b> is the vector along
## which to project, or <b>0 0 0</b> if the nearest point is desired.
## <b>dir</b> is used only in the case of surfaces.
##
## <table border>
## <tr><td><b>type    </b></td><td> point, curve, surface               	</td></tr>
## <tr><td><b>names   </b></td><td> list of entity names	 		</td></tr>
## <tr><td><b>pt      </b></td><td> point -- either entity name or 3-tuple	</td></tr>
## <tr><td><b>dir     </b></td><td> projection vector, {0, 0, 0} for nearest pnt</td></tr>
## <tr><td><b>tan_ext </b></td><td> project to tangential extension (curves only)</td></tr>
## </table>

proc ic_geo_project_point {type names pt {dir "0 0 0"} {tan_ext 0}} {
    # consolidated to use ic_geo_project_coords b/c otherwise identical --jka, 10 july 2003
    if {[llength $pt] > 1} {
	    set ptloc $pt
    } else {
	    set ptloc [ic_geo_get_point_location $pt]
    }
    return [ic_geo_project_coords $type $names $ptloc $dir $tan_ext]
}
set dont_record_command(ic_geo_project_point) 1

## Project and move a point to a set of objects.  <b>dir</b> is the vector along
## which to project, or <b>0 0 0</b> if the nearest point is desired.
## <b>dir</b> is used only in the case of surfaces.
##
## <table border>
## <tr><td><b>type    </b></td><td> point, curve, surface               	</td></tr>
## <tr><td><b>names   </b></td><td> list of entity names	 		</td></tr>
## <tr><td><b>pt      </b></td><td> point -- either entity name or 3-tuple	</td></tr>
## <tr><td><b>dir     </b></td><td> projection vector, {0, 0, 0} for nearest pnt</td></tr>
## <tr><td><b>tan_ext </b></td><td> project to tangential extension (curves only)</td></tr>
## <tr><td><b>fam     </b></td><td> part name (if blank, use the part name of the point)</td></tr>
## </table>

proc ic_geo_project_and_move_point {type names pt {dir "0 0 0"} {tan_ext 0} {fam ""}} {
    if {[llength $pt] > 1} {
	    set ptloc $pt
    } else {
	    set ptloc [ic_geo_get_point_location $pt]
    }
    set xyz [ic_geo_project_coords $type $names $ptloc $dir $tan_ext]
    if {$xyz == ""} {
        return ""
    }
    if {$fam == ""} {
        set fam [ic_geo_get_family point $pt]
    }
    ic_delete_geometry point names $pt 0 1
    return [ic_geo_cre_pnt $fam $pt $xyz]
}

## Project coords to a set of objects.  <b>dir</b> is the vector along
## which to project, or <b>0 0 0</b> if the nearest point is desired.
## <b>dir</b> is used only in the case of surfaces.

proc ic_geo_project_coords {type names ptloc {dir "0 0 0"} {tan_ext 0}} {
    global projlib
    
    if {$projlib == ""} { return "" }
    
    set nums ""
    foreach name $names {
	lappend nums [$projlib get_number_by_name $type $name]
    }
    switch $type {
	surface  {
	    return [$projlib project_to_surfaces $nums $ptloc $dir]
	}
	curve {
	    return [$projlib project_to_curves $nums $ptloc $tan_ext]
	}
	point {
	    return [$projlib project_to_points $nums $ptloc]
	}
	default  { return "" }
    }
}
set dont_record_command(ic_geo_project_coords) 1

## Project a point to a set of objects, and return the name of the best one
## and the location.  <b>dir</b> is the vector along
## which to project, or <b>0 0 0</b> if the nearest point is desired.
## <b>pt</b> may either be an XYZ location or the name of a prescribed point.
## The <b>tol</b> argument is used for intersecting a line with curves.
## NOTE: curve projection is not yet implemented

proc ic_geo_nearest_object {type pt {dir "0 0 0"} {tol 0}} {
    global projlib
    
    if {$projlib == ""} { return "" }
    
    set ptloc [ic_geo_get_point_location $pt]
    switch $type {
	surface  {
	    set ret [$projlib project_to_all_surfaces $ptloc $dir]
	    if {$ret != ""} {
		return [list [$projlib get_name surface [lindex $ret 0]] \
			    [lindex $ret 1]]
	    }
	}
	curve {
	    set ret [$projlib project_to_all_curves $ptloc $dir $tol]
	    if {$ret != ""} {
		return [list [$projlib get_name curve [lindex $ret 0]] \
			    [lindex $ret 1]]
	    }
	}
    }
    return ""
}
set dont_record_command(ic_geo_nearest_object) 1

## Project one or more curves to one or more surfaces 
## <table border>
## <tr><td><b>crvs    </b></td><td> list of curve names		 	</td></tr>
## <tr><td><b>surfs   </b></td><td> list of surface names	 	</td></tr>
## <tr><td><b>name    </b></td><td> base name of created curve     	</td></tr>
## <tr><td><b>fam     </b></td><td> family of created curves	 	</td></tr>
## <tr><td><b>new_name</b></td><td> do not reuse existing names        	</td></tr>
## <tr><td><b>bld_topo</b></td><td> trim surfaces by projected curves   </td></tr>
## <tr><td><b>return  </b></td><td> name(s) of created curve(s)     	</td></tr>
## </table>
proc ic_geo_project_curve_to_surface { crvs surfs name {fam ""} {new_name 0} \
    {bld_topo 0}} {
#
#   History---
#   04/10/06 VG -- always create curve as bspline using "name", ...
#
    global projlib batch_mode
    if {$projlib == "" || ![llength $crvs] || ![llength $surfs]} { return "" }
    set new_crvs ""
    if {$fam == ""} {
	set fam [ic_geo_get_family curve [lindex $crvs 0]]
    }
    set resume 0
    if 0 {
        if ![ic_undo_suspended] {
            ic_save_model_for_undo
            ic_undo_suspend
            set resume 1
        }
    }
    ic_geo_new_family $fam
    foreach crv $crvs {
	if [ catch { $projlib project_curve_to_surface $crv $surfs tmpname } res ] {
	    continue
	}
	foreach obj $res {
	    set n [$projlib get_number curve $obj]	
	    if [catch {ic_geo_cvt_uns_to_bsc $fam tmp2 $obj} cvt] continue
	    define_geom_objects2 curve $cvt
	    $projlib delete_curve $n
	    foreach newbsp $cvt {
	 	set the_name [$projlib new_name curve $name 1] 		
		lappend new_crvs [ic_geo_set_name curve $newbsp $the_name]
	    }
	}
    }
    if { $new_crvs == "" } return
    ic_geo_set_family curve $fam names $new_crvs 0
    if $bld_topo {
	ic_geo_build_topo_on_srfs $surfs $new_crvs -1 1
	display_update geo 0
	$projlib configure -modified 1
    }
    if $resume {
        ic_undo_resume
    }
    return $new_crvs
}

## Create a facetted surface from <b>crv1</b> and <b>crv2</b>.
## <br>If the curves are not connected, the new surface will connect straight across the gaps.
## <br><b>name</b> is the name of the new surface.

proc ic_geo_create_surface_curves { crv1 crv2 name } {
	global projlib
	if {$projlib == ""} { return "" }
	$projlib spanning_surface $crv1 $crv2 $name
	define_geom_objects2 surface $name
}

## Create a curtain surface between one or more curves and a surface.
## <table border>
## <tr><td><b>crvs</b></td><td>list of defining curves</td></tr>
## <tr><td><b>surfs</b></td><td>surface(s) to project to</td></tr>
## <tr><td><b>name</b></td><td>base name of created surfaces</td></tr>
## <tr><td><b>fam</b></td><td>family of created surfaces</td></tr>
## <tr><td><b>bld_topo</b></td><td>run the topology builder </td></tr>
## <tr><td><b>quiet</b></td><td>suppress diagnostic messages </td></tr>
## </table>
## </pre>
proc ic_geo_create_surface_curtain { crvs surfs name fam {bld_topo 0} {quiet 0}} {
	global projlib batch_mode
	
    if {$projlib == ""} { return "" }
    set new_surfs ""
    set ret_surfs ""
    set topo_surfs ""
    set topo_curvs ""
    set gttol 0.001
    foreach {n v} [ic_set_meshing_params global 0] {
        if {$n == "gttol"} {set gttol $v}
    }
    set new_fam 0
    set res_surfs ""
    foreach crv $crvs {
	    set srfTmp $surfs
	    if [catch {$projlib curtain_surface $crv $srfTmp $name} new_surfs] {
            mess "Error: $new_surfs\n"
	    } else {
            foreach srf $new_surfs {
                set validname [ic_vset -new_name $name all]
                set val [$projlib get_number surface $srf]
                if { $val != -1  && $val != $srf } {
                    if [catch {geoclean_reappr_surface "" "" $srf $val $gttol vid_dummy_pre vid_dummy_pre} srf_id] {
                        mess "Error reapproximation: $srf_id" red
                    } else {
                        if {[ic_geo_check_objects_exist surface $srf_id] == ""} {
                            mess "Error: curtain surface can not be created by a closed curve $crv\n" red
                            return ""
                        }
                        ic_geo_set_name surface $srf_id $validname
                        set srf $validname
                        lappend res_surfs $srf
                    }      
                    define_geom_objects2 surface $srf
                    if {$new_fam == 0} {
                        set new_fam [ic_geo_new_family $fam]
                    }
                    ic_geo_set_family surface $fam names $srf
                	lappend topo_surfs $srf
                    set edges [ic_geo_get_srf_edges $srf]
                    foreach crv $edges {
			            lappend topo_curvs $crv
				        set eb [$projlib get_number curve $crv]
                        set eb [define_geom_object curve $eb]
                        update_geom_visible_obj $eb
			        }
                }
            }
        }
    }
    if {!$batch_mode && $new_fam} {
        display_update geo $new_fam
    }
    if {$bld_topo} {
        #
        #  run topology bilger
        ic_geo_build_topo_on_srfs      $surfs $topo_curvs -1 1 0 $quiet
	    #
	    #  rebuild display -- necessary cuz build_topo does not
 	    #  return created entity lists to the tcl level
	    #
    	update_bsp_consistency
        display_update geo 0
        $projlib configure -modified 1
    }
    return $res_surfs
}
## Move a node on an object.

proc ic_geo_set_node {type name num pt} {
    global projlib
    
    if {$projlib == ""} { return "" }
    
    set n [$projlib get_number_by_name $type $name]
    switch $type {
	surface  { $projlib move_surface_node $n $num $pt }
	curve    { $projlib move_curve_node $n $num $pt }
	density  { $projlib move_density_node $n $num $pt }
	default  { return "" }
    }
    [$projlib get_object $type $n] signal_change 1
    $projlib configure -modified 1
}

## Get the family for an object.

proc ic_geo_get_family {type name} {
    global projlib
# check for valid name    
    if {$projlib == ""} { return "" }
    set num [$projlib get_number $type $name]
    if {$num < 0} return
    return [$projlib get_family $type $num]
}
set dont_record_command(ic_geo_get_family) 1

## Get the part for an object (just the family with stuff after the first : removed)

proc ic_geo_get_part {type name} {
    global projlib
    
    return [lindex [split [ic_geo_get_family $type $name] :] 0]
}
set dont_record_command(ic_geo_get_part) 1

## Build the topology information from the geometry data.  Arguments are:
## <ul>
## <li> <i>tolerance</i> 	   : the gap tolerance
## <li> <b>-angle</b> <i>angle</i> : the angle for extraction
## <li> <b>-filter_points</b> 	   : extract the cad points
## <li> <b>-filter_curves</b> 	   : extract the cad curves
## <li> <b>-delete_degenerate</b>  : delete degenerate surfaces
## <li> <b>-save_old</b> 	   : don't delete existing entities.
## <li> <b>-quiet</b> 		   : suppress diagnostic messages
## <li> <b>-no_reg_surf</b> 	   : do not trim/regularize surfaces
## <li> <b>-no_concat</b> 	   : do join edge curves
## <li> <b>-create_interior</b>    : create interior curves on mesh surfaces
## <li> <b>family_name</b> 	   : name(s) of family(ies) to operate on.
## </ul>

proc ic_build_topo {args} {
# 04/05/05: fix for bug 11461: 
# restore dormant points if filter off & point is in active fam
# This is the only place outside c++ code, where dormant points
# will be restored when user use replay file 
# "The basic c++ function shouldn't do this as is breaks other things."
#
#  03/28/06 : fix for 43803: option to keep dormant status.
#  Method: Check for argument -keep_dormant_dormant; 
#          create dormant lists before build_topo; Set dormant after build topo
# 05/19/06 : update_bsp_consistency instead of clean/define_geom_objects
# 05/26/06 : new meaning of -keep_dormant_dormant: do not delete old and do not create new
# 06/15/06 : update_bsp_consistency replaced with reinit: display problem (X11, 47778) 
# 03/10/08 : replace list (if any) in args with values, e.g. -curves "A B" with -curves A B

    global projlib batch_mode
    
    set tmpargs $args
    set args ""
    foreach val $tmpargs {append args "$val "}
#  --- check option and save dormant names if exists; first arg always tolerance
	    set restore_dormants [lsearch $args "-keep_dormant_dormant"]
	    if {$restore_dormants > 0} {
		    set args [lreplace $args $restore_dormants $restore_dormants] 
		    foreach d_name [ic_geo_get_dormant curve] {set d_curve($d_name) 1}
		    foreach d_name [ic_geo_get_dormant point] {set d_point($d_name) 1}
	    } else {
	        # --- start restore dormant points (see 11461, 48237)----
	        set nw [llength $args]
	        set do_restore 1
	        set pts [ic_geo_get_dormant point]
	        # if ! dormant pts - ignore args, 
	        if ![llength $pts] {
		        set do_restore 0		
		        set nw 0
	        }
	        for {set i 1} {$i < $nw} {incr i} {
		        set a [lindex $args $i]
		        if {$a == "-filter_points"} {
			        set do_restore 0
			        break 			
		        }
		        if {($a == "-surfaces") || ($a == "-curves")} {
			        set do_restore 0
			        break 			
		        }
		        if {$a == "-angle"} {incr i}
		        if {[string index $a 0] == "-"} continue
		        set active_fams($a) 1
	    }
	    if $do_restore {
		    # if ! active_fams - all families
		    foreach pnt $pts {
			    if ![array exists active_fams] {
				    ic_geo_set_dormant_entity point $pnt 0
			    } else {
				    set fam [ic_geo_get_family point $pnt]
				    if [info exists active_fams($fam)] {
					    ic_geo_set_dormant_entity point $pnt 0
				    }
			    }
		    }	
	    }
	}

    set restore_bodies 0
	foreach b [ic_geo_get_objects body] {
        foreach {t n} [ic_geo_body_lower_entities $b] {
            if {$t != "surface"} continue
			lappend body($b) $n
			set restore_bodies 1
        }
	}
	if {$restore_bodies > 0} {
	    set all_surfs [ic_geo_get_objects surface]
	}
		
    busy 1
    eval $projlib build_topo $args
      
    if {$restore_dormants < 0 && $restore_bodies < 0} {
        reinit_geom_objects 
        busy 0
		return
	}
    
    if {$restore_dormants > 0} {
	    # set dormant status as it was before "build_topo"
	    foreach type {curve point} {
		    foreach d_name [ic_geo_get_dormant $type] {
			    set check d_${type}($d_name)
			    if ![info exists $check] {
				    ic_geo_set_dormant_entity $type $d_name 0	
			    } else {
				    unset $check
			    }
		    }
		    foreach d_name [array names d_$type] {
			    if ![llength [ic_geo_check_objects_exist $type $d_name]] continue
			    ic_geo_set_dormant_entity $type $d_name 1
		    }		
        }
    }
    
    reinit_geom_objects

    if {$restore_bodies > 0 && [ic_geo_get_objects surface] != $all_surfs} {
        # restore bodies as it was before "build_topo"
        foreach b [ic_geo_get_objects body] {
            if ![info exists body($b)] continue
            if ![llength [ic_geo_check_objects_exist body $b]] continue
            set do_restore 0
            foreach n $body($b) {
                if ![llength [ic_geo_check_objects_exist surface $n]] {
                    set do_restore 0
                    break
                }
                foreach s [ic_geo_get_objects surface] {
                    if {"$n" == "$s"} continue
                    if {[lsearch $body($b) $s] >= 0} continue
                    if ![string match "*.cut.*" $s] continue
                    if ![string match "${n}*" $s] continue
                    if [string match "${n}.cut.?" $s] {
                        set do_restore 1
                        lappend body($b) $s
                    }
                }
            }
            if $do_restore {
                set part [ic_geo_get_part body $b]
                ic_delete_geometry body names $b 0
                ic_geo_create_body $body($b) $b $part 1
            }
        }
    }
	busy 0	
}

## Get a good tolerance for the current geometry.

proc ic_geo_default_topo_tolerance_old {} {
    set topotol 0.1
    # set the tol as 10^-4 of the bbox diag
    set bbox [ic_geo_model_bounding_box ]
    set dist [eval ic_vcalc distance $bbox]
    if {$dist != ""} {
            set topotol [format %.1g [expr $dist * 0.5 * 1.0e-03]]
        }
    return $topotol
}

proc ic_geo_default_topo_tolerance {} {
    if ![ic_geo_is_loaded] {
	return 0.0
    }
    #  Implementation is in geoclean/geokern.C, IcGkDefaultTopoTol
    set topotol [format %.1g [gk_default_topo_tol]]
    return $topotol
}

set dont_record_command(ic_geo_default_topo_tolerance) 1

## Delete geometry objects.  The first argument tells what kind of objects to
## delete: surface, curve, material, point, density, or loop.
## The second argument tells how to select the
## objects and the third is the list of object specifiers.  <b>how</b> can be:
## <ul>
## <li> <b>names</b> : a list of the names of the objects
## <li> <b>numbers</b> : a list of the numbers of the objects
## <li> <b>patterns</b> : a list of glob-patterns that match the names of
## the objects
## <li> <b>families</b> : a list of the families to select
## <li> <b>all</b> : all objects of that type (the objects list is ignored)
## <li> <b>visible</b> : all visible objects of that type
## (the objects list is ignored and can be left off)
## <li> <b>blanked</b> : all blanked objects of that type
## (the objects list is ignored and can be left off)
## <li> <b>objects</b> : the internal handles for the objects
## <li> <b>report_err</b> : optional argument - if 0 then don't report errors
## if objects don't exist
## </ul>

proc ic_delete_geometry {type how {objects ""} {report_err 1} {even_if_dormant 0}} {
    global projlib
    set objs [geo_lookup $type $how $objects $report_err $even_if_dormant]
    if ![llength $objs] {return 0}
    set nums ""
    set del ""
    set bounds ""
    set objs2  ""
    foreach obj $objs {
        if {$obj == ""} continue
        lappend objs2 $obj
        lappend nums [$obj get -bspline]
        lappend del [$obj get -type] [$obj get -bspline]
        if {$type == "surface"} {
            foreach bn [$obj boundary] {
                lappend bounds [$projlib get_object_by_name curve $bn]
            }
        }
	}
    delete_geom_object $objs2
    foreach {t n} $del {
        eval $projlib delete_$t $n
    }
    # This updates the color by count
    foreach b $bounds {
        if {$b != ""} {$b signal_change 0}
    }
    return [llength $nums]
}

## Delete a point and join incident curves
## <ul>
## <li><b>how</b> 	  - how points are selected. see
##			    ic_delete_geometry
## <li><b>objects</b>     - the internal handles for the objects
## </ul>
proc ic_geo_pnt_mrg_inc_crv {how objects} {
    global projlib
    set objs [geo_lookup point $how $objects 1]
    set ret  ""
    foreach obj $objs {
        set num [$obj get -bspline]
        if [catch {gk_pnt_mrg_inc_crv $num} res] {
            mess "Error: $res\n" red
        } elseif {$res != ""} {
			set newname [lindex $res 0]
            lappend ret $newname
            set nb [$projlib get_number curve $newname]
            set bsp [define_geom_object curve $nb]
# bug in gk_pnt_mrg_inc_crv? newname is different from curve name
			$bsp configure -name $newname
#
            update_geom_visible_obj $bsp
	    if {[llength $res] > 1} {
		ic_delete_geometry curve names [lindex $res 1]
	    }
        }
    }
    return $ret
}


## Make a new geometric entity that is the faceted or piecewise linear
## equivalent of the old one.  Optional arguments are:
## <ul>
## <li><b>noisy</b> <i>on</i> : if 1 print status information
## <li><b>replace</b> <i>on</i> : if 1 replace the old object, otherwise
## make a new one.
## </ul>

proc ic_facetize_geometry {type name args} {
    # Modified 06/01/06 : fixed replace option usage
    global projlib

    set noisy 1
    set replace 0
    foreach {n v} $args {
	    set $n $v
    }
    set num [$projlib get_number_by_name $type $name]
    set new [$projlib facetize_$type $num 0]
    if ![string length $new] {
	    if $noisy {
	        mess "$name is not a CAD $type - not facetizing\n" red
	    }
	    return ""
    }
	set bsp [define_geom_object $type $new]
	update_geom_visible_obj $bsp
	set newname [$bsp get -name]
    if !$replace {
		return $newname
    } else {
		ic_delete_geometry surface names $name 0
		ic_geo_set_name surface $newname $name
	    return $name
    }
}

## Move an existing geometry entity.  The <b>type</b> argument gives the type:
## point, curve, surface, material, density, loop, or all.  The other arguments
## are:
## <ul>
## <li> <b>names</b> : a list of the names of the objects
## <li> <b>type_names</b> : a list of pairs with the types and
## names of the objects
## <li> <b>numbers</b> : a list of the numbers of the objects
## <li> <b>patterns</b> : a list of glob-patterns that match the names of
## the objects (* = all objects)
## <li> <b>families</b> : a list of the families to select
## <li> <b>objects</b> : the internal handles for the objects
## <li> <b>cent</b> : a list of X Y Z giving the center for rotation, scaling,
## and mirroring, which could be "centroid"
## <li> <b>translate</b> : the X Y Z values for translating the entity
## <li> <b>rotate</b> : the number of degrees to rotate the object about the
## axis given by <b>rotate_axis</b>
## <li> <b>rotate_axis</b> : the vector giving the axis to rotate about
## <li> <b>scale</b> : a scale value, or 3 values giving the factor to scale
## in X Y and Z
## <li> <b>mirror</b> : the axis about which to mirror
## </ul>
## The translation vector, center of rotation, and rotate axis should be
## specified in the current local cartesian coordinate system.

proc ic_move_geometry {type args} {
    global projlib batch_mode

    set names ""
    set type_names ""
    set numbers ""
    set patterns ""
    set families ""
    set objects ""
    set cent "0 0 0"
    set translate ""
    set rotate ""
    set rotate_axis "0 0 1"
    set scale ""
    set mirror ""
    set duplicate 0
    set distance 0.0
    set newfam ""
    set detach 1

    foreach {n v} $args { set $n $v }
    
    # Function does not work in cylindrical and spherical LCS
    # except below
    set cur_csys [ic_csystem_get_current]
    set cur_csys_type cartesian
    if {$cur_csys != "global"} {
        set cur_csys_type [lindex [ic_csystem_get $cur_csys] 0]
        if {$cur_csys_type != "cartesian"} {
            set to_return 0
            if {$cur_csys_type == "cylindrical" && ($translate != "" || (($rotate != "" && $rotate_axis != "") || $mirror != "") && $scale == "")} {
                if {$translate != ""} {
                    if {[lindex $translate 0] != 0 || [lindex $translate 1] != 0} {
                        mess "Error: translate works for current cylindrical coordinate system only for Z offset\n" red
                        set to_return 1
                    }
                } elseif {$rotate != "" && $rotate_axis != ""} {
                    if {[lindex $rotate_axis 0] != 0 || [lindex $rotate_axis 1] != 0} {
                        mess "Error: rotate works for current cylindrical coordinate system only for Z axis\n" red
                        set to_return 1
                    }
                } elseif {$mirror != ""} {
                    if {[lindex $mirror 0] != 0 || [lindex $mirror 1] != 0} {
                        mess "Error: mirror works for current cylindrical coordinate system only for Z plane axis\n" red
                        set to_return 1
                    }
                }
            } else {
                mess "Error: current coordinate system is not cartesian\n" red
                set to_return 1
            }
            if $to_return return
        }
    }

    # Next lines make possible to use expressions and variables
    # scalar, scalar expression
    set rotate [ic_vset - $rotate]
    
    # vector, point, vector expression 
    if {[llength $translate] == 2} {
        if {([ic_geo_check_objects_exist point [lindex $translate 0]] != "")} {
            set translate1 [ic_vset -vec - [lindex $translate 0]]
        } else {
            set translate1  [lindex $translate 0]
        }
        if {([ic_geo_check_objects_exist point [lindex $translate 1]] != "")} {
            set translate2 [ic_vset -vec - [lindex $translate 1]]
        }  else {
            set translate2  [lindex $translate 1]
        }
        set off_set [ic_vcalc diff $translate1 $translate2]
        if {$distance != 0.0} {
            set mvdis [ic_vset -var - $distance]
        } else {
            set mvdis [ic_vcalc distance $translate1 $translate2]
        }
        set nrm [ic_vcalc nrm $off_set]
        set translate [ic_vcalc smult $nrm $mvdis]
    } else {
        set translate [ic_vset -vec - $translate]
    }
    
    if {[llength $rotate_axis] == 2} {
        if {([ic_geo_check_objects_exist point [lindex $rotate_axis 0]] != "")} {
            set rotate_axis1 [ic_vset -vec - [lindex $rotate_axis 0]]
        } else {
            set rotate_axis1 [lindex $rotate_axis 0]
        }
        if {([ic_geo_check_objects_exist point [lindex $rotate_axis 1]] != "")} {
            set rotate_axis2 [ic_vset -vec - [lindex $rotate_axis 1]]
        } else {
            set rotate_axis2 [lindex $rotate_axis 1]
        } 
        set rotate_axis [ic_vset -vec - [ic_vcalc dir $rotate_axis1 $rotate_axis2]]
    } else {
        set rotate_axis [ic_vset -vec - $rotate_axis]
    }
    
    # also, for cent, if !"centroid"
    # for scale: 1-word scalar expr. or 3-words (3 scalar exprs)
    foreach i {names type_names numbers patterns families objects} {
        if {[set $i] != ""} { set how $i; set objects [set $i]; break }
    }
    if ![info exists how] {
        if {$type == "all"} {
            set how all
        } else {
            error "no objects selected"
        }
    }
    set objs [geo_lookup $type $how $objects]
    if {$cent == "centroid"} {
        set bb [bbox_of_images $objs]
        set bmin [lindex $bb 0]; set bmax [lindex $bb 1]
        set cent ""
        foreach i {0 1 2} {
            lappend cent [expr {([lindex $bmin $i] + [lindex $bmax $i]) / 2.0}]
        }
    } else {
        set cent [ic_vset -vec - $cent]
        set cent [coords_into_global $cent]
    }
    
    set rotate_axis [coords_dir_into_global $rotate_axis]
    
    if {$translate != ""} {
        set translate [coords_dir_into_global $translate]
    }
 
    if {[llength $mirror] == 2} {
        if {([ic_geo_check_objects_exist point [lindex $mirror 0]] != "")} {
            set mirror1 [ic_vset -vec - [lindex $mirror 0]]
        } else {
            set mirror1 [lindex $mirror 0]
        }
        if {([ic_geo_check_objects_exist point [lindex $mirror 1]] != "")} {
            set mirror2 [ic_vset -vec - [lindex $mirror 1]]
        } else {
            set mirror2 [lindex $mirror 1]
        }
        set mirror [coords_dir_into_global [ic_vcalc dir $mirror1 $mirror2]]
    } else {
        set mirror [coords_dir_into_global $mirror]
    }
    
    ic_geo_unmark_all
    foreach e $objs {
        if {$translate != ""} {
            if {[$e get -type] == "body"} {
                $projlib translate_entity body_surfs [$e get -number] $translate
            } elseif {[$e get -type] == "point" || [$e get -type] == "curve" || [$e get -type] == "surface"} {
                $projlib translate_entity [$e get -type] [$e get -number] $translate $detach
            } else {
                $projlib translate_entity [$e get -type] [$e get -number] $translate
            }
        }
        if {$rotate != ""} {
            if {[$e get -type] == "body"} {
                $projlib rotate_entity body_surfs [$e get -number] $rotate_axis $rotate $cent
            } elseif {[$e get -type] == "point" || [$e get -type] == "curve" || [$e get -type] == "surface"} {
                $projlib rotate_entity [$e get -type] [$e get -number] $rotate_axis $rotate $cent $detach
            } else {
                $projlib rotate_entity [$e get -type] [$e get -number] $rotate_axis $rotate $cent
            }
        }
        if {$scale != ""} {
            set sc ""
            if {[llength $scale] == 1} { 
                set sc [ic_vset - $scale]
            }
            if {$sc != ""} {
                set scale "$sc $sc $sc"
            } else { 
                set scale [ic_vset -vec - $scale]
            }
            if {$scale != ""} {
                if {[$e get -type] == "body"} {
                    $projlib scale_entity body_surfs [$e get -number] $scale $cent
                } elseif {[$e get -type] == "point" || [$e get -type] == "curve" || [$e get -type] == "surface"} {
                    $projlib scale_entity [$e get -type] [$e get -number] $scale $cent $detach
                } else {
                    $projlib scale_entity [$e get -type] [$e get -number] $scale $cent
                }
            }
        }
        if {$mirror != ""} {
            if {[$e get -type] == "body"} {
                $projlib mirror_entity body_surfs [$e get -number] $mirror $cent
            } elseif {[$e get -type] == "point" || [$e get -type] == "curve" || [$e get -type] == "surface"} {
                $projlib mirror_entity [$e get -type] [$e get -number] $mirror $cent $detach
            } else {
                $projlib mirror_entity [$e get -type] [$e get -number] $mirror $cent
            }
        }
        if { $newfam != "" } {
            ic_geo_set_family [$e get -type] $newfam names [$e get -name] 
        }
        $e signal_change 1
        update_geom_object $e
    }
    ic_geo_unmark_all

    if {$newfam != "" && !$batch_mode} {
        update_fam_window
    }
    if {$cur_csys_type != "cartesian"} {
        ic_csystem_set_current $cur_csys
    }
}

proc ic_geo_unmark_all {} {
    global projlib
    
    $projlib unmark_all
}

proc ic_copy_geometry {type args} {
    global projlib
 #   busy 1
    set names ""
    set type_names ""
    set numbers ""
    set patterns ""
    set families ""
    set objects ""
    foreach {n v} $args { set $n $v }
    foreach i {names type_names numbers patterns families objects} {
	if {[set $i] != ""} { set how $i; set objects [set $i]; break }
    }
    if {$type == "all"} { set how all }    
    if ![info exists how] { error "No objects selected" }    
    set objs [geo_lookup $type $how $objects]
    
    set nobjs ""
    foreach obj $objs {
	set n [$obj get -name]
	set t [$obj get -type]
	set nn [ic_geo_duplicate $t $n]
	lappend $nobjs [ic_geo_get_objects_by_name $t $nn]
    }
    
    foreach obj $nobjs {
	
	ic_move_geometry $type $args
    }
  #  busy 0
}

## Duplicate an existing geometrical entity.  If the <i>newname</i> is
## given then that is used, otherwise a name is generated
## automatically.  If <i>facetize</i> is specified then bspline surfaces
## are turned into facets.

proc ic_geo_duplicate {type name {newname ""} {facetize 0}} {
    global projlib
    
    if {"all" == $type} {
	set nname_list ""
	foreach ttyp [ic_geo_get_types] {
	    foreach tnam [ic_geo_get_objects $ttyp] {
		lappend nname_list [ic_geo_duplicate $ttyp $tnam]
	    }
	}
	return $nname_list
    }
    set num [$projlib get_number $type $name]
    if {$num < 0} {
	error "No $type named $name exists"
    }
    if {$facetize && (($type == "surface") || ($type == "curve")) && \
	    ([$projlib get_object_type $type $num] == "parametric")} {
	set nnum [$projlib facetize_$type $num 0]
    } else {
	set nnum [$projlib duplicate_entity $type $num]
	set nname [$projlib get_name $type $nnum]
    }
    set ne [define_geom_object $type $nnum]

    if [ic_hex_blocking_loaded] {
	ic_hex_update_comp_curves
    }
    update_geom_visible_obj $ne
    
    set nname [$ne get -name]
    if {$newname != ""} {
	$projlib rename_entity $type [$ne get -number] $newname
	$ne configure -name $newname
	set nname $newname
    }
    return $nname
}
#
#
proc ic_geo_duplicate_set_fam_and_data {type name {newname ""} {famlist ""} {famext _1} {only_surfs 0}} {
# 1) new parameters: famlist, famext - change family to ${fam}$ext if fam is in famlist
# 2) copy meshing params
# 3) no facetizing 
# 4) newname - checking if exists 
    global projlib
    set num [$projlib get_number $type $name]
    if {$num < 0} {return ""}
    if {$type == "body" && $only_surfs == "1"} {
        set nnum [$projlib duplicate_entity body_surfs $num]
    } else {
	    set nnum [$projlib duplicate_entity $type $num]
	}
    set bsp [define_geom_object $type $nnum]
    update_geom_visible_obj $bsp
    set nname [$bsp get -name]
	set newnum [$bsp get -number]
    if {$newname != "" && [$projlib get_number $type $newname] == -1} {
		$projlib rename_entity $type $newnum $newname
		$bsp configure -name $newname
		set nname $newname
    }
	if [llength $famlist] {
		set fam [$bsp get -family]
		if {[lsearch $famlist $fam] >= 0} {
			ic_geo_new_family ${fam}$famext
			$projlib set_family $type $newnum ${fam}$famext
			update_geom_object $bsp
			update_geom_visible_obj $bsp
		}
	}
	set params [ic_set_meshing_params $type $name]
	foreach {opt val} $params {
		ic_set_meshing_params $type $nname $opt $val
	}
    return $nname
}
## Fix problems in surfaces and curves like duplicate triangles, unused
## nodes, etc.

proc ic_geo_fixup {{mesh 0}} {
    global projlib

    if $mesh {
        mess "Fixing potential problems with mesh surfaces and curves ...\n"
    } else {
        mess "Fixing potential problems with surfaces and curves ...\n"
    }
    busy 1
    foreach type {surface curve density} {
        foreach num [$projlib list_objects $type] {
            if {($mesh == 0) || ([$projlib get_object_type $type $num] == "mesh")} {
                $projlib finish_${type}_edit $num
            }
        }
    }
    busy 0
    mess "Done.\n"
}

## Get the minimum edge length on the a list of surfaces or curves.
## Args are:
## <ul>
## <li> <b>surface</b> <i>val</i> : list of surface names
## <li> <b>curve</b>   <i>val</i> : list of curve names
## </ul>
## Typcial usage:
##   set surfaces "surf1 surf2 surf3"
##   set curves   "curv1"
##   ic_geo_min_edge_length surface $surfaces curve $curves

proc ic_geo_min_edge_length {args} {
    global projlib    
    set surface ""
    set curve ""
    foreach {a v} $args {
	set $a $v
    }
    $projlib min_edge_length $curve $surface
}

## Simplify surfaces or curves by coarsening them.
## The arguments are:
## <ul>
## <li><b>tol</b> <i>val</i> : the tolerance to use for coarsening, which
## determines how far from the original surface the new nodes can move
## (default 0)
## <li><b>surfaces</b> <i>namelist</i> : the surfaces to coarsen.
## <li><b>curves</b> <i>namelist</i> : the curves that define prescribed
## nodes that should not be coarsened (default none)
## <li><b>points</b> <i>namelist</i> : the points that should not be coarsened
## away (default none)
## <li><b>auto_curves</b> <i>on</i> : UNIMPLEMENTED - automatically determine
## what curves to preserve
## <li><b>auto_points</b> <i>on</i> : UNIMPLEMENTED - automatically determine
## what points to preserve
## <li><b>n_iter</b> <i>num</i> : how many iterations of coarsening to try
## (default 16)
## <li><b>noisy</b> <i>on</i> : print status information
## </ul>

proc ic_geo_coarsen {args} {
    global projlib interrupt_disable
    
    set surfaces ""
    set curves ""
    set points ""
    set auto_curves 0
    set auto_points 0
    set tol 0.0
    set n_iter 16
    set noisy 1
    set minl 0.0
    
    foreach {n v} $args {
	switch $n {
	    tol - surfaces - curves - points - noisy -
	    auto_curves - auto_points - n_iter - minl {
		set $n $v
	    }
	    default { error "unknown option $n $v" }
	}
    }
    
    if $auto_curves {
    }
    if $auto_points {
    }
    
    if $noisy {
	busy 1
    }
    
    undo_on 0
    set uns [uns_mesh]
    $uns initialize_mesh
    $uns create_family FC -1
    $uns create_family FP -1
    set map [uns_map -mesh $uns -list_type 0]
    
    # Filter out the non-mesh surfaces
    set msurfaces ""
    set n 3
    foreach s $surfaces {
	if {[ic_geo_get_object_type surface $s] != "mesh"} {
	    mess "Not coarsening surface $s - convert to facets first\n" red
	    continue
	}
	lappend msurfaces $s
	$uns create_family F$n -1
	set num [$projlib get_number_by_name surface $s]
	$projlib finish_surface_edit $num
	eval $uns import_tris F$n [$projlib export_tris $num]
	set tri_fams($s) F$n
	incr n
    }
    set surfaces $msurfaces
    
    # Filter out the non-mesh curves
    set mcurves ""
    foreach c $curves {
	if {[ic_geo_get_object_type curve $c] != "mesh"} {
	    mess "Not coarsening curve $c - convert to facets first\n" red
	    continue
	}
	lappend mcurves $c
	$uns create_family F$n -1
	set num [$projlib get_number_by_name curve $c]
	$projlib finish_curve_edit $num
	eval $uns import_bars F$n [$projlib export_bars $num]
	set bar_fams($c) F$n
	incr n
    }
    foreach p $points {
	set num [$projlib get_number_by_name point $p]
	$uns import_point FP [$projlib get_point_loc $num]
    }
    $uns reset_dimension
    
    if ![$uns count MIXED] {
	$uns delete
	undo_on 1
	if $noisy {
	    busy 0
	    mess "No data in surfaces - not coarsening\n"
	}
	return
    }    
    
    # Don't ask about this one.
    set mtol [expr $minl * 0.1]
    if $noisy {
	mess "Merging all nodes with tolerance $mtol\n"
    }
    $map merge_nodes_tol $mtol 0 "0 0 0" "0 0 0" 0 0 0
    
    if $noisy {
	mess "Beginning coarsening: [$uns count nodes] vertices, [$uns count TRI_3] triangles, [$uns count BAR_2] edges, tolerance $tol.\n"
    }
    set cmd [list $map coarsen_elements 0.01 tol $tol n_iter $n_iter]
    if !$noisy { set interrupt_disable 1; lappend cmd quiet }
    eval $cmd
    if !$noisy { unset interrupt_disable }
    
    set vmap [uns_map -mesh $uns]
    $vmap diagnostic_disconnected_verts
    $vmap delete_vertices
    $vmap delete
    
    if $noisy {
	mess "Final: [$uns count nodes] vertices, [$uns count TRI_3] triangles, [$uns count BAR_2] edges.\n"
	mess "Recreating surfaces..."
    }
    undo_on 1
    
    set n 3
    foreach s $surfaces {
	if ![info exists tri_fams($s)] continue
	
	set bsp [$projlib get_object_by_name surface $s]
	set stuff [$uns export_tris $tri_fams($s) 1]
	if {$stuff != ""} {
	    set num [$projlib get_number_by_name surface $s]
	    set nn [eval $projlib replace_surface_mesh $num $stuff]
	    $bsp signal_change 1
	}
	incr n
    }
    foreach s $curves {
	if ![info exists bar_fams($s)] continue
	
	set bsp [$projlib get_object_by_name curve $s]
	set stuff [$uns export_bars $bar_fams($s) 1]
	if {$stuff != ""} {
	    set num [$projlib get_number_by_name curve $s]
	    set nn [eval $projlib replace_curve_mesh $num $stuff]
	    $bsp signal_change 1
	}
	incr n
    }
    
    $map delete
    $uns delete
    if $noisy {
	mess " done coarsening\n"
	busy 0
    }
}

## Do geometry repair.
## Args are:
## <ul>
## <li> <b>toler</b> <i>val</i> : the geometry tolerance
## <li> <b>toler_max</b> <i>val</i> : the maximum gap tolerance
## <li> <b>partial</b> <i>val</i> : allow partial repairing if set, default is 0
## <li> <b>yellow</b> <i>val</i> : yellow curves only if set, default is 1
## <li> <b>do</b> <i>val</i> : Close gaps if value is 1, match
##      surfaces if 2, close one hole if 3, and close multiple
##      holes if 4.
## <li> <b>build_topo</b> <i>val</i> : build topology if set,
##      default is 1 (for do = 1 only)
## <li> <b>new_family</b> <i>name</i> : the family name for new geometry
## <li> <b>new_name</b> <i>name</i> : the entity name for new geometry
## <li> <b>quiet</b> <i>val</i> : Quiet operation if set.  Default is 0.
##      For do = 1 it selects reintersection if 1, fill if 2, blend if 3,
##      and Y-closure if 4.
## <li> <b>db</b> <i>val</i> : Do some checking and printing if > 0, print less
##      messages if < 0.  Default is 0.
## <li> <b>curves</b> <i>names</i> : the names of the curves to do
## </ul>
## Return value is 0 if there was an error and 1 if it was ok.

proc ic_geo_gap_repair {args} {
    global projlib batch_mode last_toler_max

    set curves ""
    set toler 0.01
    set toler_max 0.1
    set do 1
    set yellow 1
    set partial 0
    set build_topo 1
    set new_family ""
    set new_name ""
    set quiet 0
    set db 0

    foreach {n v} $args {
        switch $n {
            toler - toler_max - partial - do - yellow - new_family - \
            new_name - quiet - db - curves - build_topo {
                set $n $v
            }
            default {error "unknown option $n $v"}
        }
    }
    if {$new_family == "-inherited"} {
        set new_family ""
    }
    if {$new_name != "" && [ic_geo_check_objects_exist surface $new_name] == $new_name} {
        mess "Name \"$new_name\" already exists.\n" red
        return 0
    }
    if {$batch_mode && !$quiet} {
        set quiet 1
    }
    set nums ""
    foreach obj $curves {lappend nums [$projlib get_number_by_name curve $obj]}

    if {$do == 1} {
 # 59122 : this function works for param surfaces only
      foreach crv $curves {
        set srfs [ic_geo_incident curve $crv]
        foreach srf $srfs {
          if {[ic_geo_get_object_type surface $srf] != "param"} {
            mess "Extend/Trim function works only for parametrical surfaces.\nTry \"Close Holes\" function." red
            return
          }
        } 
      }  
        if {!$quiet} {
            mess "Close gaps.\n"
        }
    } elseif {$do == 2} {
        if {!$quiet} {
            mess "Match surfaces.\n"
        }
    } elseif {$do == 3} {
        if {!$quiet} {
            mess "Close one hole.\n"
        }
    } elseif {$do == 4} {
        if {!$quiet} {
            mess "Close multiple holes.\n"
        }
    } else {
        mess "Illegal do parameter.\n" red
        return 0
    }
# Note: busy is very slow for large number of visible objects
 #   busy 1
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    set ret 1
    if {$do == 1} { set last_toler_max $toler_max }
    if [catch {tsf_clean $projlib $toler $toler_max $partial $nums $do $new_family \
        $yellow $quiet $new_name $db $build_topo} err] {
        if {$err != ""} {
            mess "$err\n" red
            set ret 0
        }
    }
    if {$do == 1} { unset last_toler_max }
    update_bsp_consistency
    $projlib configure -topo_valid 0
    if $resume {
        ic_undo_resume
    }
  #  busy 0
    return $ret
}

## Create midsurfaces.
## Args are:
## <ul>
## <li> <b>max_dist</b> <i>val</i> : the maximum distance between surface pairs
## <li> <b>family</b> <i>val</i> : the family name for midsurfaces
## <li> <b>surfaces</b> <i>names</i> : the names of the surfaces to compress
## <li> <b>surfaces2</b> <i>names</i> : the names of the second set of surfaces to compress
## <li> <b>save_old</b> <i>val</i> : save compressed surfaces if set
## <li> <b>partial</b> <i>val</i> : create partial midsurface if set
## <li> <b>similar</b> <i>val</i> : do similar pairs only if set
## <li> <b>alternate</b> <i>val</i> : do alternate order of surfaces if set
## <li> <b>prefer_connected</b> <i>val</i> : prefer connected surface pairs if set
## <li> <b>precision</b> <i>val</i> : precision value for midsurface if set
## <li> <b>offset</b> <i>val</i> : just offset side 1 half distance to side 2 
## <li> <b>tolerance</b> <i>val</i> : the midsurface tolerance if set
## <li> <b>ask</b> <i>val</i> : quiet operation if not set, ask yes/no if
##      1, present the candidates and ask yes/no if 2, just count and return
##      number of candidates if 3
## </ul>
## Return value is 0 if there was an error and 1 if it was ok.

proc ic_geo_midsurface {args} {
    global projlib

    set surfaces ""
    set surfaces2 ""
    set max_dist 0.0
    set save_old 0
    set ask 0
    set ret 0
    set partial 0
    set precision 0
    set tolerance 0.0
    set similar 0
    set prefer_connected 1
    set family "MIDSURFACES"
    set offset 0
    set alternate 0
    set debug 0
    foreach {n v} $args {
        switch $n {
            max_dist - family - surfaces - surfaces2 - save_old - ask - partial - \
            similar - precision - tolerance - prefer_connected - offset - \
            alternate - debug {
                set $n $v
            }
            default {error "unknown option $n $v"}
        }
    }
    if {$debug} {
        mess "surfaces = \"$surfaces\"\n" red
        if {$surfaces2 != ""} {
            mess "surfaces2 = \"$surfaces2\"\n" red
        }
    }
    set nums ""
    set side 0
    foreach obj $surfaces {
        lappend nums [$projlib get_number_by_name surface $obj]
    }
    if {$surfaces2 != ""} {
        set side [llength $nums]
        if {$debug} {
           mess "$side surfaces belong to first set.\n" red
        }
        if {$offset} {
            set side -$side
            if {$debug} {
                mess "Just do offset.\n" red
            }
        }
        foreach obj $surfaces2 {
            lappend nums [$projlib get_number_by_name surface $obj]
        }
    }
    if {[llength $nums] < 2} {
        mess "Please select at least two surfaces.\n" red
        set ret 1
    } else {
        if {$debug} {
            mess "[llength $nums] surfaces to compress.\n" red
        }
        if {$family != ""} {
            mess "Creating midsurfaces for part \"$family\".\n"
        } else {
            mess "Creating midsurfaces.\n"
        }
        busy 1
        set resume 0
        if ![ic_undo_suspended] {
            ic_save_model_for_undo
            ic_undo_suspend
            set resume 1
        }
        if [catch {geoclean_midsurface $max_dist $family $save_old $nums $ask \
            $partial $precision $similar $debug $tolerance $prefer_connected $side \
            $alternate} ret] {
            mess "$ret\n" red
        }
        if {$offset} {
            #
            #   The midsurface function currently just returns
            #   the approximated surface and the distance ...
            #   so we do offsetting now.
            #
            set asurf [lindex $ret 0]
            set dist [lindex $ret 1]
            if {$debug} {
                mess "Approximated surface = $asurf, distance = $dist\n" red
            }
            set res 0
            set nasurf [$projlib get_number_by_name surface $asurf]
            set afam [$projlib get_family surface $nasurf]
            if {[catch {ic_geo_cre_srf_offset $afam offset $asurf $dist} $res]} {
		        return -code error "Error creating offset: $res"
    	    }
    	    set ret 1
        }
        if $resume {
            ic_undo_resume
        }
        busy 0
    }
    return $ret
}

## Look up geometry objects based on certain criteria.  <b>type</b> may be
## one of the geometry type names or <b>all</b>.
## This always returns a list of type/name pairs.
## Useful values for <b>how</b> and <b>args</b> are:
## <ul>
## <li> <b>names</b> <i>names</i> : return objects with the given names
## <li> <b>families</b> <i>names</i> : return objects with the given families
## <li> <b>all</b> : return all objects of the specified types
## <li> <b>patterns</b> <i>pats</i> : looks up objects based on glob-style
## name matching (e.g., FAM*)
## <li> <b>visible</b> : all visible objects
## <li> <b>blanked</b> : all non-visible objects
## </ul>

proc ic_geo_lookup {types how {spec ""}} {
    set ret ""
    # i added 0 for report_err arg so I could call like
    #   set list [ic_geo_lookup all names $e]  --jka, 23 oct 02
    foreach obj [geo_lookup $types $how $spec 0] {
	lappend ret [list [$obj get -type] [$obj get -name]]
    }
    return $ret
}
set dont_record_command(ic_geo_lookup) 1

## For the given list of entities, return a *flat* list of "type entname" pairs, i.e.
## {type_1 ent_1 type_2 ent_2 ... type_n ent_n}

proc ic_geo_get_entity_types {entnames} {
    set ent_type_pairs ""
    foreach e $entnames {
	catch {ic_geo_lookup all names $e} list
	append ent_type_pairs "[lindex $list 0] "
    }
    return $ent_type_pairs
}
set dont_record_command(ic_geo_get_entity_types) 1

## How much memory is the geometry data using now?

proc ic_geo_memory_used {} {
    global projlib
    if {$projlib == ""} { return 0 }
    return [$projlib memory_used]
}
set dont_record_command(ic_geo_memory_used) 1

## Set the projection mode: 

proc ic_geo_project_mode {which} {
    global projlib
    if {$projlib != ""} {
	$projlib configure -project_to_active $which
    }
}

# ---------------------

## What is the current coordinate system.

proc ic_csystem_get_current {} {
    global projlib
    if {$projlib == ""} { return global }
    set cur [$projlib csystem_get_current]
    if {$cur == ""} { return global }
    return $cur
}
set dont_record_command(ic_csystem_get_current) 1

## Set the current coordinate system.

proc ic_csystem_set_current {what} {
    global projlib uns_cur str_cur hexlib
    if {$projlib == ""} { return "" }
    set ret [$projlib csystem_set_current $what]
    if {$uns_cur != ""} { $uns_cur signal_change 1 }
    #if {$str_cur != ""} { $str_cur signal_change 1 }
    if [ic_hex_blocking_loaded] { ic_hex_set_coordinate_system $what }

    return $ret
}

## List the existing coordinate systems.

proc ic_csystem_list {} {
    global projlib
    if {$projlib == ""} { return "" }
    return [$projlib csystem_list]
}
set dont_record_command(ic_csystem_list) 1

## Get information on the named coordinate system.  This returns a list of
## 4 items: the type of the coordinate system, the origin, and the 3 vectors
## that define coordinate system.  The type can be one of:
## <ul>
## <li> <b>cartesian</b>
## <li> <b>cylindrical</b>
## <li> <b>spherical</b>
## <li> <b>toroidal</b>
## </ul>

proc ic_csystem_get {name} {
    global projlib
    if {$name == "global"} {
        return [list cartesian "0 0 0" "1 0 0" "0 1 0" "0 0 1"]
    } else {
        return [$projlib csystem_get $name]
    }
}
set dont_record_command(ic_csystem_get) 1

## Delete the named coordinate system.

proc ic_csystem_delete {name} {
    global projlib
    if {[lsearch [ic_csystem_list] $name] >= 0} {
        $projlib csystem_delete $name
    }
}

## Create a new coordinate system with the given parameters.
## <ul>
## <li> <b>name</b> : the name of the system to create.
## <li> <b>type</b> : the type which can be one of
## <b>cartesian</b>,
## <b>cylindrical</b>,
## <b>spherical</b>, or
## <b>toroidal</b> (as yet unsupported).
## <li> <b>center</b> : the center point in 3-D coords.
## <li> <b>axis0</b> : the first axis vector.
## <li> <b>axis1</b> : the second axis vector.
## <li> <b>axis2</b> : the third axis vector.
## </ul>

proc ic_csystem_create {name type center axis0 axis1 axis2} {
    global projlib
    $projlib csystem_create $name $type $center $axis0 $axis1 $axis2
}

## Translate coordinates from the current or given system into
## the global system.

proc ic_coords_into_global {pt {system ""}} {
    return [coords_into_global $pt $system]
}
set dont_record_command(ic_coords_into_global) 1

## Translate a vector from the current or given system into the global system.
 
proc ic_coords_dir_into_global {pt {system ""}} {
    return [coords_dir_into_global $pt $system]
}
set dont_record_command(ic_coords_into_global) 1

## Translate coordinates from the global system into the current
## or given local system.

proc ic_coords_into_local {pt {system ""}} {
    return [lrange [coords_into_local $pt $system] 0 2]
}
set dont_record_command(ic_coords_into_local) 1

## Display the named coord system.  If it's <b>all</b> and <b>on</b> is 0 then
## erase all coord systems.

proc ic_csystem_display {name on} {
    global csystem_display tdv_default projlib batch_mode

    if $on {
	ic_csystem_display all 0
	if ![info exists csystem_display($name)] {
	    set csystem_display($name) [csystem_display]
	    if !$batch_mode { $tdv_default add_image $csystem_display($name) }
	}
	set data [$projlib csystem_get $name]
	if {$data == ""} { error "no such coord system $name" }

	$csystem_display($name) configure -name $name -type [lindex $data 0] \
	    -origin [lindex $data 1] -axis0 [lindex $data 2] \
	    -axis1 [lindex $data 3] -axis2 [lindex $data 4] -width 2 -size 100

    } elseif {$name == "all"} {
	foreach cs [array names csystem_display] {
	    $csystem_display($cs) delete
	}
	catch {unset csystem_display}

    } elseif [info exists csystem_display($name)] {
	$csystem_display($name) delete
	unset csystem_display($name)
    }
}
set dont_record_command(ic_csystem_display) 1

proc ic_get_coordinate_system {name} {

    set cc [ic_csystem_get $name]
    if {$cc == ""} { return "" }
    return [eval concat system name $name type [lindex $cc 0] \
        origin [lindex $cc 1] xaxis [lindex $cc 2] \
        yaxis [lindex $cc 3] zaxis [lindex $cc 4]]
}
set dont_record_command(ic_get_coordinate_system) 1

# ------------------------------------------------------------------

## Untrim a surface.

proc ic_geo_untrim_surface {surf} {
    global projlib
    set resume 0
    if ![ic_undo_suspended] {
	ic_save_model_for_undo
	ic_undo_suspend
	set resume 1
    }
    set edges [ic_geo_get_srf_edges $surf]
    $projlib untrim_surface $surf
    set obj [$projlib get_object_by_name surface $surf]
    $obj signal_change 0
    #
    foreach crv $edges {
	set eb [$projlib get_number curve $crv]
	set eb [define_geom_object  curve  $eb]
	update_geom_visible_obj $eb
    }
    #
    if $resume {
        ic_undo_resume
    }
}

## Get the thincut data

proc ic_geo_get_thincuts {} {
    global projlib
    return [$projlib get_thincuts]
}
set dont_record_command(ic_geo_get_thincuts) 1

## Set the thincut data

proc ic_geo_set_thincuts {data} {
    global projlib
    eval $projlib set_thincuts $data
}

## Get the periodic data

proc ic_geo_get_periodic_data {} {
    global projlib
    return [$projlib get_periodic_data]
}
set dont_record_command(ic_geo_get_periodic_data) 1

## Set the periodic data

proc ic_geo_set_periodic_data {data} {
    global projlib hexlib

    eval $projlib set_periodic_data $data
    if [ic_hex_blocking_loaded] {
        ic_hex_update_periodicity
    }
}

## Get a family param
proc ic_geo_get_family_param {fam name} {
    global projlib
    
    if {($fam == "ORFN") || ($fam == "VORFN")} return
    
    array set syn {
	    emax tetra_size ehgt height emin min edev dev erat ratio 
	    hrat hratio ewid width
    }
    if [info exists syn($name)] { set name $syn($name) }
    if {$name == "prism"} {
	    set val [$projlib get_family_param $fam prism]
	    if {$val != "" && $val != 0} {return 1} else {return 0}
    } else {
	    return [$projlib get_family_param $fam $name]
    }
}
set dont_record_command(ic_geo_get_family_param) 1

## Set a family param.  If there is no such family don't do anything

proc ic_geo_set_family_params {fam args} {
    global projlib

    if {($fam == "ORFN") || ($fam == "VORFN")} return

    set first [lindex $args 0]
    if {$first == "only_crv_inf"} {
	    set only_crv_inf 1
	    set args [lrange $args 1 end]
    } elseif {$first == "no_crv_inf"} {
	    set no_crv_inf 1
	    set args [lrange $args 1 end]
    } elseif {$first == "reset_crv_inf"} {
	    set reset_crv_inf 1
	    set args [lrange $args 1 end]
    }
    
    if [ic_wb2_input_parameter_mode] {
        if {$args != ""} {
            set args2 ""
            foreach "n v" $args {
                if [ic_wb2_is_input_part_param_set $n $fam] continue
                lappend args2 $n $v
            }
            set args $args2
        }
        if {$args == ""} return
    }
    
    set pfams [ic_geo_list_families_in_part $fam]
    if ![info exists only_crv_inf] {
	    array set syn {
	        emax tetra_size ehgt height emin min edev dev erat ratio hrat hratio ewid width
	    }
	    # First update the family and then all the ents in the family
	    foreach {name val} $args {
	        if [info exists syn($name)] { set name $syn($name) }
	        if {$name == "prism"} {
		        if {$val != "" && $val != 0} {set val 1}
	        }
	        foreach fam $pfams {$projlib set_family_param $fam $name $val}
	    }
    }

    # update entities only for non-volume families
    # this takes extra time.  Can we just check if this one family is a volume family?
    catch {unset is_matfam}
    foreach mf [ic_geo_list_families 1] {
	    set is_matfam($mf) 1
    }

    set inf_pars {ehgt hrat nlay ewid erat}
    set cargs ""
    if [info exists no_crv_inf] {
	    # Don't apply (or change) inflation params on curves
	    foreach {n v} $args {
	        if {[lsearch $inf_pars $n] < 0} {
		    lappend cargs $n $v
	        }
	    }
    } elseif [info exists reset_crv_inf] {
	    # Set inflation params to zero on curves
	    foreach n $inf_pars {
	        lappend cargs $n 0
	    }
	    foreach {n v} $args {
	        if {[lsearch $inf_pars $n] < 0} {
		        lappend cargs $n $v
	        }
	    }
    } else {
	    # curve mesh params should use the hrat value for erat
	    foreach {n v} $args {
	        if {$n == "hrat"} {
		        if {$v != ""} {lappend cargs erat $v}
	        } elseif {$n != "erat"} {
		        lappend cargs $n $v
	        }
	    }
	    if [info exists only_crv_inf] {
	        # Only apply inflation params, and only do it to curves
	        set args ""
	        set argsn ""
	        foreach {n v} $cargs {
		        if {[lsearch $inf_pars $n] > -1} {
		            lappend argsn $n $v
		        }
	        }
	        set cargs $argsn
	    }
    }

    foreach fam $pfams {
        if ![info exists is_matfam($fam)] {
	        set pid [$projlib lookup_family_pid $fam]
	        if {$pid != ""} {
		        if {$args != ""} {
		            foreach type {surface point loop density} {
			            set enums [$projlib get_objects_in_family $type $pid]
			            foreach n $enums {
			                eval $projlib set_meshing_params $type $n $args
			                set obj [$projlib get_object $type $n]
			                if {$obj != ""} { $obj signal_change 0 }
			            }
		            }
		        }
		        set enums [$projlib get_objects_in_family curve $pid]
		        foreach n $enums {
		            eval $projlib set_meshing_params curve $n $cargs
		            set obj [$projlib get_object curve $n]
		            if {$obj != ""} { $obj signal_change 0 }
		        }
	        }
	    }
    }
    $projlib configure -modified 1
}

## Reset family param on families <em>fams</em> for parameters <em>params</em>

proc ic_geo_reset_family_params {fams params} {
    global projlib
    array set syn {
	emax tetra_size ehgt height emin min edev dev erat ratio hrat hratio ewid width
    }
    foreach fam $fams {
	if { ($fam == "ORFN") || ($fam == "VORFN") } { continue }
	foreach name $params {
	    if [info exists syn($name)] { set name $syn($name) }
	    $projlib set_family_param $fam $name {}
	}
    }
}

## Delete unattached stuff.

proc ic_geo_delete_unattached { { fams "" } {quiet 0} {only_if_dormant 0}} {
    global projlib tdv_default batch_mode

    set pa [tdv_active 0]
    set flags ""
    if $only_if_dormant {
        set flags "-only_if_dormant"
    }
    set deletes [eval $projlib delete_unattached $fams $flags]
    if {!$quiet} {
        mess "$deletes\n"
    }
    process_deletes $deletes
    tdv_active $pa
}

## Remove features

proc ic_geo_remove_feature {curves} {
    global projlib
 # Modif: Oct, 30, 2006  
 # only curves which are "interior" to some surface will be used    

    foreach srf [ic_geo_incident curve $curves] {
		set bnd_crvs [ic_geo_boundary surface $srf]
		set outer_crvs [ic_geo_boundary surface $srf 1]
		foreach crv $bnd_crvs {
			if {[lsearch $outer_crvs $crv] < 0} { 
				set tmp_int_crv($crv) 1
			}
		}
	}
    set int_crvs ""	
	foreach crv $curves {
		 if [info exists tmp_int_crv($crv)] {
			lappend int_crvs $crv
		}
	}        
	if ![llength $int_crvs] {
		mess "No selected features\n" red 
		return
	}
    set surfs [ic_geo_incident curve $int_crvs]
    set deletes [eval $projlib remove_feature $int_crvs]
    mess $deletes

    process_deletes $deletes

    set crv_pnts [ic_geo_get_all_marked_pnts]
    foreach p $crv_pnts {
        set lst [ic_geo_incident point $p 1]
	    if {[llength $lst] == 0} {
	        ic_delete_geometry point names $p
	    }
    }
    foreach s $surfs {
	    if {[ic_geo_check_objects_exist surface $s] == ""} {
	        mess "Surface \"$s\" no longer exists\n" red
	    } else {
	        set srf [$projlib get_object_by_name surface $s]
	        $srf signal_change 0
	    }
    }
}

## Merge curves

proc ic_geo_merge_curves {curves} {
    global projlib
    set deletes [eval $projlib merge_curves $curves]
    mess "$deletes\n"
    process_deletes $deletes
}

## Reapproximate curves.
## <table border>
## <tr><td> curves </td><td> list of curve names </td></tr>
## <tr><td> tol    </td><td> reapproximation tolerance </td></tr>
## <tr><td> ask    </td><td> prompt to accept result </td></tr>
## <tr><td> return </td><td> list of new curve names </td></tr>
## 
## <b>Notes</b>
## <ul>
## <li> In interactive mode, if the ask parameter is 1 (default)
##      the user will be prompted for each curve whether the result
##      is okay.  Parameter is ignored in batch mode.
## </ul>

proc ic_geo_modify_curve_reappr {curves tol {ask 1}} {
    global projlib ask_reappr_curves batch_mode aborted
    set aborted 0
    if $batch_mode {
        set ask_reappr_curves 0
    } else {
        set ask_reappr_curves $ask
    }
    set ret ""
    set crv_id ""
    foreach name $curves {
        set number [$projlib get_number_by_name curve $name]
        mess "Reapproximating curve \"$name\" with tolerance $tol.\n"
        if [catch {geoclean_reappr_curve $name $number $tol gm_crv_reappr_pre gm_crv_reappr_post} crv_id] {
            mess "$crv_id" red
       	} else {
            if {$crv_id!=""} {
                define_geom_object curve $crv_id
		        lappend ret [$projlib get_name curve $crv_id]
	        }
       	}
	    if $aborted {
	        mess "Aborted.\n"
	        break
	    }
    }
    return $ret
}

## Reapproximate surfaces.
## <table border>
## <tr><td> surfaces </td><td> list of surface names </td></tr>
## <tr><td> tol      </td><td> reapproximation tolerance </td></tr>
## <tr><td> ask      </td><td> prompt to accept result if set </td></tr>
## <tr><td> each     </td><td> reapproximate each surface seperately if set </td></tr>
## <tr><td> curves   </td><td> list of curve names </td></tr>
## <tr><td> return   </td><td> list of new surface names </td></tr>
## 
## <b>Notes</b>
## <ul>
## <li> In interactive mode, if the ask parameter is 1 (default)
##      the user will be prompted for each surface whether the result
##      is okay.  Parameter is ignored in batch mode.
## </ul>

proc ic_geo_modify_surface_reappr {surfaces tol {ask 1} {each 0} {curves ""}} {
    global projlib ask_reappr_surfaces batch_mode aborted ask_all
    set aborted 0
    if $batch_mode {
        set ask_reappr_surfaces 0
    } else {
        set ask_reappr_surfaces $ask
    }
    set ret ""
    set cname ""
    set cnumbers ""
    set n_surface [llength $surfaces]
    set n_curves [llength $curves]
    if {$n_curves > 0} {
        # approximate by curve
        set each 0
    }
    set ask_all 0
    if {$each > 0 || ($n_surface == 1 && $n_curves == 0) } {
        if {$n_surface > 1} {
            set ask_all 1
        }
        foreach name $surfaces {
            # "name" could be a list of surfaces to support multiple groups of
            # surfaces to reapproximate.
            set number ""
            foreach n $name {
                lappend number [$projlib get_number_by_name surface $n]
            }
            mess "Reapproximating surface \"$name\" with tolerance $tol.\n"
            lappend ret [geoclean_reappr_surface $cname $cnumbers $name $number $tol \
                gm_srf_reappr_pre gm_srf_reappr_post]
            if $aborted {
                mess "Aborted.\n"
                break
            }
        }
    } else {
        set numbers ""
        foreach name $surfaces {
            append numbers "[$projlib get_number_by_name surface $name] "
        }
        if {$n_surface == 0} {
            set name ""
        }
        if { $n_curves > 0 } { 
            set cnumbers ""
            foreach cname $curves {
                append cnumbers "[$projlib get_number_by_name curve $cname] "
            }
            mess "Reapproximating $n_surface surfaces by $n_curves curves with tolerance $tol.\n"
            lappend ret [geoclean_reappr_surface $cname $cnumbers $name $numbers $tol \
                gm_srf_reappr_pre gm_srf_reappr_post]
        } else {
            mess "Reapproximating $n_surface surfaces with tolerance $tol.\n"
            lappend ret [geoclean_reappr_surface $cname $cnumbers $name $numbers $tol \
                gm_srf_reappr_pre gm_srf_reappr_post]
        }
    }
    if {$ret != "" && $ret != "{}"} {
        set ret_names ""
        foreach id $ret {
            if {[llength $id] == 0} continue
            lappend ret_names [$projlib get_name surface $id]
        }
        return $ret_names
    } else {
	return ""
    }
}

# The return values are:
# 1 accept
# 0 reject
proc gm_crv_reappr_pre {crv_id crv_name appr_id dist} {
    global projlib ask_reappr_curves batch_mode aborted

    if !$batch_mode {
        set busy_last [busy reset]
        busy 0
        update_bsp_consistency
    }
    mess "Reapproximation error of $dist.\n"
    if $ask_reappr_curves {
        set crvStf "curve $crv_id curve $appr_id"
        set status [present_geometry $crvStf "Accept reapproximation? " \
            {n "no" y "yes" a "yes to all" x "cancel"}]
	if {$status == 2} {
	    set status 1
	    set ask_reappr_curves 0
	}
	if {$status == 3} {
	    set status 0
	    set aborted 1
	}
    } else {
        set status 1
    }
    if !$batch_mode {
        busy $busy_last
    }
    return $status
}

# The return values are:
# 1 accept
# 0 reject
proc gm_srf_reappr_pre {appr_id} {
    global projlib ask_reappr_surfaces batch_mode aborted ask_all

    if !$batch_mode {
        set busy_last [busy reset]
        busy 0
    }
    update_bsp_consistency
    if $ask_reappr_surfaces {
        if {$ask_all} {
            set status [present_geometry "surface $appr_id" "Accept reapproximation? " \
                {n "no" y "yes" a "yes to all" x "cancel"}]
            if {$status == 2} {
                set status 1
                set ask_reappr_surfaces 0
            }
            if {$status == 3} {
                set status 0
                set aborted 1
            }
         } else {
            set status [present_geometry "surface $appr_id" "Accept reapproximation? " \
                {n "no" y "yes"}]
         }
    } else {
        set status 1
    }
    if !$batch_mode {
        busy $busy_last
    }
    return $status
}

proc gm_crv_reappr_post { crv_id } {
    global projlib batch_mode

    if !$batch_mode {
        busy 1
        update_bsp_consistency
        set crvStf "curve $crv_id"
        if [catch {center_geometry $crvStf } res] {
            mess "Error in reappr post callback: $res"
        }
        busy 0
    }
    return [$projlib get_name curve $crv_id]
}

proc ic_geo_calculate_thickness {mid_surfaces {sol_surfaces ""} \
    {order 2} {thickness 0} {debug 0}} {
    global projlib

    set mid_surf_numbers ""
    foreach name $mid_surfaces {
        append mid_surf_numbers "[$projlib get_number_by_name surface $name] "
    }
    set sol_surf_numbers ""
    foreach name $sol_surfaces {
        append sol_surf_numbers "[$projlib get_number_by_name surface $name] "
    }
    set n_mid_surfaces [llength $mid_surfaces]
    if {$n_mid_surfaces != 1} {
        mess "Calculating thickness of $n_mid_surfaces midsurfaces.\n"
    } else {
        mess "Calculating thickness of midsurface.\n"
    }
    if $debug {
        mess "Order = $order, thickness = $thickness\n"
    }
    if [catch {midsurface_calculate_thickness $mid_surf_numbers $sol_surf_numbers \
        $order $thickness $debug} res] {
        mess "$res\n" red
        return 4711
    }
    return $res
}
set dont_record_command(ic_geo_calculate_thickness) 1

## Reset the Tcl data structures after making big changes to the
## proj database.

proc ic_geo_reset_data_structures {} {
    global batch_mode

    if !$batch_mode {
        update_bsp_consistency
    }
}

## Modify the display of the size icons for ref, natural, and max size
## Also can be used for per-object parameters like tetra_size

proc ic_geo_params_update_show_size {type size} {
    global projlib batch_mode
    global tdv_default
    
    if $batch_mode { return }
    
    switch $type {
	surface - curve - point - body - material {
	    $projlib configure_objects_draw_sizes $type $size
	}
	default {
	    $projlib configure -draw_${type}size $size \
		-draw_${type}size_pt [tdv_get_centroid $tdv_default]
	}
    }
    $tdv_default redraw
}
set dont_record_command(ic_geo_params_update_show_size) 1

## Repair holes using the stlrepair functionality. Type indicates
## the entity type by which segments are specified, e.g. surface.

proc ic_geo_stlrepair_holes {type segs add_nodes int_surf {complete_edges 1} {dcurves ""} {toler ""} {part ""}} {
    global projlib geo_cad batch_mode remesh
    global tdv_default

    busy 1
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    set uns [uns_mesh]
    $uns initialize_mesh
    set start 0; set end 0
    foreach ss $segs {
        set nn [$projlib get_number_by_name $type [lindex $ss 0]]
        set ss_len [llength [lindex $ss 1]]
        set end [expr $end + $ss_len]
        if {$dcurves != "" && $ss_len > 1} {
            set uni_pairs ""
            foreach c [lrange $dcurves $start $end] {
                set num_seg [lindex [ic_geo_num_segments curve $c] 0]; set ii 0
                foreach pp [lindex $ss 1] {
                    set pairs [expr [llength $pp] / 2]
                    if {$pairs == $num_seg} {
                        lappend uni_pairs [lindex [lindex $ss 1] $ii]
                    }
                    incr ii
                }
            }
            set edges [uniquify_pairs [list $uni_pairs]]
        } else {
            set edges [uniquify_pairs [lindex $ss 1]]
        }
        if {$edges == ""} {
            set skip($nn) 1; set start [expr $end + 1]; continue
        }
        set stuff [eval $projlib export_tri_edges $nn $edges]
        eval $uns import_bars F$nn $stuff
        set start [expr $end + 1]
    }
    $uns reset_dimension
    # note that I have made this an EXPLICIT list, necessarily -JKA
    set map [uns_map -mesh $uns -color yellow -width 2 -list_type 2]
    $map add_all_type BAR_2
    $map add_all_nodes
    set min_edge [$map min_edge_length]
    set tol [expr $min_edge * 0.1]
    $map merge_nodes_tol $tol 0 "0 0 0" "0 0 0" 0 0 0
    if !$batch_mode { $tdv_default add_image $map }
    if {$toler == ""} {
        if [info exists geo_cad(toler)] {
            set remesh(ele_tol) $geo_cad(toler)
        } else {
            set remesh(ele_tol) 0.0
        }
    } else {
        set remesh(ele_tol) $toler
    }
    set remesh(geo_active) 0
    set remesh(how) 2
    set remesh(surf) $int_surf
    set remesh(complete_edges) $complete_edges
    if $add_nodes {
        # TRI_3
        set remesh(element) 3
    } else {
        # TRI_3 (STL-like)
        set remesh(element) 5
    }
    foreach h [array names remesh] {
        append args "$h $remesh($h) "
    }
    set nok [eval ic_uns_quad_remesh $map $args]
    if {$nok != "error"} {
        foreach ss $segs {
            set nn [$projlib get_number_by_name $type [lindex $ss 0]]
            if [info exists skip($nn)] continue
            set name [lindex $ss 0]
            set stuff [$uns export_tris F$nn 1]
            if {$stuff != ""} {
                eval $projlib add_to_unstruct_surface $nn $stuff
                $projlib finish_surface_edit $nn
                if {$part != ""} {
                    ic_geo_set_part surface $name $part 0
                }
            }
        }
    }
    $map delete
    $uns delete
    if $resume {
        ic_undo_resume
    }
    busy 0
    if {$nok == "error"} { return 0 }
    return 1
}

## Repair edges using the stlrepair functionality. Type indicates
## the entity type by which segments are specified, e.g. surface.
proc ic_geo_stlrepair_edges {type segs merge_tol {merge_ends -1}} {
# VG: 03/09/07: Fixing function for 52990; cleaning weird stuff
# Function has been used in lib only 2 times, both with type == surface

    global projlib remesh batch_mode
    global tdv_default

    # save the whole model
    ic_save_model_for_undo
    ic_undo_suspend

    set uns [uns_mesh]
    $uns initialize_mesh
    foreach ss $segs {
	    set nn [$projlib get_number_by_name $type [lindex $ss 0]]
	    set edges [uniquify_pairs [lindex $ss 1]]
	    #set edges [lindex $ss 1]
	    set stuff [eval $projlib export_tris_and_edges $nn 0 $edges]
	    eval $uns import_bars_and_tris F$nn [lrange $stuff 0 5]
	    eval lappend to_delete($nn) [lrange $stuff 6 end]
    }
    
    $uns reset_dimension
    set map [uns_map -mesh $uns -color yellow -width 2 -list_type 2]
    # -draw_enums 1 -draw_nodes 1 -draw_node_type 2
    $map add_all_type BAR_2
    $map add_all_type TRI_3
    $map add_all_nodes
    set tol [expr [$map min_edge_length] * 0.1]
    $map merge_nodes_tol $tol 0 "0 0 0" "0 0 0" 0 0 0
    if !$batch_mode { $tdv_default add_image $map }
    
    set remesh(geo_active) 0
    set remesh(how) 3
    set remesh(merge_tol) $merge_tol
    set remesh(element) 3 ;#TRI_3
    if {$merge_ends >= 0} {
        set remesh(merge_ends) $merge_ends
    }

    busy 1
        foreach h [array names remesh] {
            append args "$h $remesh($h) "
        }
        set nok [eval ic_uns_quad_remesh $map $args]
    busy 0

    if !$nok {
	$map add_all_type BAR_2
	$map add_all_type TRI_3
	#what's this??? if !$batch_mode { $tdv_default redraw; after 500 }
	
	# It might be that the same surface is referenced more than once
	# in the segs list.  Make sure we go through this loop the correct
	# number of times ...
	
	foreach arr {to_add old_curves old_points old_surfs} {
	  if [info exists $arr] {unset $arr}
	}
	foreach ss $segs {
# surf is the name of the surface
		set nn [$projlib get_number_by_name $type [lindex $ss 0]]
		set surf [lindex $ss 0]
	    if ![info exists to_add($nn)] {
		set to_add($nn) [$uns export_tris F$nn 1]
	    }
	  set old_surfs($surf) 1
	  foreach curve [ic_geo_boundary surface $surf] {
	      set old_curves($curve) 1
	      foreach point [ic_geo_boundary curve $curve] {
	        set old_points($point) 1
	      }
            }
	}
	
	# Get rid of the old stuff.
	foreach nn [array names to_delete] {
	    if {($to_add($nn) != "") && ($to_delete($nn) != "")} {
		eval $projlib delete_surface_triangles $nn $to_delete($nn)
	    }
	}
	
	# Now put in the new stuff.
	foreach nn [array names to_add] {
	    if {$to_add($nn) != ""} {
		eval $projlib add_to_unstruct_surface $nn $to_add($nn)
	    }
	    $projlib finish_surface_edit $nn
	}
	catch {unset to_delete}

	set args $merge_tol 
	lappend args -surfaces [array names old_surfs]
  if [array exists old_curves] {
         lappend args -curves [array names old_curves]
        }
  if [array exists old_points] {
         lappend args -points [array names old_points]
        }
        eval ic_build_topo $args
        update_bsp_consistency
    }
    $map delete
    $uns delete

    ic_undo_resume
    if $nok { mess "Repair failed.\n" red; return }
}

## Display some geometry selected or not

proc ic_show_geo_selected {type names on {color ""} {force_visible 0}} {
    global projlib tdv_default batch_mode
    
    if {$projlib == ""} return
    if {$color == ""} { set color [$tdv_default highlight_color] }
    
    if {$type == "family"} {
        set pa [tdv_active 0]
	    foreach name $names {
	        set pid [$projlib lookup_family_pid $name]
            if {$pid == ""} {
                puts "no pid: $name"
                continue
            }
	        foreach {type num} [$projlib get_objects_in_family "" $pid] {
			    set obj [$projlib get_object $type $num]
			    if {$obj == ""} continue
			    show_geo_selected $obj $on $color $force_visible
	        }
	    }
        tdv_active $pa
    } elseif {$type == "mixed"} {
	    foreach {type name} $names {
	        if [ catch { $projlib get_object_by_name $type $name } obj ] {
		        mess "$type $name doesn't exist\n"
	        } elseif {$obj != ""} {
		        show_geo_selected $obj $on $color $force_visible
	        }
	    }
	} else {
	    foreach name $names {
	        if [ catch { $projlib get_object_by_name $type $name } obj ] {
		        mess "$type $name doesn't exist\n"
	        } elseif {$obj != ""} {
		        show_geo_selected $obj $on $color $force_visible
	        }
	    }
    }
}
set dont_record_command(ic_show_geo_selected) 1

## Reset all selection display

proc ic_reset_geo_selected {} {
    global batch_mode
    if !$batch_mode {
        show_geo_selected "" 0
    }
}
set dont_record_command(ic_reset_geo_selected) 1

## Get all current geom selections

proc ic_get_geo_selected {} {
    global batch_mode show_geo_selected
    set ret ""
    if !$batch_mode {
	foreach i [array names show_geo_selected] {
	    lappend ret $i
	}
    }
    return $ret
}
set dont_record_command(ic_get_geo_selected) 1

## Set all previous geom selections

proc ic_set_geo_selected {selected on} {
    global batch_mode
    if !$batch_mode {
	foreach i $selected {
	    show_geo_selected $i $on
	}
    }
}
set dont_record_command(ic_set_geo_selected) 1

## Return the previously used selection option.

proc ic_select_geometry_option {} {
    global select_geometry_option
    return $select_geometry_option
}
set dont_record_command(ic_select_geometry_option) 1

# --------------------------------------------------------------

## Add segments or triangles to a surface or curve

proc ic_geo_add_segment {type name item pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    set pts2 ""
    foreach p $pts { lappend pts2 [coords_into_global $p] }
    if {$sn != ""} {
        eval $projlib add_${type}_$item $sn $pts2 0
    }
    set sobj [$projlib get_object_by_name $type $name]
    if {$sobj != ""} {
        $sobj signal_change 1
    }
    $projlib configure -modified 1
}

## Delete segments or triangles from a surface or curve

proc ic_geo_delete_segments {type name item pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib delete_${type}_${item}s $sn $pts
    }
}

## Restrict to segments or triangles from a surface or curve

proc ic_geo_restrict_segments {type name item pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib restrict_${type}_${item}s $sn $pts
    }
}

## Split some segments in a surface or curve

proc ic_geo_split_segments {type name item how pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib split_${type}_${item}s $sn $how $pts
    }
}

## Split some edges in a surface

proc ic_geo_split_edges {type name pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib split_${type}_edges $sn $pts
     }
}

## Split one edge in a surface

proc ic_geo_split_one_edge {type name ed} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        return [eval $projlib split_one_surface_edge $sn $ed]
    } else {
        return ""
    }
}

## Swap some edges in a surface

proc ic_geo_swap_edges {type name pts} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib swap_${type}_edges $sn $pts
    }
}

## Move some segments from one surface to another

proc ic_geo_move_segments {type name1 name2 item pts} {
    global projlib
    set sn1 [$projlib get_number_by_name $type $name1]
    set sn2 [$projlib get_number_by_name $type $name2]
    if {$sn1 != "" && $sn2 != ""} {
        eval $projlib move_${type}_${item}s $sn1 $sn2 $pts
    }
}

## Move a node in a surface or curve.  nodes is a list of the node numbers.
## After this can be either one or more positions.  If it's one then
## all nodes are moved to that position.  If it's more then they are moved
## to their corresponding positions.

proc ic_geo_move_node {type name nodes args} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    set pos1 [lindex $args 0]
    foreach n $nodes p $args {
	    if {$p == ""} { set p $pos1 }
	    if {$sn != ""} {
            $projlib move_${type}_node $sn $n [coords_into_local $p]
        }
    }
}

## Merge nodes in a surface or curve

proc ic_geo_merge_nodes {type name nodes} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        eval $projlib merge_${type}_nodes $sn $nodes
    }
}

## Merge nodes in a surface or curve by tolerance

proc ic_geo_merge_nodes_tol {type name tol} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        $projlib merge_${type}_nodes_tol $sn $tol
    }
}


## Merge multiple surfaces

proc ic_geo_merge_surfaces {to from} {
    global projlib
    set sn1 [$projlib get_number_by_name surface $to]
    if {$sn1 != ""} {
        eval $projlib merge_surfaces $sn1 $from
    }
}

## Merge multiple curves, or surfaces

proc ic_geo_merge_objects {type dest objs} {
    global projlib
    set sn1 [$projlib get_number_by_name $type $dest]
    foreach obj $objs {
        set sn2 [$projlib get_number_by_name $type $obj]
        if {$sn1 != "" && $sn2 != ""} {
            $projlib merge_${type} $sn1 $sn2
        }
    }
}

## Merge multiple points using a tolerance

proc ic_geo_merge_points_tol {pts tol} {
    global projlib
    
    if {[llength $pts] > 2} {
        set nums ""
        set objs ""
        foreach p $pts {
            set obj [$projlib get_object_by_name point $p]
	        lappend objs $obj
	    }
	    set delpts [$projlib merge_points $nums $tol]
	    mess "[llength $delpts] points deleted\n"
	    set names ""
	    foreach p $delpts { 
	        set obj [$projlib get_object point $p]		 
	        set got($obj) 1
	        lappend names [$obj get -name]
	    }
	    ic_delete_geometry point names $names
	    foreach p $objs {
	        if ![info exists got($p)] { $p signal_change 1 } 
	    }
    } else {
	    set obj1 [$projlib get_object_by_name point [lindex $pts 0]]
	    set obj2 [$projlib get_object_by_name point [lindex $pts 1]]
	    eval $projlib merge_pre_points $pts
	    delete_geom_object $obj2
	    $obj1 signal_change 1
    }
}

## Clean up a surface or curve after editing operations

proc ic_geo_finish_edit {type name} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        $projlib finish_${type}_edit $sn
    }
}

## Delete a surface or curve if it is empty

proc ic_geo_delete_if_empty {type name} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        $projlib finish_${type}_edit $sn
        geo_delete_if_empty [$projlib get_object_by_name $type $name]
    }
}

## What is the smallest triangle in a surface

proc ic_geo_smallest_segment {type name} {
    global projlib
    set sn [$projlib get_number_by_name $type $name]
    if {$sn != ""} {
        return [$projlib smallest_${type}_triangle $sn]
    } else {
        return ""
    }
}
set dont_record_command(ic_geo_smallest_segment) 1

## This is kind of an escape.

proc ic_geo_get_config_param {type name param} {
    global projlib
    set obj [$projlib get_object_by_name $type $name]
    return [$obj cget -$param]
}
set dont_record_command(ic_geo_get_config_param) 1

## This is kind of an escape.

proc ic_geo_set_config_param {type name param val} {
    global projlib
    set obj [$projlib get_object_by_name $type $name]
    $obj configure -$param $val
}
set dont_record_command(ic_geo_set_config_param) 1

## Set the given tag on the objects, or remove it.  If the <b>tagname</b> is <i>pickable</i>
## this affects the geometry selection code.  If the <b>type</b> is clear then the
## tag is removed from all objects and the <b>name</b> and <b>on</b> params are ignored.
## If <b>name</b> is an empty string then all the objects of that type will be modified.

proc ic_geo_set_tag {type names tagname on} {
    global projlib
    global tdv_default

    if {$type == "clear"} {
	$tdv_default remove_tag_from_all $tagname
		return
    }
	foreach name $names {
	set im [$projlib get_object_by_name $type $name]
		if {$im == ""} continue
	    if $on {
		$tdv_default add_tag $im $tagname
	    } else {
		$tdv_default remove_tag $im $tagname
	    }
	}
    }
set dont_record_command(ic_geo_set_tag) 1

## Highlight some segments of an image.

proc ic_geo_highlight_segments {type name add hsmode segs} {
    global projlib

    set im [$projlib get_object_by_name $type $name]
    if {$im == ""} return
    switch $add {
	    add {
	        return [eval $im add_highlight_segments $hsmode $segs]
	    }
	    remove {
	        return [eval $im remove_highlight_segments $hsmode $segs]
	    }
	    get {
	        return [$im get_highlight_segments $hsmode]
	    }
	    count {
	        return [$im count_highlight_segments $hsmode]
	    }
	    attached {
	        return [$im get_highlight_segments_attached $hsmode $segs]
	    }
	    between {
	        return [$im get_highlight_segments_between_nodes $hsmode $segs]
	    }
    }
}
set dont_record_command(ic_geo_highlight_segments) 1

## What is the bounding box of a set of objects.  objlist is a list of
## type names pairs, e.g. <i> { { curve {C1 C2 C2} point {C2 C3}} }</i>
## Alternately it can the word <b>all</b> which will give the bounding box of
## all the geometry.

# You can use internal numbers instead of names but that's not useful at the
# scripting level.

proc ic_geo_bounding_box {objlist} {
    global projlib

    if {[lindex $objlist 0] == "all"} {
        return [$projlib get_bbox]
    } else {
        set ims ""
        foreach {type names} $objlist {
            foreach name $names {
                if [scan $name %d num] {
                    lappend ims [$projlib get_object $type $num]
                } else {
                    lappend ims [$projlib get_object_by_name $type $name]
                }
            }
        }
        return [bbox_of_images $ims]
    }
}
set dont_record_command(ic_geo_bounding_box) 1

## This is the more rigorous version of the boundary box calculation.

proc ic_geo_bounding_box2 {objlist} {
    global projlib

    set o ""
    foreach {type name} $objlist {
        lappend o [$projlib get_object_by_name $type $name]
    }
    return [bbox_of_images2 $o]
}
set dont_record_command(ic_geo_bounding_box2) 1

## This gives bbox of all objects in projlib
proc ic_geo_model_bounding_box {} {
    global projlib
    
    if [catch {$projlib get_model_bbox} bbox] {
        return ""
    } else {
        return $bbox
    }
}
set dont_record_command(ic_geo_model_bounding_box) 1


## What is the feature size of an object.

proc ic_geo_feature_size {type name} {
    global projlib
    set obj [$projlib get_object_by_name $type $name]
    return [$obj get_feature_size]
}
set dont_record_command(ic_geo_feature_size) 1

## Replace a surface mesh.  Points is a list of x y z triples.  Tris is a 
## list of 3 point numbers.  E.g.<br>
## ic_geo_replace_surface_mesh SURF.1 {{0 0 0} {1 1 1} ...} {{0 1 2} ...}

proc ic_geo_replace_surface_mesh {name pts tris} {
    global projlib
    
    set num [$projlib get_number surface $name]
    $projlib replace_surface_mesh_string $num $pts $tris
}

## Replace a curve mesh.  Points is a list of x y z triples.  Bars is a
## list of 2 point numbers.  E.g.<br>
## ic_geo_replace_curve_mesh CRV.1 {{0 0 0} {1 1 1} ...} {{0 1} {2 3} ...}

proc ic_geo_replace_curve_mesh {name pts bars} {
    global projlib

    set num [$projlib get_number curve $name]
    $projlib replace_curve_mesh_string $num $pts $bars
}

## Compute the displacement vector between two points
## <table border>
## <tr><td><b>p1  </b></td><td> point -- e.g. {1 2 3}               </td></tr>
## <tr><td><b>p2  </b></td><td> point -- e.g. {3 4 3}               </td></tr>
## <tr><td><b>return  </b></td><td> 3-tuple containing difference   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Compute the displacement vector between two points
##   #
##      if [catch {ic_geo_vec_diff {1 2 3} {3 4 3} } crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec diff, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_diff { p1 p2 } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $p1] == 1} {
       	if [catch {ic_geo_get_point_location $p1} res]  {
	    return -code error "Error parsing p1 data: $p1"
       	} else {
            set p1 $res
       	}
    }
    if {[llength $p2] == 1} {
       	if [catch {ic_geo_get_point_location $p2} res]  {
	    return -code error "Error parsing p2 data: $p2"
       	} else {
            set p2 $res
       	}
    }

    if [catch {gk_vec_diff $p1 $p2} res] {
        mess "$res\n" red
        return -code error $res
    }
    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}
set dont_record_command(ic_geo_vec_diff) 1

## Compute the dot product between two vectors
## <table border>
## <tr><td><b>v1  </b></td><td> vector -- e.g. {1 2 3}              </td></tr>
## <tr><td><b>v2  </b></td><td> vector -- e.g. {3 4 3}              </td></tr>
## <tr><td><b>return  </b></td><td> dot product   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Compute the dot product between two vectors
##   #
##      if [catch {ic_geo_vec_dot {1 2 3} {3 4 3} } crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec dot, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_dot { v1 v2 } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $v1] == 1} {
       	if [catch {ic_geo_get_point_location $v1} res]  {
	    return -code error "Error parsing v1 data: $v1"
       	} else {
            set v1 $res
       	}
    }
    if {[llength $v2] == 1} {
       	if [catch {ic_geo_get_point_location $v2} res]  {
	    return -code error "Error parsing v2 data: $v2"
       	} else {
            set v2 $res
       	}
    }
    if [catch {gk_vec_dot $v1 $v2} res] {
        mess "$res\n" red
        return -code error $res
    }
    return $res
}
set dont_record_command(ic_geo_vec_dot) 1

## Compute the cross product between two vectors
## <table border>
## <tr><td><b>v1  </b></td><td> vector -- e.g. {1 2 3}              </td></tr>
## <tr><td><b>v2  </b></td><td> vector -- e.g. {3 4 3}              </td></tr>
## <tr><td><b>return  </b></td><td> cross product   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Compute the cross product between two vectors
##   #
##      if [catch {ic_geo_vec_mult {2 0 1} {1 3 0} } crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec mult, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_mult { v1 v2 } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $v1] == 1} {
       	if [catch {ic_geo_get_point_location $v1} res]  {
	    return -code error "Error parsing v1 data: $v1"
       	} else {
            set v1 $res
       	}
    }
    if {[llength $v2] == 1} {
       	if [catch {ic_geo_get_point_location $v2} res]  {
	    return -code error "Error parsing v2 data: $v2"
       	} else {
            set v2 $res
       	}
    }
    if [catch {gk_vec_mult $v1 $v2} res] {
        mess "$res\n" red
        return -code error $res
    }
    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}
set dont_record_command(ic_geo_vec_mult) 1

## Normalize a vector
## <table border>
## <tr><td><b>vec  </b></td><td> vector -- e.g. {1 2 3}             </td></tr>
## <tr><td><b>return  </b></td><td> normalized vector   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Normalize a vector
##   #
##      if [catch {ic_geo_vec_nrm {2 2 4} } crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec normalize, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_nrm { vec } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $vec] == 1} {
       	if [catch {ic_geo_get_point_location $vec} res]  {
	    return -code error "Error parsing vec data: $vec"
       	} else {
            set vec $res
       	}
    }
    if [catch {gk_vec_nrm $vec} res] {
        mess "$res\n" red
        return -code error $res
    }
    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}
set dont_record_command(ic_geo_vec_nrm) 1

## Compute the length of a vector
## <table border>
## <tr><td><b>vec  </b></td><td> vector -- e.g. {1 2 3}             </td></tr>
## <tr><td><b>return  </b></td><td> length   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##      if [catch {ic_geo_vec_len {3 4 0} } len] {
##           mess "$len\n" red
##      } else {
##           mess "vec length should be 5: $len\n"
##      }
## </pre>
proc ic_geo_vec_len { vec } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $vec] == 1} {
       	if [catch {ic_geo_get_point_location $vec} res]  {
	    return -code error "Error parsing vec data: $vec"
       	} else {
            set vec $res
       	}
    }
    if [catch {gk_vec_len $vec} res] {
        mess "$res\n" red
        return -code error $res
    }
    return $res
}
set dont_record_command(ic_geo_vec_len) 1

## Compute the distance between two points
## <table border>
## <tr><td><b>pnt1  </b></td><td> point -- e.g. {1 2 3} or point name</td></tr>
## <tr><td><b>pnt2  </b></td><td> point -- e.g. {1 2 3} or point name</td></tr>
## <tr><td><b>return  </b></td><td> distance between points   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   #
##      if [catch {ic_geo_pnt_dist {2 2 4} {3 2 1}} len] {
##           mess "Error: $len\n" red
##      } else {
##           mess "Distance = $len\n"
##      }
## </pre>
proc ic_geo_pnt_dist {pnt1 pnt2} {
    set len 0
    if [catch {ic_geo_vec_diff $pnt1 $pnt2} dvec] {
	 return -code error "$dvec"
    } else {
	if [catch {ic_geo_vec_len $dvec} len] {
	    return -code error "$len"
	}
    }
    return $len
}
set dont_record_command(ic_geo_pnt_dist) 1

proc ic_geo_get_nearest_existing_point {loc {part ""}} {
    
    if {$part != ""} {
        set points [ic_geo_get_objects point $part]
    } else {
        set points [ic_geo_get_objects point]
    }
    set point ""
    foreach p $points {
	    set pdist [ic_geo_pnt_dist $loc [ic_geo_get_point_location $p]]
	    if ![info exists dist] {
	        set dist $pdist
	        set point $p
	    } else {
	        if {$pdist < $dist} {
	            set dist $pdist
	            set point $p
	        }
	    }
    }
    return $point
}
set dont_record_command(ic_geo_get_nearest_existing_point) 1

## Multiply a vector by a scalar
## <table border>
## <tr><td><b>vec  </b></td><td> vector -- e.g. {1 2 3}             </td></tr>
## <tr><td><b>scal  </b></td><td> scalar -- e.g. 42         </td></tr>
## <tr><td><b>return  </b></td><td> scalar product vector    </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Multiply a vector by a scalar
##   #
##      if [catch {ic_geo_vec_smult {1 2 3} 42 } crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec smult, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_smult {vec  scal} {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $vec] == 1} {
       	if [catch {ic_geo_get_point_location $vec} res]  {
	    return -code error "Error parsing vec data: $vec"
       	} else {
            set vec $res
       	}
    }
    if [catch {gk_vec_smult $vec $scal} res] {
        mess "$res\n" red
        return -code error $res
    }
    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}

## Compute the sum of two vectors
## <table border>
## <tr><td><b>v1  </b></td><td> vector -- e.g. {1 2 3}              </td></tr>
## <tr><td><b>v2  </b></td><td> vector -- e.g. {3 4 3}              </td></tr>
## <tr><td><b>return  </b></td><td> cross product   </td></tr>
## </table>
## <b>Example</b>
## <pre>
##   # Compute the sum of two vectors
##   #
##      if [catch {ic_geo_vec_sum {1 2 3} {4 5 6}} crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "vec sum, $crv1\n"
##      }
## </pre>
proc ic_geo_vec_sum { v1 v2 } {
#
#   Check to see any of the tuples were passed as a point name
    if {[llength $v1] == 1} {
       	if [catch {ic_geo_get_point_location $v1} res]  {
	    return -code error "Error parsing v1 data: $v1"
       	} else {
            set v1 $res
       	}
    }
    if {[llength $v2] == 1} {
       	if [catch {ic_geo_get_point_location $v2} res]  {
	    return -code error "Error parsing v2 data: $v2"
       	} else {
            set v2 $res
       	}
    }
    if [catch {gk_vec_sum $v1 $v2} res] {
        mess "$res\n" red
        return -code error $res
    }
    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}

## Compute the arc length of a curve segment
## <table border>
## <tr><td><b>crvs    </b></td><td> list of one or more curves   </td></tr>
## <tr><td><b>t_min   </b></td><td> Lower limit of segment <i>(unitized</i></td></tr>
## <tr><td><b>t_max   </b></td><td> Upper limit of segment <i>(unitized</i></td></tr>
## <tr><td><b>return  </b></td><td> list of computed arc lengths </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> tMin and tMax default to 0 and 1 respectively
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_crv_length.tcl">ic_geo_crv_length.tcl</a>.
## </ul>
proc ic_geo_crv_length { crvs {t_min 0} {t_max 1}} {
#
#   Last Modified ---
#   12/17/01 -- AWM
#	     -- Added support for curve segments per request
#		from Yuriy
#   12/07/01 --	AWM
#	     -- Supports multiple curves; added reference to
#	        unit test program
#
    global projlib
#
#   This code can handle multiple selections
    set lens ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} res] {
 	    return -code error $res
	} else {
	    switch [$projlib get_object_type curve $res] {
		parametric {
		    if [catch {gk_crv_length $res $t_min $t_max} len] {
			return -code error $len
		    }
		}
		mesh {
		    set len [$projlib get_curve_bars_length $res]
		}
	    }
	    lappend lens $len
	}   
    }
    return $lens
}
set dont_record_command(ic_geo_crv_length) 1

## Create a rev surface from a generator curve and axis
## <table border>
## <tr><td><b>family  </b></td><td> family containing surface   </td></tr>
## <tr><td><b>name    </b></td><td> name of created surface     </td></tr>
## <tr><td><b>gen     </b></td><td> generator curve(s)          </td></tr>
## <tr><td><b>base    </b></td><td> axis base point             </td></tr>
## <tr><td><b>zaxis   </b></td><td> axis direction vector       </td></tr>
## <tr><td><b>srtang  </b></td><td> start angle (degrees)	</td></tr>
## <tr><td><b>endang  </b></td><td> end angle  (degrees)	</td></tr>
## <tr><td><b>dxn     </b></td><td> c-clockwise, a-anticlockwise</td></tr>
## <tr><td><b>bld_topo</b></td><td> associate edge curves       </td></tr>
## <tr><td><b>return  </b></td><td> name of created surface     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> The dxn flag determines whether the curve is swept clockwise
##      or anticlockwise (counter clockwise) about the rev axis.  
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_rev.tcl">ic_geo_cre_srf_rev.tcl</a>.
## </ul>
proc ic_geo_cre_srf_rev { family name gen base zaxis srtang endang {dxn a} {bld_topo 0}} {
#
#   Last Modified ---
#   04/25/02 -- AWM
#	     -- Restore support for unstructured curves; tested
#		against regression tests on windows.
#   03/29/02 -- Vlad 
#	        Automatically set srtang <= endang (may crash med if not)
#   03/20/02 -- AWM
#	     -- More intelligent handling of unstructured curves
#   12/07/01 --	AWM 
#	     -- Supports multiple curves; added reference to
#	        unit test program; basepoint can be prescribed point
#	        name.  Fixed bugs in underlying C code.
#
    global projlib
#
    set new_fam [ic_geo_new_family $family]
#
#
#   Check to see if center was passed as a name
    if {[llength $base] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $base} res]  {
	    return -code error "Error parsing base data: $base"
       	} else {
            set base $res
       	}
    }
#
    if {$srtang > $endang} {
	set tmp $endang
	set endang $srtang
	set srtang $tmp
    }
#
    set srfNames ""
    foreach obj $gen {
	if [catch {$projlib get_number_by_name curve $obj} crvNum] {
	    return -code error "Error retrieving curve $obj\n"
	}
        if [catch {ic_geo_cvt_uns_to_bsc $family CVT_CRV $obj} cvtList] {
            return -code error "Error: $cvtList"
	} else {
	#
            foreach crv $cvtList {
                if [catch {$projlib get_number_by_name curve $crv} crvNum] {
                    return -code error "Error retrieving curve $crv\n"
                }
                #
                if [catch {gk_cre_srf_rev $family $name \
                    $crvNum $base $zaxis $srtang $endang $dxn} res] {
                    return -code error "Error creating rev: $res"
                } else {
                    lappend srfNames $res
                }
                if {$crv != $obj} {
                    ic_delete_geometry curve names $crv
                }
            }
	}
    }
    #  build the edge curves
    if {$bld_topo && [llength $srfNames] > 0} {
     	ic_geo_build_topo_on_srfs $srfNames $gen
    }
    foreach srf $srfNames {
	update_surface_display $srf
    }
    display_update geo $new_fam
    return $srfNames
}

## Create isoparametric curve segments on a surface
## <table border>
## <tr><td><b>family  </b></td><td> family containing curves	    </td></tr>
## <tr><td><b>name    </b></td><td> name of created curves	    </td></tr>
## <tr><td><b>srfs    </b></td><td> list of surface names	    </td></tr>
## <tr><td><b>par     </b></td><td> surface parameter 0 <= par <= 1 </td></tr>
## <tr><td><b>sel     </b></td><td> == 0 u cons; == 1 v cons	    </td></tr>
## <tr><td><b>do_split</b></td><td> == 1 split the surface	    </td></tr>
## <tr><td><b>coord   </b></td><td> == 0 use restricted coordinates;<br>
##				    == 1 use natural coordinates    </td></tr>
## <tr><td><b>return  </b></td><td> list of created curves/surfaces </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The defining parameter is assumed to be unitized
## <li> When applied to trimmed surfaces
##      <ul>
##      <li> The feature may produce multiple result curves
##      <Li> Restricted coordinates are taken with respect to the
##	     active region of the trimmed surface, not the domain
##	     of the underlying surface.
##	<li> Natural coordinates are taken with respect to the underlying
##	     surface.  This alternative is consistant with the output of
##	     ic_geo_find_nearest_srf_pnt in that while the coordinates are
##	     still unitized, they run through the full extent of the underlying
##	     surface.
##	</ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The surface parameter is unitized.
## <li> The return value is a list containing two elements
##      <ol>
##      <li> Names of created curves
##      <li> Names of created surfaces
##      </ol> 
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_crv_iso_crv.tcl">ic_geo_cre_crv_iso_crv.tcl</a>.
## </ul>
proc ic_geo_cre_crv_iso_crv { family name srfs par sel {do_split 0} {coord 0}} {
#
#   Last Modified ---
#   09/02/02 -- AWM
#            -- added support for part parameters
#   08/14/02 -- AWM
#            -- modified error handling
#   12/07/01 -- AWM 
#            -- Supports multiple surfaces; added reference to
#               unit test program; fixed regression in underlying
#               C code.
#
    global projlib
    set new_fam [ic_geo_new_family $family]
    
    if {[ic_geo_check_objects_exist point $par] != ""} {
        set pnts [ic_geo_get_points_near surface $srfs]
        set loc [ic_geo_get_point_location $par]
        set uv [ic_geo_find_nearest_srf_pnt $srfs $loc]
        foreach {u v} $uv {
            if {[expr abs($u-0.5)] > [expr abs($v-0.5)]} {
                set dir 1
            } else {
                set dir 0
            }
        }
        set par [lindex $uv $dir]
        set sel $dir
    }
    
#   check to see if variable passed for parameter
    ic_virtual define var _ic_geo_cre_crv_iso_crv_var $par
    set par_status [ic_virtual check var _ic_geo_cre_crv_iso_crv_var 1]
    if $par_status {
        return -code error "Unable to parse parameter, $par\n"
    } else {
        set par [ic_virtual check var _ic_geo_cre_crv_iso_crv_var]
    }
#
    set crv_list ""
    set srf_list ""
    foreach obj $srfs {
        set srfNum [$projlib get_number_by_name surface $obj]
        if [catch {gk_cre_crv_iso_crv $family $name \
            $srfNum $par $sel $do_split $coord} ents_tmp] {
            return -code error "$ents_tmp"
        } else {
            set crv_tmp [lindex $ents_tmp 0]
            set srf_tmp [lindex $ents_tmp 1]
            set crv_list [concat $crv_list $crv_tmp]
            set srf_list [concat $srf_list $srf_tmp]
        }
    }
    if $do_split {
        if {[llength $srf_list] > 0} {
            ic_geo_reduce_face $srf_list
        }
    }
    if {[llength $crv_list] > 0} {
        $projlib configure -modified 1
        set ent_list [list $crv_list $srf_list]
        update_bsp_consistency
        return $ent_list
    } else {
        return -code error "No isocurve segments created"	
    }
}
## Create a bspline plane from 3 points
## <table border>
## <tr><td><b>family</b></td><td> family containing plane    </td></tr>
## <tr><td><b>name  </b></td><td> name of created plane      </td></tr>
## <tr><td><b>p1  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>p2  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>p3  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>scale </b></td><td>scales surface extent  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_pln_3pnts.tcl">ic_geo_cre_srf_pln_3pnts.tcl</a>.
## </ul>
proc ic_geo_cre_srf_pln_3pnts { family name p1 p2 p3 rad} {
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]
#
#   Check to see any of the points were passed as a name
    if {[llength $p1] == 1} {
       	if [catch {ic_geo_get_point_location $p1} res]  {
	    return -code error "Error parsing p1 data: $p1"
       	} else {
            set p1 $res
       	}
    }
#
    if {[llength $p2] == 1} {
       	if [catch {ic_geo_get_point_location $p2} res]  {
	    return -code error "Error parsing p2 data: $p2"
       	} else {
            set p2 $res
       	}
    }
#
    if {[llength $p3] == 1} {
       	if [catch {ic_geo_get_point_location $p3} res]  {
	    return -code error "Error parsing p3 data: $p3"
       	} else {
            set p3 $res
       	}
    }
#
    if [catch {gk_cre_srf_pln_3pnts $family $name $p1 $p2 $p3 $rad} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline plane from a point and normal vector
## <table border>
## <tr><td><b>family</b></td><td> family containing plane    </td></tr>
## <tr><td><b>name  </b></td><td> name of created plane      </td></tr>
## <tr><td><b>pnt  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>nrm  </b></td><td> plane normal, e.g. {1 1 1} </td></tr>
## <tr><td><b>rad </b></td><td>radius of created surface  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> For an annotated example of usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_pln_nrm_pnt.tcl">ic_geo_cre_srf_pln_nrm_pnt.tcl</a>.
## </ul>
proc ic_geo_cre_srf_pln_nrm_pnt { family name pnt nrm rad} {
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]
#
#   Check to see any of the points were passed as a name
    if {[llength $pnt] == 1} {
       	if [catch {ic_geo_get_point_location $pnt} res]  {
	    return -code error "Error parsing pnt data: $pnt"
       	} else {
            set pnt $res
       	}
    }
    
    if [catch {gk_cre_srf_pln_nrm_pnt $family $name $pnt $nrm $rad} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline plane from normal vector at a distance from origin
## <table border>
## <tr><td><b>family</b></td><td> family containing plane    </td></tr>
## <tr><td><b>name  </b></td><td> name of created plane      </td></tr>
## <tr><td><b>nrm   </b></td><td> plane normal, e.g. {1 1 1} </td></tr>
## <tr><td><b>dist  </b></td><td> signed distance between origin and plane </td></tr>
## <tr><td><b>rad   </b></td><td>radius of created surface  </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> This variant replaces plane definition by coefficients from older
##      API's.  The plane equation can be written in terms of the input
##      variables as
##<pre>
##      DOT(nrm, X) = LENGTH(nrm)*dist
##</pre>
## </ul>
## <b>Example</b>
## <pre>
##      if [catch {ic_geo_cre_srf_pln_nrm_dist duck dewey \
##              {1 2 3} {1 0 0} 10 42} pln1] {
##           mess "$pln1\n" red
##      } else {
##           mess "Created a plane, $pln1\n"
##      }
## </pre>
proc ic_geo_cre_srf_pln_nrm_dist { family name nrm dist rad} {
    global projlib
    
    create_empty_tetin_if_needed
    
#
    set new_fam [ic_geo_new_family $family]    

    if [catch {gk_cre_srf_pln_nrm_dist $family $name $nrm $dist $rad} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline arc from 3 points
## <table border>
## <tr><td><b>family</b></td><td> family containing curve    </td></tr>
## <tr><td><b>name  </b></td><td> name of created curve      </td></tr>
## <tr><td><b>p1  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>p2  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>p3  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> For an annotated example of usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_arc_from_pnts.tcl">ic_geo_cre_arc_from_pnts.tcl</a>.
## </ul>
proc ic_geo_cre_arc_from_pnts { family name p1 p2 p3} {
#
#   Last Modified ---
#   12/07/01 --	AWM 
#	     -- Added reference to unit test program; arc points
#		can be prescribed point names.
#
    global projlib

    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]    
#
if { 0 } {
# if these are point names pass them down a level
#   Check to see any of the points were passed as a name
    if {[llength $p1] == 1} {
       	if [catch {ic_geo_get_point_location $p1} res]  {
	    return -code error "Error parsing p1 data: $p1"
       	} else {
            set p1 $res
       	}
    }
#
    if {[llength $p2] == 1} {
       	if [catch {ic_geo_get_point_location $p2} res]  {
	    return -code error "Error parsing p2 data: $p2"
       	} else {
            set p2 $res
       	}
    }
#
    if {[llength $p3] == 1} {
       	if [catch {ic_geo_get_point_location $p3} res]  {
	    return -code error "Error parsing p3 data: $p3"
       	} else {
            set p3 $res
       	}
    }
#
}
    if [catch {gk_cre_crv_arc_3pnts $family $name $p1 $p2 $p3} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline curve from n points
## <table border>
## <tr><td><b>family</b></td><td> family containing curve   </td></tr>
## <tr><td><b>name  </b></td><td> name of created curve	    </td></tr>
## <tr><td><b>pnts  </b></td><td> point data 		    </td></tr>
## <tr><td><b>tol   </b></td><td> approximation tolerance   </td></tr>
## <tr><td><b>deg   </b></td><td> curve degree = 1 (linear) or 3 (cubic)   </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> The approximation tolerance is relative.  It will be scaled
##      by the pointset chordlength to form an absolute tolerance.
##      It has a default value of 0.0001.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_bsp_crv_n_pnts.tcl">ic_geo_cre_bsp_crv_n_pnts.tcl</a>.
## </ul>
proc ic_geo_cre_bsp_crv_n_pnts { family name pnts {tol 0.0001} {deg 3}} {
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]    
#
#   Expand any points passed as entity names
    set  exp_pnts $pnts
    set  indx 0
    set  srt_pnt  ""
    set  end_pnt  ""
    set  end_indx [llength $pnts]
    incr end_indx -1
	# small end_tol cause error for big models 
	set end_tol 999.9
    foreach pnt $pnts {
	if {[llength $pnt] == 1} {
#
#           Hopefully a point entity
            if [catch {ic_geo_get_point_location $pnt} coords]  {
		return -code error "Error parsing point data"
	    } else {
	        set exp_pnts [lreplace $exp_pnts $indx $indx $coords]
		if {$indx ==         0} {set srt_pnt $pnt}
		if {$indx == $end_indx} {set end_pnt $pnt}
	    }
	}
        incr indx
    }
#
    if [catch {gk_cre_bsp_crv_n_pnts $family $name $exp_pnts $tol $deg} res] {
        return -code error $res
    } else {
	if {$srt_pnt != ""} {
	    if [catch {ic_geo_mod_crv_set_end $res $srt_pnt 0 $end_tol} err] {
		mess "Start point: $err\n" red
	    }
	}
	if {$end_pnt != ""} {
	    if [catch {ic_geo_mod_crv_set_end $res $end_pnt 1 $end_tol} err] {
		mess "End point: $err\n" red
	    }
	}
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

## Create a bspline curve from n points <i>with constraints</i>
## <table border>
## <tr><td><b>family	</b></td><td> family containing curve	</td></tr>
## <tr><td><b>name	</b></td><td> name of created curve	</td></tr>
## <tr><td><b>pnts	</b></td><td> point data 		</td></tr>
## <tr><td><b>fixPnts	</b></td><td> fixed points		</td></tr>
## <tr><td><b>tanCons	</b></td><td> specified tangents	</td></tr>
## <tr><td><b>tanIndx	</b></td><td> indices of points in pnts<br>
##				      associated to tangent vectors</td></tr>
## <tr><td><b>tol	</b></td><td> approximation tolerance   </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> Point array is indexed as 0, 1, 2, . . . 
## <li> The approximation tolerance is relative.  It will be scaled
##      by the pointset chordlength to form an absolute tolerance.
##	It has a default value of 0.0001.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_bsp_crv_n_pnts_cons.tcl">ic_geo_cre_bsp_crv_n_pnts_cons.tcl</a>.
## </ul>
proc ic_geo_cre_bsp_crv_n_pnts_cons { family name pnts fixPnts tanCons tanIndx {tol 0.001}} {
    global projlib
    
    create_empty_tetin_if_needed
#
	if {$fixPnts == "all"} {
		set all_fixed 1
		set fixPnts ""
	} else {
		set all_fixed 0
	}
    set new_fam [ic_geo_new_family $family]    
#
#   Expand any points passed as entity names
    set  exp_pnts $pnts
    set  indx 0
    set  srt_pnt  ""
    set  end_pnt  ""
    set  end_indx [llength $pnts]
    incr end_indx -1
    foreach pnt $pnts {
	if {[llength $pnt] == 1} {
#
#           Hopefully a point entity
            if [catch {ic_geo_get_point_location $pnt} coords]  {
		return -code error "Error parsing point data"
	    } else {
	        set exp_pnts [lreplace $exp_pnts $indx $indx $coords]
		if {$indx ==         0} {set srt_pnt $pnt}
		if {$indx == $end_indx} {set end_pnt $pnt}
	    }
	}
		if $all_fixed {lappend fixPnts $indx}
        incr indx
    }
	if $all_fixed {
		set fixPnts [list $fixPnts]
    }
#
    if [catch {gk_cre_bsp_crv_n_pnts_cons $family $name \
	    $exp_pnts $fixPnts $tanCons $tanIndx $tol} res] {
        return -code error $res
    } else {
	if {$srt_pnt != ""} {
	    if [catch {ic_geo_mod_crv_set_end $res $srt_pnt 0} err] {
		mess "Start point: $err\n" red
	    }
	}
	if {$end_pnt != ""} {
	    if [catch {ic_geo_mod_crv_set_end $res $end_pnt 1} err] {
		mess "End point: $err\n" red
	    }
	}
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

## Create a bspline arc from center, radius information
## <table border>
## <tr><td><b>family  </b></td><td> family containing curve         </td></tr>
## <tr><td><b>name    </b></td><td> name of created curve           </td></tr>
## <tr><td><b>center  </b></td><td> arc center                      </td></tr>
## <tr><td><b>x_ax    </b></td><td> vector aligned along angle == 0 </td></tr>
## <tr><td><b>normal  </b></td><td> arc normal                      </td></tr>
## <tr><td><b>radius  </b></td><td> arc radius                      </td></tr>
## <tr><td><b>srtang  </b></td><td> start angle (degrees)           </td></tr>
## <tr><td><b>endang  </b></td><td> end angle (degrees)             </td></tr>
## <tr><td><b>return  </b></td><td> name of created curve           </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> If endang < srtang or (endang - srtang) > 360, the angle will
##      be adjusted by adding 360 increments.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> For annotated examples of usage see
##      <ul>
##      <li> <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_crv_arc_ctr_rad.tcl">ic_geo_cre_crv_arc_ctr_rad.tcl</a>
##      <li>  <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_create_surface_from_curves.tcl">ic_geo_create_surface_from_curves.tcl</a>
##      </ul>
## </ul>
## </ul>
proc ic_geo_cre_crv_arc_ctr_rad { family name center x_ax normal \
        radius srtang endang } {
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]
#
#   Check to see if center was passed as a name
    if {[llength $center] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $center} res]  {
	    return -code error "Error parsing center data: $center"
       	} else {
            set center $res
       	}
    }
# med crashes if $srtang >= $endang
# temporary here next loop:
	while {$srtang >= $endang} {
		set endang [expr $endang+360.0]
	}    
    if [catch {gk_cre_crv_arc_ctr_rad $family $name $center $x_ax \
            $normal $radius $srtang $endang } res] {
        return -code error $res
    } else {
	$projlib configure -modified 1
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline cylinder from center, radius information
## <table border>
## <tr><td><b>family  </b></td><td> family containing surface       </td></tr>
## <tr><td><b>name    </b></td><td> name of created surface         </td></tr>
## <tr><td><b>base    </b></td><td> cylinder base point             </td></tr>
## <tr><td><b>x_ax    </b></td><td> vector aligned along angle == 0 </td></tr>
## <tr><td><b>z_ax    </b></td><td> vector aligned along cyl axis   </td></tr>
## <tr><td><b>radius  </b></td><td> cylinder radius                 </td></tr>
## <tr><td><b>srtang  </b></td><td> start angle (degrees)           </td></tr>
## <tr><td><b>endang  </b></td><td> end angle (degrees)             </td></tr>
## <tr><td><b>length  </b></td><td> length                          </td></tr>
## <tr><td><b>return  </b></td><td> name of created surface         </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> If endang < srtang or (endang - srtang) > 360, the angle will
##      be adjusted by adding 360 degree increments.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_cyl.tcl">ic_geo_cre_srf_cyl.tcl</a>.
## </ul>
proc ic_geo_cre_srf_cyl { family name center x_ax z_ax \
        radius srtang endang length } {
#
#   Last Modified ---
#   12/07/01 --	AWM 
#	     -- Added reference to unit test program; base point
#		can be prescribed point name.
# 
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]
#
#   Check to see if center was passed as a name
    if {[llength $center] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $center} res]  {
	    return -code error "Error parsing center data: $center"
       	} else {
            set center $res
       	}
    }
    if [catch {gk_cre_srf_cyl $family $name $center $x_ax \
            $z_ax $radius $srtang $endang $length } res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a bspline line from 2 points
## <table border>
## <tr><td><b>family</b></td><td> family containing curve    </td></tr>
## <tr><td><b>name  </b></td><td> name of created curve      </td></tr>
## <tr><td><b>p1  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>p2  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>return</b></td><td> name of created curve </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> For an annotated example of usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_line.tcl">ic_geo_cre_line.tcl</a>.
## </ul>
proc ic_geo_cre_line { family name p1 p2} {
#
#   Last Modified ---
#   12/07/01 --	AWM 
#	     -- Added reference to unit test program; endpoints
#		can be prescribed point names.
#
    global projlib
    
    create_empty_tetin_if_needed
#
    set new_fam [ic_geo_new_family $family]
    
    if [catch {gk_cre_crv_line $family $name $p1 $p2} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}

## Create a prescribed point from coordinates
## <table border>
## <tr><td><b>family</b></td><td> family containing point    </td></tr>
## <tr><td><b>name  </b></td><td> name of created point      </td></tr>
## <tr><td><b>pnt  </b></td><td> point data, e.g. {1 2 3} </td></tr>
## <tr><td><b>in_lcs</b></td><td> 1 if the location should be in the
## current local coordinate system (default) </td></tr>
## <tr><td><b>return</b></td><td> name of created point </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The specified point name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
## <b>Example</b>
## <pre>
##    # Create a prescribed point from coordinates
##
##      if [catch {ic_geo_cre_pnt duck louie {1 2 3} } pnt1] {
##           mess "$pnt1\n" red
##      } else {
##           mess "Created a ducky point, $pnt1\n"
##      }
## </pre>
proc ic_geo_cre_pnt {family name pnt {in_lcs 1}} {
    global projlib
    
    create_empty_tetin_if_needed
#
    if $in_lcs { set pnt [coords_into_global $pnt] }
    
    set new_fam [ic_geo_new_family $family]
    
    if [catch {gk_cre_pnt $family $name $pnt} res] {
	return -code error $res
    } else {
	set nb [$projlib get_number point $res]
	set nb [define_geom_object point $nb]
	update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
	return $res
    }
}
## Create a material point from coordinates
## <table border>
## <tr><td><b>family</b></td><td> family containing material point </td></tr>
## <tr><td><b>name  </b></td><td> name of created material point </td></tr>
## <tr><td><b>pnt  </b></td><td> point data, e.g. {1 2 3}, or the word
## <b>outside</b></td></tr>
## <tr><td><b>in_lcs</b></td><td> 1 if the location should be in the
## current local coordinate system (default) </td></tr>
## <tr><td><b>return</b></td><td> name of created material point </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The specified point name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
## <b>Example</b>
## <pre>
##    # Create a material point from coordinates
##
##      if [catch {ic_geo_cre_mat duck louie {1 2 3} } pnt1] {
##           mess "$pnt1\n" red
##      } else {
##           mess "created a ducky point, $pnt1\n"
##      }
## </pre>
proc ic_geo_cre_mat {fam name pt {in_lcs 1}} {
    global projlib

    create_empty_tetin_if_needed
    if { $name == "" } {
	set name [ic_geo_new_name material $fam.]
    }

    if {$pt == "outside"} {
	set bb [ic_geo_bounding_box all]
	set min [lindex $bb 0]
	set max [lindex $bb 1]
	set pt ""
	foreach i {0 1 2} {
	    lappend pt [expr 2 * [lindex $min $i] -  [lindex $max $i]]
	}
    } elseif $in_lcs {
	set pt [coords_into_global $pt]
    }

    ic_uns_new_family $fam
    ic_geo_new_family $fam

    set new [$projlib create_material $name $fam $pt]

    set bsp [define_geom_object material $new]
    update_geom_visible_obj $bsp
    return [$bsp get -name]
}

## Get the normal vector of a surface at a parameter
## <table border>
## <tr><td><b>upar  </b></td><td> surface u parameter		</td></tr>
## <tr><td><b>vpar  </b></td><td> svrface v parameter		</td></tr>
## <tr><td><b>srf   </b></td><td> list of surfaces to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The return string will be a list of 3-tuples
## <li> The input uv coordinates should be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_get_srf_nrm.tcl">ic_geo_get_srf_nrm.tcl</a>.
## </ul>
proc ic_geo_get_srf_nrm { upar vpar srf } {
    global projlib
#
    set nums ""
    foreach obj $srf {lappend nums [$projlib get_number_by_name surface $obj] }
    if [catch {gk_get_srf_nrm $upar $vpar $nums} res] {
        return -code error $res
    }
    return $res
}
set dont_record_command(ic_geo_get_srf_nrm) 1

## Get a surface position at a parameter
## <table border>
## <tr><td><b>upar  </b></td><td> surface u parameter		</td></tr>
## <tr><td><b>vpar  </b></td><td> svrface v parameter		</td></tr>
## <tr><td><b>srf   </b></td><td> list of surfaces to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The return string will be a list of 3-tuples
## <li> The input uv coordinates should be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_get_srf_pos.tcl">ic_geo_get_srf_pos.tcl</a>.
## </ul>
proc ic_geo_get_srf_pos { upar vpar srf } {
    global projlib
#
    ic_undo_suspend
    set nums ""
    foreach obj $srf {lappend nums [$projlib get_number_by_name surface $obj] }
    if [catch {gk_get_srf_pos $upar $vpar $nums} res] {
	ic_undo_resume 
        return -code error $res
    }
    ic_undo_resume
    return $res
}
set dont_record_command(ic_geo_get_srf_pos) 1

## Create a prescribed point on a surface at a parameter
## <table border>
## <tr><td><b>family</b></td><td> family containing point    </td></tr>
## <tr><td><b>name  </b></td><td> name of created point      </td></tr>
## <tr><td><b>upar  </b></td><td> surface u parameter        </td></tr>
## <tr><td><b>vpar  </b></td><td> svrface v parameter        </td></tr>
## <tr><td><b>srf   </b></td><td> list of surfaces to evaluate</td></tr>
## <tr><td><b>return</b></td><td> Names of created points      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified point name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The input uv coordinates should be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_pnt_on_srf_at_par.tcl">ic_geo_cre_pnt_on_srf_at_par.tcl</a>.
## </ul>
proc ic_geo_cre_pnt_on_srf_at_par { family name upar vpar srf } {
    global projlib
#
    set new_fam [ic_geo_new_family $family]    
    
    set nums ""
    foreach obj $srf {lappend nums [$projlib get_number_by_name surface $obj] }
    if [catch {gk_cre_pnt_on_srf_at_par $family $name $upar $vpar $nums} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number point $res]
        set nb [define_geom_object point $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

## Create a prescribed point on a curve at a parameter
## <table border>
## <tr><td><b>family</b></td><td> family containing point    </td></tr>
## <tr><td><b>name  </b></td><td> name of created point      </td></tr>
## <tr><td><b>par   </b></td><td> curve parameter            </td></tr>
## <tr><td><b>crv   </b></td><td> name of curve to evaluate  </td></tr>
## <tr><td><b>return</b></td><td> Name of created point      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified point name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Example usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_pnt_on_crv_at_par.tcl">ic_geo_cre_pnt_on_crv_at_par.tcl</a>.
## </ul>
proc ic_geo_cre_pnt_on_crv_at_par { family name par crv } {
    global projlib
#
    set new_fam [ic_geo_new_family $family]
    
    set nums ""
    foreach obj $crv {lappend nums [$projlib get_number_by_name curve $obj] }
    if [catch {gk_cre_pnt_on_crv_at_par $family $name $par $nums} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number point $res]
        set nb [define_geom_object point $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

## Create a new curve by concatinating existing curves
## <table border>
## <tr><td><b>family</b></td><td> family containing curve    </td></tr>
## <tr><td><b>name  </b></td><td> name of created curve      </td></tr>
## <tr><td><b>tol   </b></td><td> merge tolerance            </td></tr>
## <tr><td><b>crvs  </b></td><td> list of curves to be joined</td></tr>
## <tr><td><b>return</b></td><td> Name of created curve      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_crv_concat.tcl">ic_geo_cre_crv_concat.tcl</a>.
## </ul>
proc ic_geo_cre_crv_concat { family name tol crvs } {
    global projlib
#
#   History---
#   06/14/02 -- AWM -- Check for wrong number of curves passed
#   01/16/02 -- AWM
#	     -- Renamed to be consistant with Geometry Kernel nomencature;
#		updated and checked regression test.
    if {[llength $crvs] <= 1} {
	return -code error "Must select two or more curves"
    }
    set nums ""
    set del_list ""
    foreach obj $crvs {
	if [catch {ic_geo_cvt_uns_to_bsc $family CVT_CRV $obj} cvtList] {
	    return -code error "Error: $cvtList" 
	} else {
	    foreach bsc $cvtList {
		if [catch {$projlib get_number_by_name curve $bsc} res] {
		    return -code error "$res, $obj"
		} else {
		    lappend nums $res
		}
		if {$bsc != $obj} {
		    lappend del_list $bsc
		}
	    }
	}
    }

    if { $family != "" } {
    	set new_fam [ic_geo_new_family $family]    
    } else {
	set crv_num [ lindex $nums 0 ]
	set new_fam [ $projlib get_family curve $crv_num ]
    }

    if { $tol == "" } {
	set tol "0.0"
    }
    if [catch {gk_cre_crv_concat $family $name $tol $nums} res] {
        return -code error $res
    } else {
	#
	#   delete construction geometry
	foreach obj $del_list {
	    ic_delete_geometry curve names $obj
	}
	#
	#   define entity in display
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

##  Deprecated version of ic_geo_cre_crv_concat
##
##  This function has been deprecated and has been replaced by
##  <a href="#ic_geo_cre_crv_concat">ic_geo_cre_crv_concat</a>.
##
proc ic_geo_create_curve_concat { family name tol crvs } {
    global projlib
    if [catch {ic_geo_cre_crv_concat $family $name $tol $crvs} res] {
	return -code error $res
    }
    $projlib configure -modified 1
    return $res
}

## Create a new surface spanning a planar contour
## <table border>
## <tr><td><b>family</b></td><td> family containing new surface    </td></tr>
## <tr><td><b>name  </b></td><td> base name of created surface      </td></tr>
## <tr><td><b>tol   </b></td><td> merge tolerance            </td></tr>
## <tr><td><b>crvs  </b></td><td> list of curves to span     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> For annotated examples of usage see
##     <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_from_contour.tcl">ic_geo_cre_srf_from_contour.tcl</a>.
## </ul>
proc ic_geo_cre_srf_from_contour {family name tol crvs} {
    global projlib
#
#   08/10/02 -- AWM
#	     -- Created
#
    set new_fam [ic_geo_new_family $family]
    
    set nums ""
    set del_list ""
    foreach obj $crvs {
	if [catch {ic_geo_cvt_uns_to_bsc $family CVT_CRV $obj} cvtList] {
	    return -code error "Error: $cvtList" 
	} else {
	    foreach bsc $cvtList {
		if [catch {$projlib get_number_by_name curve $bsc} res] {
		    return -code error "$res, $obj"
		} else {
		    lappend nums $res
		}
		if {$bsc != $obj} {
		    lappend del_list $bsc
		}
	    }
	}
    }
    if [catch {gk_cre_srf_from_contour $family $name $tol $nums} res] {
	#
	#   delete construction geometry
	foreach obj $del_list {
	    ic_delete_geometry curve names $obj
	}
        return -code error $res
    } else {
	ic_geo_delete_family TEMP_TSF_FAM
	#
	#   define entity in display
	foreach obj $res {
	    set nb [$projlib get_number surface $obj]
	    set nb [define_geom_object surface $nb]
	    update_geom_visible_obj $nb
	    display_update geo $new_fam
	}
        return $res
    }
}


## Create a new surface spanning two to four curves.
## <table border>
## <tr><td><b>family  </b></td><td> family containing new surface</td></tr>
## <tr><td><b>name    </b></td><td> name of created surface      </td></tr>
## <tr><td><b>tol     </b></td><td> merge tolerance              </td></tr>
## <tr><td><b>crvs    </b></td><td> list of curves to span       </td></tr>
## <tr><td><b>bld_topo</b></td><td> associate edge curves        </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> For annotated examples of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_create_surface_from_curves.tcl">ic_geo_create_surface_from_curves.tcl</a>.
## </ul>
proc ic_geo_create_surface_from_curves {family name tol crvs {bld_topo 0}} {
    global projlib
#
#   04/25/02 -- AWM
#	     -- Added code to handle unstructured curves
#   06/23/06 -- VG 
#        -- Added code to check for new crvs if bld_topo==1 and create objects  
#
     set new_fam [ic_geo_new_family $family]
    set nums ""
    set sel_nums ""
    set del_list ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend sel_nums $res
	}
	if [catch {ic_geo_cvt_uns_to_bsc $family CVT_CRV $obj} cvtList] {
	    return -code error "Error: $cvtList" 
	} else {
	    foreach bsc $cvtList {
		if [catch {$projlib get_number_by_name curve $bsc} res] {
		    return -code error "$res, $obj"
		} else {
		    lappend nums $res
		}
		if {$bsc != $obj} {
		    lappend del_list $bsc
		}
	    }
	}
    }
    if [catch {gk_cre_srf_from_crvs $family $name $tol $nums $sel_nums $bld_topo} res] {
        return -code error "$res, $name"
    } else {
	    #
	    # define entity in display
	    foreach obj $res {
            update_surface_display $obj
	        display_update geo $new_fam
	    }
	    if $bld_topo {
		    update_bsp_consistency
	    }
        return $res
    }
}

## Create a new surface from a u,v set of coordinates
## <table border>
## <tr><td><b>family</b></td><td> family containing new surface    </td></tr>
## <tr><td><b>name  </b></td><td> name of created surface      </td></tr>
## <tr><td><b>nu    </b></td><td> number of u coordinates    </td></tr>
## <tr><td><b>nv    </b></td><td> number of v coordinates    </td></tr>
## <tr><td><b>ord_u </b></td><td> order of u </td></tr>
## <tr><td><b>ord_v </b></td><td> order of v </td></tr>
## <tr><td><b>rational</b></td><td> dimension of polynomial fit above 3</td></tr>
## <tr><td><b>u_knots</b></td><td> for rational=0, list of u coordinates</td></tr>
## <tr><td><b>v_knots</b></td><td> for rational=0, list of v coordinates</td></tr>
## <tr><td><b>control_pts</b></td><td>points the surface should go through</td></tr>
## <tr><td><b>loops</b></td><td>loops to trim</td></tr>
## </table>
##
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
##
proc ic_geo_create_param_surface {family name nu nv ord_u ord_v \
         rational u_knots v_knots control_pts loops } {
#
#   09/02/03 -- DBL
#
    global projlib
    if [catch {$projlib create_param_surface $name $family $nu $nv \
        $ord_u $ord_v $rational $u_knots $v_knots $control_pts $loops} res] {
        return -code error "$res"
    }
    $projlib configure -modified 1
    set bsp [define_geom_object surface $res]
    update_geom_visible_obj $bsp
    return [$bsp get -name]
}
## List the IGES data defining a list of curves
## <table border>
## <tr><td><b>out_file </b></td><td> output file        </td></tr>
## <tr><td><b>format   </b></td><td> output format      </td></tr>
## <tr><td><b>crvs     </b></td><td> list of curves     </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> Output formats:
##      <table border>
##      <tr><td> <b>iges </b> </td><td> IGES  Style </td>
##      <tr><td> <b>tetin</b> </td><td> TETIN Style </td>
##      </table>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains <i>curve names</i>.
## </ul>
## <b>Example</b>
## <pre>
##   # List the IGES data defining a list of curves
##   #
##      if [catch {ic_geo_cre_crv_arc_ctr_rad duck dewey \
##              {1 2 3} {1 0 0} {1 1 1} 4.2 0 1.047197} crv1] {
##           mess "$crv1\n" red
##      } else {
##           mess "created a ducky arc, $crv1\n"
##           if [catch {ic_geo_cre_crv_arc_ctr_rad duck louie \
##              {1 2 3} {0 1 0} {1 1 1} 4.2 0 1.047197} crv2] {
##              mess "$crv2\n" red
##           } else {
##              mess "created a ducky arc, $crv2\n"
##              if [catch {ic_geo_list_crv_data out.txt iges \
##                      "$crv1 $crv2"} err] {
##                   mess "$err\n" red
##              }
##           }
## </pre>
proc ic_geo_list_crv_data {file format crvs} {
    global projlib
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {gk_list_crv_data $file $format $nums} res] {
        return -code error $res
    }
    $projlib configure -modified 1
}
set dont_record_command(ic_geo_list_crv_data) 1

## List the IGES data defining a list of surfaces
## <table border>
## <tr><td><b>out_file </b></td><td> output file        </td></tr>
## <tr><td><b>format   </b></td><td> output format      </td></tr>
## <tr><td><b>crvs     </b></td><td> list of surfaces   </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> Output formats:
##      <table border>
##      <tr><td> <b>iges </b> </td><td> IGES  Style </td>
##      <tr><td> <b>tetin</b> </td><td> TETIN Style </td>
##      </table>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>srfs</i> contains <i>surface names</i>.
## </ul>
proc ic_geo_list_srf_data {file format srfs} {
    global projlib
    set nums ""
    foreach obj $srfs {lappend nums [$projlib get_number_by_name surface $obj] }
    if [catch {gk_list_srf_data $file $format $nums} res] {
        return -code error $res
    }
}
set dont_record_command(ic_geo_list_srf_data) 1

## Makes connected regions of type: surface or curve
## entities are a list of the type, surfaces or curves
## if type is surface, surf_angle limits connectivity based off curves over the feature angle; default is 180, 0 would make each surface seperate
## if type is surface, surf_curvature limits connectivity to surfaces with curvature over value; default is 360, 0 would make each surface seperate
## The return is a seperated list based off connecitivity

proc ic_geo_make_conn_regions {type entities {surf_angle 180} {surf_curvature 360}} {
    set ret ""
    set j [llength $entities]
    if {$type == "surface"} {
 	set lower_type curve
	set curved_surfaces ""
	set angle_curves ""
          if {($surf_angle < 180) || ($surf_curvature < 360)} {
	    set fams ""
	    foreach s $entities {
		lappend fams [ic_geo_get_family surface $s]
		if {($surf_curvature < 360.0) && ([ic_surface_curvature $s] > $surf_curvature)} {
		    lappend curved_surfaces $s
		}	
	    }
	    if {$surf_angle < 180} {
		set fams [lsort -unique $fams]
		set angle_curves [ic_geo_filter_curves $surf_angle $fams]
	    }
	}
    } elseif {$type == "curve"} {
	set lower_type point
    }
    while {$j > 0} {
	set ent    [lindex $entities 0]
	set entities [lreplace $entities 0 0]
	if {$type == "surface"} {
	    while {[lsearch $curved_surfaces $ent] != -1 } {
		lappend ret $ent
		if {$entities == ""} {return $ret}
		set ent    [lindex $entities 0]
		set entities [lreplace $entities 0 0]
		set j [llength $entities]
	    }
	}
	set new_ents $ent
	set all_new_ents $ent
	while [llength $new_ents] {
	    set bounds ""
	    foreach e $new_ents {
		set bounds   [concat $bounds [ic_geo_boundary $type $e 0 1]]
	    }
	    #set bound_ents ""
	    set new_att_ents ""
	    set bounds [lsort -unique $bounds]
	    foreach b $bounds {
		if {($type == "surface") && ([lsearch $angle_curves $b] != -1) } continue
		foreach inc [ic_geo_incident $lower_type $b 1] {
		    if {[lsearch $new_ents $inc] != -1} continue
		    if {($type == "surface") && ([lsearch $curved_surfaces $inc] != -1) } continue
		    set place [lsearch $entities $inc]
		    if {$place == -1} continue	
		    lappend new_att_ents $inc
		    set entities [lreplace $entities $place $place] 
		    lappend all_new_ents $inc
		}
	    }
	    if {$new_att_ents == ""} {break} else {
		set new_ents $new_att_ents
	    }
	}
	lappend ret $all_new_ents
	set j [llength $entities]
    }
    return $ret
}

## Gets all attached entities based off attach_type and orig_type to a list of entities
## attach_type could be boundary or incident
## orig_type could be surface curve or point 
## example, if you want all curves attached to a list of surfaces 
## attach_type is boundary, orig_type is surface, entities is the list of surfaces

proc ic_geo_get_attached_entities {attach_type orig_type entities} {
    set ret ""
    foreach e $entities {
	set ret [concat $ret [ic_geo_$attach_type $orig_type $e]]
    }
    return [lsort -unique $ret]
}
set dont_record_command(ic_geo_get_attached_entities) 1

## Gets all entities of a type: point or curve; that have defined number of
##  entities attached to it.  For example a single curve has 1 entity attached
##  entities is list of type to look for.  Default is all entities of this type.
##  if num is multiple, it will find attachments of 3 or more
##  if num is double, it will find attachments of 2
##  if num is single, it will find attachments of 1
##  if num is unattached, it will find attachments of 0

proc ic_geo_get_entities_by_attach_num {type num {entities ""}} {
    set ret ""
    if {($type != "curve") && ($type != "point")} {
	mess "Type $type is not supported by ic_geo_get_entities_by_attach_num; please use curve or point\n" red
	return $ret
    }
    if {$num == "double"} {set num 2}
    if {$num == "single"} {set num 1}
    if {$num == "unattached"} {set num 0}
    if {$entities == ""} {set entities [ic_geo_get_objects $type ""]}
    foreach e $entities {
	set att [llength [ic_geo_incident $type $e 1]]
	if {$num == "multiple"} {
	    if {$att > 2} {lappend ret $e}
	    continue
	}
	if {$att == $num} {lappend ret $e}
    }
    return $ret
}
set dont_record_command(ic_geo_get_entities_by_attach_num) 1


## This command will take a given "surf" and return the curves that are internal
## In other words, it will return all attached curves except those on outer boundary
## Optional argument not_single will limit the returned curves to only those that are attached to more than 1 surface.

proc ic_geo_get_internal_surface_boundary {surf {not_single 0}} {
    if {[llength [ic_geo_boundary surface $surf 0 1]] < 4} {return ""}
    set outer [ic_geo_boundary surface $surf 1 1] 
    set boundary [ic_geo_boundary surface $surf 0 1]
    set inner ""
    foreach c $boundary {
	if {[lsearch $outer $c] == -1} {
	    if {$not_single && ([llength [ic_geo_incident curve $c 1]] == 1)} {continue}
	    lappend inner $c
	}
    }
    return $inner
}
set dont_record_command(ic_geo_get_internal_surface_boundary) 1

## This procedure returns a list of outer curves and inner curves attached to a set of surfaces
## optional argument not_single will limit the list to just curves attached to more than 1 surface

proc ic_geo_find_internal_outer_loops {surfs {not_single 0} {all_boundary 0}} {

    set bb ""
    if $all_boundary {
	foreach s $surfs {
	    set new_crvs [ic_list_remove_duplicated [ic_geo_boundary surface $s 0 1]]
	    set bb [concat $bb $new_crvs] 
	}
    } else {
	foreach s $surfs {
	    set new_crvs [ic_list_remove_duplicated [ic_geo_boundary surface $s 1 1]]
	    set bb [concat $bb $new_crvs] 
	}
    }
    set bb [ic_list_remove_duplicated $bb]
    set ll [ic_meshdirect_make_conn_loops $bb]
     if {[llength $ll] < 2 } {
#	mess "There is no internal loop in surfs $surfs\n"
	return $ll 
    }
    set ordered ""
    foreach l $ll {
	set l [lindex $l 0]
	set length 0
	foreach c $l {
#	    if {[llength [ic_geo_incident curve $c 1]] == 1} {
#		set length 999999999
#		break
#	    }
	    set length [expr $length + [ic_geo_crv_length $c]]
	}
	lappend ordered [list $length $l]
    }
#mess "ordered is $ordered\n" blue
    set ordered [lsort -index 0 -increasing -real $ordered]
#mess "ordered is $ordered\n" green
    set outer_c [lindex [lindex $ordered end] 1]
    set inner_ordered [lreplace $ordered end end]
    set inner_c ""
    foreach io $inner_ordered {
	set inner_c [concat $inner_c [lindex $io 1]]
    }
#mess "inner_c is $inner_c\n"  red
    if $not_single {
	set new_inner_c ""
	foreach c $inner_c {
	    if {[llength [ic_geo_incident curve $c 1]] > 1} {lappend new_inner_c $c}
	}
	set inner_c $new_inner_c
    }
#mess "inner_c is $inner_c\n"  red
    return [list $outer_c $inner_c]
}
set dont_record_command(ic_geo_find_internal_outer_loops) 1

##This function will find a set of surfaces enclosed by a loop of curves

proc ic_geo_find_internal_surfaces { loop surrounding_surfs {outer_curves ""} {exclusion_surfs ""}} {
    #outer curves in this case are as follows:
    #loop are the curves on the feature that it wants to look to find inner surfaces.
    #surrounding_surfs are around/outside loop
    #outer_curves is outer boundaries of surrounding_surfs...  
    #This is needed, since some times there are thin gaps.
    
    if {[llength $loop] == 1} {set loop [lindex $loop 0]}

    set surrounding_surfs [concat $surrounding_surfs $exclusion_surfs]
    foreach crv $outer_curves {	
	set surrounding_surfs [concat $surrounding_surfs [ic_geo_incident curve $crv 1]]
    }
    set surrounding_surfs [lsort -unique $surrounding_surfs]
    #mess "loop $loop\n" grey
    set loop_surfs [ic_geo_make_conn_buttons $loop $surrounding_surfs]
    #make sure button is not too high to be meshed properly
    #mess "Container of bead with $loop_surfs is [scrib_lib_feature_find_container $loop $loop_surfs]\n" 
    return $loop_surfs
}
set dont_record_command(ic_geo_find_internal_surfaces) 1

## This funciton will take a curve list (loop), and find all surfaces attached to it 
## excluding any given exclusion_surfs

proc ic_geo_make_conn_buttons {loop {exclusion_surfs ""}} {
  set used_surfs $exclusion_surfs
  set used_curves $loop
  set int_surfs "" 
  set bound_curves $loop
  while {$bound_curves != ""} {
     set new_surfs ""
     foreach c $bound_curves {
	set att [ic_geo_incident curve $c 1] 
	foreach a $att {
	    if { [lsearch $used_surfs $a]  == -1 } {
		#Check to see if the surface that will be added is invalid due to it being external.
		#For example, case of Plate with cylinder hole cutout in it.  The cylinder might want to be added, but the back surface should not.
		#In this case we should return nothing.
		set outer_c [ic_geo_boundary surface $a 1 1]
		if {[lsearch $outer_c $c] == -1} {
#		    mess "surface $a is trying to be added to button from curves $loop, but it appears to be invalid\n"
		    return ""
		}
	  	lappend int_surfs $a
	 	lappend used_surfs $a
		lappend new_surfs $a
	    }
	}
    }
    #mess "used surfs $used_surfs\n" green
    set new_curves ""
    foreach surf $new_surfs {
	set curves [ic_geo_boundary surface $surf 0 1]
	foreach crv $curves {
	    if {[lsearch $used_curves $crv] == -1} {
		lappend new_curves $crv
		lappend used_curves $crv
	    }
	}
    }
    if {$new_curves != ""} {
	set bound_curves $new_curves
	#mess "new_curves are $new_curves \n" red
    } else {return $int_surfs}
  }
  return $int_surfs
}

## Split boundaries of the given surfaces at thin regions, that is, where a surface
## boundary points is less than <em>tolerance</em> from an other boundary curve.
## It will not, however, split curves which would result in segments of length less
## than <em>min_res_curve_len</em>. Returns a list of all new points, if any.

proc ic_geo_split_surfaces_at_thin_regions {srfs tolerance min_res_curve_len} {
    global projlib
    
    if ![ic_geo_is_loaded] {
	error "cannot split surface boundaries without geometry loaded"
    }
    
    set new_points ""
    set stat [catch {$projlib split_surface_boundaries_at_thin_regions $srfs $tolerance $min_res_curve_len} new_points]
    if $stat {
	mess "Error: could not split the boundaries of the surfaces $srfs\n" red	
    } else {
	mess "Split the thin region boundaries of surfaces with new points: $new_points\n"
    }
    
    return $new_points
}

## Split boundaries of the given surfaces at thin regions, that is, where a surface
## boundary points is less than <em>tolerance</em> from an other boundary curve.
## It will not, however, split curves which would result in segments of length less
## than <em>min_res_curve_len</em>. Returns tcl-error-stat.

proc ic_geo_surface_create_smart_nodes {srfs tolerance min_res_curve_len} {
    global projlib
    
    if ![ic_geo_is_loaded] {
	error "cannot create smart nodes without without geometry loaded"
    }
    
    if {"all" == $srfs} {
	set srfs [ic_geo_get_objects surface]
    }
    
    set new_points ""
    set stat [catch {$projlib surface_create_smart_nodes $srfs $tolerance $min_res_curve_len} new_points]
    if $stat {
	mess "Error: could not create smart nodes on the surfaces $srfs\n" red
    } else {
	mess "Created smart nodes on the surfaces: $srfs\n"
    }
    
    return $stat
}      

## For each surface in the given list <em>surfs</em> returns a list of the four corners
## of a rectangular topology of that surface. The points are ordered around the rectangular
## either clockwise or counter-clockwise. The form of the list returned is:
##   "{surf_name_1 {pt_name_1_1 pt_name_1_2 pt_name_1_3 pt_name_1_4} {surf_name_2 {pt_name_2_1 ...}}"

proc ic_geo_surface_topological_corners {surfs} {
    global projlib

    if ![ic_geo_is_loaded] {
	error "cannot get topological corners of \"$surfs\" without geometry loaded"
    }
    
    if [catch {$projlib surface_topological_corners $surfs} res] {
	error "could not get topological corners of \"$surfs\""
    }
    
    return $res
}


## Return the critical point of the notch in a given flange surface
# ex: ic_geo_flanges_notch_critical_points E174935

proc ic_geo_flanges_notch_critical_points {surfs} {
    global projlib
    
    if ![ic_geo_is_loaded] {
	error "cannot process flanges among $surfs without geometry loaded"
    }
    
    if [catch {$projlib surface_flange_notch_critical_points $surfs} res] {
	error "could not get critical points of flanges \"$surfs\""
    }
    
    return $res
}

## Split a surface at a parameter
## <table border>
## <tr><td><b>srf     </b></td><td> surface name	</td></tr>
## <tr><td><b>par     </b></td><td> surface parameter 0 <= par <= 1  </td></tr>
## <tr><td><b>sel     </b></td><td> == 0 u cons; == 1 v cons    </td></tr>
## </table>
##
## <b>Example</b>
## <pre>
##      if [catch {ic_geo_trm_srf_at_par $srf1 0.5 0} err] {
##           mess "$err\n" red
##      }
## </pre>
proc ic_geo_trm_srf_at_par {srf par sel} {
    global projlib
    set num [$projlib get_number_by_name surface $srf]
    if [catch {gk_trm_srf_at_par $srf $par $sel} res] {
        return -code error $res
    }
}

## Split folded surfaces by maximum curvature.
## <table border>
## <tr><td><b>srfs</b></td><td>surface names</td></tr>
## <tr><td><b>ang</b></td><td>maximum total curvature</td></tr>
## </table>
# only for NURB
proc ic_geo_trm_srfs_by_curvature {srfs ang} {
    global projlib
    foreach obj $srfs {lappend nums [$projlib get_number_by_name surface $obj]}
    # This saves whole model in build topo many times, which is exorbident
    # Fixed - Ganesan
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    if [catch {split_folded_surfaces $ang $nums 1} err] {
        mess "$err\n" red
        return 2
    }
    if $resume {
        ic_undo_resume
    }
    display_update geo 0
    $projlib configure -modified 1
}

## Calculate curvature of surface(s).
## <table border>
## <tr><td><b>surf</b></td><td>surface name</td></tr>
## <tr><td><b>tol</b></td><td>relative boundary tolerance (100 -> 1/100 -> 1%)</td></tr>
## </table>
## Returns curvature of surface(s)
# only for NURB
proc ic_surface_curvature {surf {tol 100} {debug 0}} {
    global projlib
    set num [$projlib get_number_by_name surface $surf]
    if [catch {surface_curvature $num $tol $debug} err] {
        mess "$err\n" red
    }
    return $err
}

## Create 2D hull of surfaces or curves.
## <table border>
## <tr><td><b>entities</b></td><td>entity names</td></tr>
## <tr><td><b>tol</b></td><td>approximation tolerance</td></tr>
## <tr><td><b>four</b></td><td>split hull at best four corners if set</td></tr>
## <tr><td><b>type</b></td><td>surface or curve</td></tr>
## <tr><td><b>shrink</b></td><td>relative shrink tolerance (0 ... 1)</td></tr>
## </table>
proc ic_hull_2d {{entities ""} {tol 0} {four 1} {type "surface"} {shrink 0} {debug 0}} {
    global projlib
    set nums ""
    if {$type != "surface" && $type != "curve"} {
        mess "Unknown entity type!\n" red
        return ""
    }
    foreach obj $entities {lappend nums [$projlib get_number_by_name $type $obj]}
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    set res ""
    if [catch {hull_2d $nums $tol $four $type $debug $shrink} res] {
        mess "$res\n" red
        return ""
    }
    if $resume {
        ic_undo_resume
    }
    if $debug {
        update_bsp_consistency
    } else {
        foreach cur $res {
            set nb [$projlib get_number curve $cur]
            set nb [define_geom_object curve $nb]
            update_geom_visible_obj $nb
        }
    }
    display_update geo 0
    $projlib configure -modified 1
    return $res
}

## Create a faceted surface from points using a 2D Delaunay triangulation.
## <table border>
## <tr><td><b>points</b></td><td>point names</td></tr>
## </table>
proc ic_surface_from_points {points {part ""} {name ""}} {
    global projlib
# ic_function must have part and name parameters for new surface
# otherwice it's difficult to use result in replay/scripting  
# Fix!: "surface_from_points" must take triplet or point name!
# as a temporary solution create/delete points from locations
	set pts_to_delete ""
	foreach p $points {
		if [ic_is_triplet $p] {
			set newp [ic_geo_cre_pnt FACETED_SRF TMP_PTS.00 $p]
			lappend pts_to_delete $newp
			lappend pts $newp
		} else {
			lappend pts $p
		}
	}			
    if [catch {surface_from_points $pts} res] {
        mess "$res\n" red
		ic_delete_geometry point names $pts_to_delete 0
        return ""
    }
	ic_delete_geometry point names $pts_to_delete 0
    set nb [$projlib get_number surface $res]
    set nb [define_geom_object surface $nb]
	if [llength $name] {
		set res [ic_geo_set_name surface $res $name 1 0]
	}
	if [llength $part] {
        ic_geo_set_family surface $part names $res
	}
    update_geom_visible_obj $nb
    return $res
}

## Extend surface edge to surface(s).
## <table border>
## <tr><td><b>curve</b></td><td>"yellow" edge to extend</td></tr>
## <tr><td><b>surfaces</b></td><td>surfaces to extend surface edge to</td></tr>
## <tr><td><b>toler</b></td><td>geometry tolerance</td></tr>
## <tr><td><b>bld_topo</b></td><td>associate edge curves</td></tr>
## <tr><td><b>perpendicular</b></td><td>extend normal to curve if 1, create a
##         curtain surface if 0, or do a parametric extension if 2</td></tr>
## <tr><td><b>connect</b></td><td>connect extension to target surface(s) if set</td></tr>
## <tr><td><b>concat_crvs</b></td><td>clean points on surface edges if set</td></tr>
## </table>
proc ic_geo_surface_extend {curve surfaces {toler 0} {bld_topo 1} {perpendicular 1} \
    {connect 0} {concat_crvs 1} {db 0}} {
    global projlib
    set numc ""
    set nums ""
    set res ""
    if {$concat_crvs} {
        #
        #  see "proj\topo_funcs.C"
        #
        set concat_crvs 3
    }
    foreach obj $curve    {lappend numc [$projlib get_number_by_name curve   $obj]}
    foreach obj $surfaces {lappend nums [$projlib get_number_by_name surface $obj]}
    set topo_surfs $surfaces
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    set extended_surfs ""
    foreach num $numc {
        set cname [$projlib get_name curve $num]
        if [catch {extend_surface $toler $num $nums $perpendicular $connect $db} res] {
            if {$res != ""} {
                mess "$res\n" red
            }
            return 2
        } elseif {$res != "0"} {
            mess "Extended surface \"$res\" at curve \"$cname\" with tolerance $toler.\n"
            lappend topo_surfs $res
            lappend extended_surfs $res
        } else {
            set bld_topo 0
        }
    }
    if {$bld_topo} {
        #
        #  trim end surfaces
        #
        if {$toler <= 0} {
            set toler -1
        }
        if {$db} {
            mess "Build topology on surfaces \"$topo_surfs\" (tol = $toler, \
                connect = $connect, concat_crvs = $concat_crvs)\n" red
        }
        ic_geo_build_topo_on_srfs $topo_surfs "" $toler $connect $concat_crvs 1
    } elseif {$db} {
        mess "no build topo\n" red
    }
    update_bsp_consistency
    display_update geo 0
    $projlib configure -modified 1
    if $resume {
        ic_undo_resume
    }
    if {$db} {
        mess "return = \"$extended_surfs\"\n" red
    }
    return $extended_surfs;  # may be s *created* surf
}

## Create a curve driven surface
## <table border>
## <tr><td><b>family  </b></td><td> family containing new surface       </td></tr>
## <tr><td><b>name    </b></td><td> name of created surface             </td></tr>
## <tr><td><b>gencrv  </b></td><td> name of generator or driven curve   </td></tr>
## <tr><td><b>ctrcrv  </b></td><td> name of center or driver curve      </td></tr>
## <tr><td><b>bld_topo</b></td><td> associate edge curves        	</td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
proc ic_geo_cre_srf_crv_drv_srf {family name gencrv ctrcrv {bld_topo 0}} {
    global projlib fam_visible
    set new_fam [ic_geo_new_family $family]
    set del_list ""

    set selgen   ""
    if [catch {$projlib get_number_by_name curve $gencrv} selgen] {
	return -code error "$selgen, $gencrv"
    }

    set selctr   ""
    if [catch {$projlib get_number_by_name curve $ctrcrv} selctr] {
	return -code error "$selctr, $ctrcrv"
    }

    set gennums  ""
    if [catch {ic_geo_cvt_uns_to_bsc TMP_CRV CVT_CRV $gencrv} cvtList] {
	return -code error "Error: $cvtList" 
    } else {
	foreach bsc $cvtList {
	    if [catch {$projlib get_number_by_name curve $bsc} res] {
	    	return -code error "$res, $gencrv"
	    } else {
	    	lappend gennums $res
	    }
	    if {$bsc != $gencrv} {
		lappend del_list $bsc
	    }
	}
    }
    #
    set ctrnums  ""
    if [catch {ic_geo_cvt_uns_to_bsc TMP_CRV CVT_CRV $ctrcrv} cvtList] {
	return -code error "Error: $cvtList" 
    } else {
	foreach bsc $cvtList {
	    if [catch {$projlib get_number_by_name curve $bsc} res] {
	    	return -code error "$res, $ctrcrv"
	    } else {
	    	lappend ctrnums $res
	    }
	    if {$bsc != $ctrcrv} {
		lappend del_list $bsc
	    }
	}
    }
    set gennum [lindex $gennums 0]    
    set ctrnum [lindex $ctrnums 0]
    #
    if [catch {gk_cre_srf_crv_drv_srf $family $name $gennum $ctrnum $selgen $selctr $bld_topo} res] {
        return -code error $res
    } else {
	update_surface_display $res
	display_update geo $new_fam
    }
    foreach bsc $del_list {
	ic_delete_geometry curve names $bsc 0
    }
    ic_geo_delete_family TMP_CRV
    catch { unset fam_visible(TMP_CRV) }
    return $res
}

## This function returns a list of all geometric entity types available in the
## loaded geometry. If no geometry is loaded, it returns all possible types:
##   <em>"surface curve point material density loop"</em>

proc ic_geo_get_types {{which all}} {
    set types "surface curve point material density loop body"
    switch $which {
	all { return $types }
	current {
	    if [ic_geo_is_loaded] {
		set loaded_types ""
		foreach t $types {
		    if [ic_geo_num_objects $t] { lappend loaded_types $t }
		}
		return $loaded_types
	    }
	}
	default { return $types }
    }
}
set dont_record_command(ic_geo_get_types) 1

## Returns the list of incident surfaces at curve whose
## dihedral angle with surf is less than the feat_angle

proc ic_flood_fill_surface_angle { surf curve angle } {
    global projlib

    set bspsrf [$projlib get_object_by_name surface $surf]
    set bspcrv [$projlib get_object_by_name curve $curve]	
    set snum [$bspsrf get -number]
    set cnum [$bspcrv get -number]
	      
    set inc [$projlib flood_surface_angle $snum $cnum $angle ]
    return $inc
}
set dont_record_command(ic_flood_surface_angle) 1

## Returns the list of entities connected by the lower dimension entities.
## For example surfaces connected by the curves.
## <ul>
## <li> what       - 'curve' or 'surface'
## <li> ents       - list of type, name pairs
## <li> all        - 0 if only one level is desired
## <li> feat_angle - 0 >= theta <= 90, valid only for $what = surface
## <li> bound_mode - 'outer' if only outer loop is desired, valid only for
##               $what = surface
## <li> nedges     - for use with curves - if 0 then all attached curves,
##              otherwise only go with curves that have the specified
##              number of attached surfaces
## </ul>

proc ic_geo_flood_fill {what ents {all 1} {feat_angle 0} {bound_mode "all"} {nedges 0}} {
    global projlib
    
    foreach {type name} $ents {
	set obj [$projlib get_object_by_name $type $name]
	if {$obj != ""} {
	    set have_object($obj) 1
	    set go_from($obj) 1
	}
    }

    set outer [expr {$bound_mode != "all"}]
    
    set nlayer 0
    while {[info exists go_from]} {
        set from [array names go_from]
        set got ""
        foreach ent $from {
	    switch [$ent get -type] {
		unused__entity {
		    set inc [incident_objects $ent]
		    set bound [boundary_objects $ent $outer]
		    set got [concat $got $inc $bound]
		}
		curve {
		    set pts [boundary_objects $ent $outer]
		    foreach p $pts {
			foreach c [incident_objects $p] {
			    if {!$nedges || ($nedges == [llength [$c incident]])} {
				lappend got $c
			    }
			}
		    }
		}
		surface {
		    set crvs [boundary_objects $ent $outer]
		    foreach c $crvs {
			if {$feat_angle > 0 } {
			    set snum [$ent get -number]
			    set cnum [$c get -number]
			    foreach osname [$projlib flood_surface_angle $snum $cnum $feat_angle] {
				lappend got [$projlib get_object_by_name surface $osname]
#				puts $osname
			    }
			    
			} else {
			    foreach osurf [incident_objects $c] {
				lappend got $osurf
			    }
			}
		    }
		}
	    }
	}
	unset go_from
	foreach g $got {
	# do not append empty line!
		if ![llength $g] continue
	    if ![info exists have_object($g)] {
		set go_from($g) 1
	    }
	    set have_object($g) 1
	}
	if !$all break
    }
    set ret ""
    foreach im [array names have_object] {
    
    #===Onyx 58052: add only for 1 layer if family (not item) in GUI is visible.
    if !$all {
      set fam [$im get -family]
      if ![ic_gui_set fam_visible($fam)] continue
    }
    #===End
	lappend ret [$im get -type] [$im get -name]
    }
    return $ret
}
set dont_record_command(ic_geo_flood_fill) 1

## Returns a two-element list containing the triangulation tolerance of the model,
## such that the first element is the tolerance (real number) and the second element
## is an integer (0 or 1) inidicating whether or not the value is relative to a global
## setting.

proc ic_geo_get_triangulation_tolerance {} {
    global projlib
    if {"" == $projlib} return ""
    return [$projlib get_triangulation_tolerance]
}
set dont_record_command(ic_geo_get_triangulation_tolerance) 1

## Create the convex hull of the objects.  <b>entities</b> is a list of pairs,
## where the first element is the type and the second is the name.

proc ic_geo_convex_hull {entities name fam} {
    global projlib
    
    if {$name == ""} {
        set name [$projlib new_name surface $fam 0]
    }
    
    set surfaces ""
    foreach ent $entities {
        set s [$projlib get_object_by_name [lindex $ent 0] [lindex $ent 1]]
        if {$s != ""} { lappend surfaces $s }
    }
    set files [geo_run_hull $surfaces 1 0]
    if {$files == ""} { return 0 }
    set snum [$projlib create_unstruct_surface_from_files $name $fam [lindex $files 0] [lindex $files 1]]
#    rm_tmp_file [lindex $files 0]
#    rm_tmp_file [lindex $files 1]
    set bsp [define_geom_object surface $snum]
    if {[$bsp get_centroid] == ""} { return 0 }
    $projlib orient_triangles_outward $snum [$bsp get_centroid]
    $bsp set_source_objects [lindex $files 2] ""
    update_geom_visible_obj $bsp
    return 1
}

## Remove triangles on a plane in the named surface.

proc ic_geo_remove_triangles_on_plane {surf plane tol} {
    global projlib
    
    set snum [$projlib get_number_by_name surface $surf]
    return [$projlib remove_triangles_on_plane $snum $plane $tol]
}

## Return the bounding box of some objects.  The <b>ents</b> argument
## is a list of the form {{type name} {type name} ...}

proc ic_geo_bbox_of_entities {ents} {
    global projlib
    
    set ims ""
    foreach ent $ents {
	lappend ims [$projlib get_object_by_name \
			 [lindex $ent 0] [lindex $ent 1]]
    }
    return [bbox_of_images $ims]
}
set dont_record_command(ic_geo_bbox_of_entities) 1

## Used by convex hull

proc ic_geo_classify_by_regions {planes entities how} {
    global projlib
    
    set ims ""
    foreach ent $entities {
	set im [$projlib get_object_by_name \
		    [lindex $ent 0] [lindex $ent 1]]
	if {$im == ""} { error "no [lindex $ent 0] named [lindex $ent 1]" }
	lappend ims $im
    }
    # This function is defined in tdv/regions.C
    return [classify_by_regions $planes $ims $how]
}

## Used by convex hull

proc ic_geo_split_surfaces {surfs planes} {
    global projlib

    set ss ""
    foreach s $surfs {
	lappend ss [$projlib get_object_by_name [lindex $s 0] [lindex $s 1]]
    }
    set nsurfs ""
    set old ""
    foreach s $ss {
	if {[$s get -type] != "surface"} {
	    lappend nsurfs $s
	    continue
	}
	lappend old [$s get -number]
	delete_geom_object $s
    }
    if {$old == ""} {
	mess "Warning: no objects to split\n" red
	return ""
    }
    
    foreach pp $planes {
	set new ""
	foreach s $old {
	    if {[$projlib get_object_type surface $s] == "parametric"} {
		set ns [$projlib facetize_surface $s 0]
		$projlib delete_surface $s
		set s $ns
	    }
#	    set pp [plane_from_line_and_vec $p]
	    set n [$projlib segment_surface_plane $s \
		       [lrange $pp 0 2] [lrange $pp 3 5]]
	    if {$n != ""} {
		set new [concat $new $n]
		$projlib delete_surface $s
	    } else {
		lappend new $s
	    }

	}
	set old $new
    }
    #puts "Got surfaces: $new"

    foreach n $new {
	set nb [define_geom_object surface $n]
	if {$nb != ""} { lappend nsurfs $nb }
    }
    
    set ret ""
    foreach ns $nsurfs {
	lappend ret [list  [$ns get -type] [$ns get -name]]
    }
    return $ret
}

##
## Generate mesh geometry associativity for Catia interface
## <table border>
## <tr><td><b>domain</b></td><td> domain file </td></tr>
## <tr><td><b>assoc</b></td><td> output associativity file </td></tr>
## </table>
##
proc ic_geo_elem_assoc {domain assoc} {
    if ![file exists $domain] {
        return -code error "Error opening file, $domain"
    }
    if [catch {gk_geo_elem_assoc $domain $assoc} res] {
	return -code error $res
    }
    return $res
}

## Create a bspline surface from a point array
## <table border>
## <tr><td><b>family</b></td><td> family containing surface    </td></tr>
## <tr><td><b>name  </b></td><td> name of created surface      </td></tr>
## <tr><td><b>n_ptu </b></td><td> number of points in u direction </td></tr>
## <tr><td><b>n_ptv </b></td><td> number of points in v direction </td></tr>
## <tr><td><b>pnts  </b></td><td> point data </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> The approximation tolerance is relative.  It will be scaled
##      by the pointset radius to form an absolute tolerance.
##      It has a default value of 0.001.
## </ul>
proc ic_geo_cre_bsp_srf_by_pnt_array { family name n_ptu n_ptv pnts {tol 0.0001}} {
#
#   Last Modified ---
#   12/07/01 --	AWM 
#	     -- Added reference to unit test program; defining points
#		can be prescribed point names.
# 
    global projlib
    
    create_empty_tetin_if_needed
    
#
    set new_fam [ic_geo_new_family $family]
#
#   Expand any points passed as entity names
    set exp_pnts $pnts
    set indx 0
    foreach pnt $pnts {
	if {[llength $pnt] == 1} {
#
#           Hopefully a point entity
            if [catch {ic_geo_get_point_location $pnt} coords]  {
		return -code error "Error parsing point data"
	    } else {
	        set exp_pnts [lreplace $exp_pnts $indx $indx $coords]
	    }
	}
        incr indx
    }

    if [catch {gk_cre_bsp_srf_by_pnt_array $family $name \
	    $n_ptu $n_ptv $exp_pnts $tol} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}


## Create point and b-spline geometry from an ICEM Input file.
## <table border>
## <tr><td><b>fit_tol  </b></td><td> approximation tolerance </td></tr>
## <tr><td><b>mode     </b></td><td> type of icem input file </td></tr>
## <tr><td><b>pnt_fam  </b></td><td> family for point entities </td></tr>
## <tr><td><b>pnt_prefix </b></td><td> prefix for point names  </td></tr>
## <tr><td><b>crv_fam  </b></td><td> family for curve entities </td></tr>
## <tr><td><b>crv_prefix </b></td><td> prefix for curve names  </td></tr>
## <tr><td><b>srf_fam  </b></td><td> family for surface entities </td></tr>
## <tr><td><b>srf_prefix </b></td><td> prefix for surface names  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> MED must be initialized by loading a tetin file or opening
##      an empty part (see <i>ic_empty_tetin</i>).
## <li> The approximation tolerance is relative.  It will be scaled
##      by the pointset radius to form an absolute tolerance.
##      It has a default value of 0.001.
## <li> Supported values for <i>mode</i> are <b>input</b> and <b>plot3d</b>.
##      <b>named</b> for named entities is planned, but not yet supported.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_geom_input.tcl">ic_geo_cre_geom_input.tcl</a>.
## </ul>
proc ic_geo_cre_geom_input {in_file \
        {fit_tol 0.0001} {mode input} \
	{pnt_fam PNT} 	 {pnt_prefix pnt} \
	{crv_fam CRV} 	 {crv_prefix crv} \
	{srf_fam SRF} 	 {srf_prefix srf} \
	              } {
    global projlib
#
#   Last Modified ---
#   08/30/07 -- JSP
#	     -- increased speed for large number of points
#            -- fixed onyx 61945
#   11/14/02 -- AWM
#	     -- Split longgggg blocks into shorter segments
#		for surface fitting.
#   10/19/02 -- AWM
#	     -- Split plot3d support into separate module
#   10/11/02 -- AWM
#	     -- Added support for a plot3d
#   10/01/02 -- AWM
#	     -- Added support for a new input format
#   12/17/01 -- AWM
#	     -- Created
#
    create_empty_tetin_if_needed
    #
    if {$pnt_prefix != ""} {
	set new_fam [ic_geo_new_family $pnt_fam]
    }
    if {$crv_prefix != ""} {
	set new_fam [ic_geo_new_family $crv_fam]
    }
    if {$srf_prefix != ""} {
	set new_fam [ic_geo_new_family $srf_fam]
    }
    #
    #	branch off for other formats
    if {$mode == "plot3d"} {
	if [catch {ic_geo_cre_geom_plot3d $in_file $fit_tol \
		$pnt_fam $pnt_prefix \
		$crv_fam $crv_prefix \
		$srf_fam $srf_prefix} res] {
	    return -code error $res
	}
	return $res
    }
    #
    set pnt ""
    set pnt_list ""
    set crv_list ""
    set srf_list ""
    set srf_crv_list ""
    #
    set crv_pnt_list ""
    set srf_pnt_list ""
    #
    set n_crv_pnts -1
    set n_u_pnts -1 
    set n_v_pnts -1
    #
    set output_pnt_list ""
    set output_crv_list ""
    set output_srf_list ""
    #

    if {$pnt_prefix != ""} {
        if [ic_geo_num_objects point] {
            set search [lsort -dictionary [ic_geo_get_objects point "" 1]]
            set search [lindex [lsearch -all -inline $search "${pnt_prefix}*"] end]
            if {$search != ""} {
                set start [string trimleft $search $pnt_prefix]
                if [string is integer $start] {
                    set num_points [expr $start + 1]
                }
	    } else {
	        set num_points 0
	    }
        } else {
            set num_points 0
        }
    }

    if [catch {open $in_file "r"} instream] {
        return -code error "cannot open file $in_file for reading"
    } else {
	foreach line [split [read $instream] \n] {
	    if [regexp {^[#C/c$]}    $line dummy dummy] continue;
	    if [regexp {^[ 	]*$} $line dummy dummy] continue;
            if [regexp {^LEVEL}      $line dummy dummy] {
		regsub {\/} $line {_} pnt_name
		regsub {\/} $line {_} crv_name
		regsub {\/} $line {_} srf_name
		continue;
            }
	    
	    if [regexp {,} $line dummy dummy] {
		regsub -all {,} $line { } line
	    }
	    if {[llength $line] == 1} {
		set n_crv_pnts $line
		set crv_pnt_list ""
		set srf_pnt_list ""
		set srf_crv_list ""
            } elseif {[llength $line] == 2} {
		set n_u_pnts [lindex $line 0]
		set n_crv_pnts   [lindex $line 0]
		set n_v_pnts [lindex $line 1]
		set crv_pnt_list ""
		set srf_pnt_list ""
		set srf_crv_list ""
	    } elseif {[llength $line] == 3} {
		if {$pnt_prefix != ""} {
		    if [info exists num_points] {
		        set name $pnt_prefix${num_points}
		        incr num_points
		    } else {
		        set name [ic_geo_new_name point $pnt_prefix]
		    }
		    set line [coords_into_global $line]
                    if [catch {gk_cre_pnt $pnt_fam $name $line} res] {
	                return -code error $res
                    } else {
	                set pnt_ent $res
                    }
                    lappend output_pnt_list $pnt_ent
		}
		lappend crv_pnt_list $line
		lappend srf_pnt_list $line
	    } elseif {[llength $line] > 3} {
		foreach x $line {
		    lappend pnt $x
		    if {[llength $pnt] == 3} {
		   	if {$pnt_prefix != ""} {
		            if [info exists num_points] {
		                set name $pnt_prefix${num_points}
		                incr num_points
		            } else {
		                set name [ic_geo_new_name point $pnt_prefix]
		            }
		            set pnt [coords_into_global $pnt]
                            if [catch {gk_cre_pnt $pnt_fam $name $pnt} res] {
	                        return -code error $res
                            } else {
	                       set pnt_ent $res
                            }
                            lappend output_pnt_list $pnt_ent
                        }
		    	lappend crv_pnt_list $pnt
		    	lappend srf_pnt_list $pnt
		    	set pnt ""
		    }
		}
	    } else {
		continue;
	    }

	    if {$n_crv_pnts > 0 && [llength $crv_pnt_list] >= $n_crv_pnts} {
		if {$crv_prefix != ""} {
		    set ind $n_crv_pnts
		    incr ind -1
		    set pnt_list [lrange $crv_pnt_list 0 $ind]
		    set name [ic_geo_new_name curve $crv_prefix]
		    if [catch {ic_geo_cre_bsp_crv_n_pnts \
			$crv_fam $name $pnt_list $fit_tol} ent_name] {
			return -errorinfo $ent_name
		    }
		    lappend output_crv_list $ent_name
		}
		lappend srf_crv_list 42
		set crv_pnt_list [lrange $crv_pnt_list $n_crv_pnts end]
	    }
	    if {$n_v_pnts > 0 && [llength $srf_crv_list] >= $n_v_pnts} {
		if {$srf_prefix != ""} {
		    set n_v_left $n_v_pnts
		    set pnt_base 0
		    while {$n_v_left > 0} {
			set n_v_seg $n_v_left
			if {$n_v_seg > 511} {
			    set n_v_seg 256
			    incr n_v_left -$n_v_seg
			    incr n_v_left
			} else {
			    set n_v_left 0
		        }
                        set ind [expr  $n_u_pnts*$n_v_seg + $pnt_base]
                        incr ind -1
                        set pnt_list [lrange $srf_pnt_list $pnt_base $ind]
                        set name [ic_geo_new_name surface $srf_prefix]
                        if [catch {ic_geo_cre_bsp_srf_by_pnt_array $srf_fam $name \
                            $n_u_pnts $n_v_seg \
                            $pnt_list $fit_tol} ent_name] {
                            return -errorinfo $ent_name
                        }
                        lappend output_srf_list $ent_name
			set pnt_base $ind
			incr pnt_base
			incr pnt_base -$n_u_pnts
		    }
		}
		set n_pnts [expr  $n_u_pnts*$n_v_pnts]
		set srf_pnt_list [lrange $srf_pnt_list $n_pnts end]
	    }
	}
	close $instream
    }
    if {$pnt_prefix != ""} {
        define_geom_objects point
    }
    set ret_val [list $output_pnt_list $output_crv_list $output_srf_list]
    return $ret_val
}

## Convert structured surface domains to b-spline geometry.
## If successful, the current mesh and geometry are unloaded,
## and the new geometry is loaded.
## Surfaces, curves, and points are created only if families are
## provided for each argument type.
## By default, only surfaces will be created.
proc ic_geo_import_str_to_cad {doms {srf_fam SRFS} {crv_fam ""} {pnt_fam ""}} {
    global env

    foreach df $doms {
	if {[str_domainfile_dimension $df] == 2} {lappend domains $df} \
	else {mess "\"$df\" is not a structured surface mesh - skipping\n" red} 
    }
    if ![info exists domains] return
    if {$srf_fam != ""} {set srf_fam [string toupper $srf_fam]; set srf_prefix $srf_fam/} else {set srf_prefix ""}
    if {$crv_fam != ""} {set crv_fam [string toupper $crv_fam]; set crv_prefix $crv_fam/} else {set crv_prefix ""}
    if {$pnt_fam != ""} {set pnt_fam [string toupper $pnt_fam]; set pnt_prefix $pnt_fam/} else {set pnt_prefix ""}
    for {set i 0} {[file exists plot3d-temp$i]} {incr i} {}

    busy 1
    if [catch "exec [list $env(ICEM_ACN)/icemcfd/output-interfaces/plot3d] $domains plot3d-temp$i" res] {
	busy 0
	return -code error "$res\n"
    }
    ic_unload_mesh
    ic_unload_tetin
    set pa [tdv_active 0]
    if [catch {ic_geo_cre_geom_input plot3d-temp$i.fmt 0.001 plot3d \
		$pnt_fam $pnt_prefix $crv_fam $crv_prefix $srf_fam $srf_prefix} res] {
	tdv_active $pa
	busy 0
	return -code error "$res\n"
    }
    mess "Done importing surfaces\n"

    tdv_active $pa
    busy 0
    cmd_rm plot3d-temp$i.fmt plot3d-temp$i.log
    return $res
}

## Return the b-spline data associated to a curve
## <table border>
## <tr><td><b>crvs    </b></td><td> list of curve to examine           </td></tr>
## <tr><td><b>datums  </b></td><td> list of curve properties to return </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> curve properties may be a list of one or more of the following:
##      <dl>
##      <dt><b>order</b>
##      <dd> Integer order of spline
##      <dt><b>ncp</b>
##      <dd> Number of control points (3-tuples in model space)
##      <dt><b>rat</b>
##      <dd> Rational flag -- 1 if rational; 0 if integral
##	<dt><b>cps</b>
##	<dd> Return model space control points
##	<dt><b>knots</b>
##	<dd> Return knot vector
##	<dt><b>weights</b>
##	<dd> Return a list of curve weights
##	</dl>
## <li> If the utility is called for multiple curves, the data for each
##      curve will be grouped together
## <li> If weights are requested for an integral spline, the  list of
##      weights returned will be null
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_crv_data.tcl">ic_geo_crv_data.tcl</a>.
## </ul>
proc ic_geo_crv_data { crvs datums} {
#
#   Last Modified ---
#   12/17/01 -- AWM
#	     -- Created
#
    global projlib
#
#   This code can handle multiple selections
    set data ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} res] {
 	    return -code error $res
	} else {
    	    if [catch {gk_crv_data $res $datums} res] {
		return -code error $res
	    } elseif {[llength $crvs] == 1} {
		return $res
	    } else {
		lappend data $res
	    }
	}   
    }
    return $data
}
set dont_record_command(ic_geo_crv_data) 1

## Return the b-spline data associated to a surface
## <table border>
## <tr><td><b>srfs    </b></td><td> list of surface to examine           </td></tr>
## <tr><td><b>datums  </b></td><td> list of surface properties to return </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> surface properties may be a list of one or more of the following:
##      <dl>
##      <dt><b>order</b>
##      <dd> Integer orders (u and v) of spline
##      <dt><b>ncp</b>
##      <dd> Control point counts in u and v
##      <dt><b>rat</b>
##      <dd> Rational flag -- 1 if rational; 0 if integral
##	<dt><b>cps</b>
##	<dd> Return model space control points.  Control points are
##	     returned in a list arranged in v-major order (see example
##	     program for details).
##	<dt><b>knots_u</b>
##	<dd> Return u knot vector
##	<dt><b>knots_v</b>
##	<dd> Return v knot vector
##	<dt><b>weights</b>
##	<dd> Return a list of surface weights.  Weights are returned in
##	     a list arranged in v-major order
##	</dl>
## <li> If the utility is called for multiple surfaces, the data for each
##	surface will be grouped together
## <li> If weights are requested for an integral spline, the  list of
##      weights returned will be null
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_srf_data.tcl">ic_geo_srf_data.tcl</a>.
## </ul>
proc ic_geo_srf_data {srfs datums} {
#
#   Last Modified ---
#   12/17/01 -- AWM
#	     -- Created
#
    global projlib
#
#   This code can handle multiple selections
    set data ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
 	    return -code error $res
	} else {
    	    if [catch {gk_srf_data $res $datums} res] {
		return -code error $res
	    } elseif {[llength $srfs] == 1} {
		return $res
	    } else {
		lappend data $res
	    }
	}   
    }
    return $data
}
set dont_record_command(ic_geo_srf_data) 1

## Create a new surface by lofting two or more curves
## <table border>
## <tr><td><b>family  </b></td><td> family containing new surface    		</td></tr>
## <tr><td><b>name    </b></td><td> name of created surface      		</td></tr>
## <tr><td><b>tol     </b></td><td> approximation tolerance            		</td></tr>
## <tr><td><b>crvs    </b></td><td> list of curves to loft     			</td></tr>
## <tr><td><b>sec_ord </b></td><td> order in cross direction            	</td></tr>
## <tr><td><b>form    </b></td><td> 0 (C1 cubic blend) or 1 (C2 cubic blend)	</td></tr>
## <tr><td><b>bld_topo</b></td><td> associate edge curves        		</td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The surface order in the cross direction must be 2 (linear) or 4 (cubic)
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The approximated surface should lie within <i>tol</i> of the curves
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## </ul>
##
proc ic_geo_cre_srf_loft_crvs {family name tol crvs {sec_ord 4} {form 0} {bld_topo 0}} {
    global projlib
    set new_fam [ic_geo_new_family $family]
    
    set nums ""
    set del_list ""
    foreach obj $crvs {
	if [catch {ic_geo_cvt_uns_to_bsc $family CVT_CRV $obj} cvtList] {
	    return -code error "Error: $cvtList" 
	} else {
	    foreach bsc $cvtList {
		if [catch {$projlib get_number_by_name curve $bsc} res] {
		    return -code error "$res, $obj"
		} else {
		    lappend nums $res
		}
		if {$bsc != $obj} {
		    lappend del_list $bsc
		}
	    }
	}
    }
    #
    if [catch {gk_cre_srf_loft_crvs $family $name $tol $nums $sec_ord $form $bld_topo} res] {
        return -code error $res
    } else {
	#
	#   delete construction geometry
	    ic_delete_geometry curve names $del_list 0
	#
	#   define entity in display
	update_surface_display $res
	display_update geo $new_fam
        return $res
    }
}

## Project a curve to a surface.
## <table border>
## <tr><td><b>family</b></td><td> family for new curve </td></tr>
## <tr><td><b>name</b></td><td> name for new curve (can be "") </td></tr>
## <tr><td><b>surface</b></td><td> name of input surface </td></tr>
## <tr><td><b>curve</b></td><td> name of input curve </td></tr>
## <tr><td><b>dir</b></td><td> direction vector </td></tr>
## </table>
## Return value is the name of the new curve.

proc ic_geo_cre_crv_test_project_surface {family name surface curve dir} {
    global projlib
    
    if {[ic_geo_check_objects_exist surface $surface] == ""} {
      ic_mess "Surface \"$surface\" doesn't exists \n" red
      return ""
    }
    if {[ic_geo_check_objects_exist curve $curve] == ""} {
      ic_mess "Curve \"$curve\" doesn't exists \n" red
      return ""
    }
    if {[llength $dir] != 3} {
      ic_mess "Invalid direction $dir \n" red
      return ""
    }
    
    if {$family == ""} {
      set family [ic_geo_get_family surface $surface]
    }
    set is_new_fam [ic_geo_new_family $family]
    if {[llength $is_new_fam] != 1} {
      ic_mess "$is_new_fam \n" red
      return ""
    }
    if {[ic_geo_check_objects_exist curve $name] != ""} { 
      set name [ic_geo_new_name curve $name]
    }
    set snum [$projlib get_number_by_name surface $surface]
    set cnum [$projlib get_number_by_name curve $curve]
    set nnum [$projlib test_project_curve_to_surface $snum $cnum $family $name $dir]
    if {$nnum == ""} { return "" }

    set nobj [define_geom_object curve $nnum]
    update_geom_visible_obj $nobj
    display_update geo $is_new_fam
    $projlib configure -modified 1
    return $name
}

## Create curve as section of a surface with plane, cylinder or segment.
## <table border>
## <tr><td><b>family</b></td><td> family for new curve </td></tr>
## <tr><td><b>name</b></td><td> name for new curve (can be "") </td></tr>
## <tr><td><b>surface</b></td><td> name of input surface </td></tr>
## <tr><td><b>mode</b></td></tr>
## <tr><td></td><td> 0 - section with plane </td></tr>
## <tr><td></td><td> 1 - section with cylinder </td></tr>
## <tr><td></td><td> 2 - section with segment </td></tr>
## <tr><td><b>P0, P1, P2</b></td><td> define plane, cylinder or segment: </td></tr>
## <tr><td></td><td> Surface through three given points </td></tr>
## <tr><td></td><td> Cylinder with axis on P0-P1 line and P2 on the radius </td></tr>
## <tr><td></td><td> Segment from P0 to P1 projected in direction P0-P2 </td></tr>
## </table>
## Return value is the name of the new curve.

proc ic_geo_cre_surface_section {family name surface mode P0 P1 {P2 ""} {trim 0}} {
    global projlib
# way around crash in test_project_bar_to_surface for 10.1
# if P2 == "" -> P1 is a normal vector for plane
	set p0 [ic_vset -vec - $P0]	
	set p1 [ic_vset -vec - $P1]
    
	if {$p0 == "" || $p1 == ""} {
          ic_mess "Section location not defined $P0, $P1\n" red
      return ""
    }
    if {$family == ""} {
      set family [ic_geo_get_family surface [lindex $surface 0]]
    }
    if {[ic_geo_check_objects_exist curve $name] != ""} { 
      set name [ic_geo_new_name curve $name] 
    }
    set list ""
    set entlist ""
    set crvs ""
    foreach srf $surface {
		if {[ic_geo_check_objects_exist surface $srf] == ""} continue
		lappend entlist "surface $srf"
		lappend list $srf
	}
	foreach "bmin bmax" [ic_geo_bbox_of_entities $entlist] ""
	if {$P2 == ""} {
		set normal $p1
	} else {
		set p2 [ic_vset -vec - $P2]
		set normal [ic_vcalc product $p0 $p1 $p2]
		if {$normal == "" || ![ic_vcalc len $normal]} {
			ic_mess "Wrong plane definition\n" red
			return
		}
	}
	set length [ic_vcalc distance $bmin $bmax]
	set length [expr $length *2]
	ic_surface plane_pt_vec $family tmp_pln_srf [list $p0 $normal length $length]
	foreach srf $list { 
		set crv [ic_geo_intersect_surfaces $family "$srf tmp_pln_srf" use_bsp]
		if {[ic_geo_check_objects_exist curve $crv] == ""} continue
		lappend crvs $crv
		if $trim {
			catch {ic_geo_trim_surface $srf $crv}
		}
	}
	ic_delete_geometry surface names tmp_pln_srf 0

#    
#    set snum [$projlib get_number_by_name surface $surface]
#    set nnum [$projlib test_project_bar_to_surface $snum $family $name $mode $P0 $P1 $P2]
#    if {$nnum == ""} { return "" }
#
#    set nobj [define_geom_object curve $nnum]
#    update_geom_visible_obj $nobj
#    display_update geo $is_new_fam

	if {[llength $crvs] == 1} {
		ic_geo_set_name curve $crvs $name
    return $name
	}
	return $crvs
}

## Offset surface using mesh representation

proc ic_geo_offset { family name surface_to_offset offset {max_factor 3} } {
    global projlib
    # YK, 020906

    set new_fam [ic_geo_new_family $family]

    if [catch {$projlib get_number_by_name surface $surface_to_offset} res] {
	return -code error "$res, $obj"
    }

    if [catch {$projlib gk_offset $family $name $res $offset $max_factor} res] {
	return -code error "Error creating offset: $res"
    } else {
	set nb [$projlib get_number surface $res]
	set nb [define_geom_object surface $nb]
	update_geom_visible_obj $nb
    }
    display_update geo $new_fam
    return $res
}

## Create a reduced b-spline curve
## <table border>
## <tr><td><b>family</b></td><td> family containing curve    </td></tr>
## <tr><td><b>name  </b></td><td> name of created curve      </td></tr>
## <tr><td><b>crvs  </b></td><td> list of curves to be joined</td></tr>
## <tr><td><b>tol   </b></td><td> approximation tolerance    </td></tr>
## <tr><td><b>return</b></td><td> Names of created curves    </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> Example usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_crv_datred.tcl">ic_geo_cre_crv_datred.tcl</a>.
## </ul>
proc ic_geo_cre_crv_datred {family name crvs {tol 0.001}} {
    global projlib
#
#   History---
#   01/21/02 -- AWM
#	     -- Created
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }

    if { $family != "" } {
    	set new_fam [ic_geo_new_family $family]
    } else {
	set crv_num [ lindex $nums 0 ]
	set new_fam [ $projlib get_family curve $crv_num ]
    }

    if { $tol == "" } {
	set tol "0.001"
    }
    if [catch {gk_cre_crv_datred $family $name $nums $tol} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
        return $res
    }
}

## Create a reduced b-spline surface
## <table border>
## <tr><td><b>family</b></td><td> family containing surface    </td></tr>
## <tr><td><b>name  </b></td><td> name of created surface      </td></tr>
## <tr><td><b>crvs  </b></td><td> list of surfaces to be joined</td></tr>
## <tr><td><b>tol   </b></td><td> approximation tolerance    </td></tr>
## <tr><td><b>return</b></td><td> Names of created surfaces    </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>srfs</i> contains surface <i>surface names</i>.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_datred.tcl">ic_geo_cre_srf_datred.tcl</a>.
## </ul>
proc ic_geo_cre_srf_datred {family name srfs {tol 0.001}} {
    global projlib
#
#   History---
#   01/21/02 -- AWM
#	     -- Created
    set nums ""
    foreach obj $srfs {lappend nums [$projlib get_number_by_name surface $obj] }

    if { $family != "" } {
    	set new_fam [ic_geo_new_family $family]    
    } else {
	set srf_num [ lindex $nums 0 ]
	set new_fam [ $projlib get_family surface $srf_num ]
    }

    if { $tol == "" } {
	set tol "0.001"
    }
    if [catch {gk_cre_srf_datred $family $name $nums $tol} res] {
        return -code error $res
    } else {
        set nb [$projlib get_number surface $res]
        set nb [define_geom_object surface $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}


## Create a swept surface from a generator curve and axis
## <table border>
## <tr><td><b>family  </b></td><td> family containing surface   </td></tr>
## <tr><td><b>name    </b></td><td> name of created surface     </td></tr>
## <tr><td><b>gen     </b></td><td> generator curve(s)          </td></tr>
## <tr><td><b>drv     </b></td><td> drive curve or vector       </td></tr>
## <tr><td><b>bld_topo</b></td><td> associate edge curves       </td></tr>
## <tr><td><b>return  </b></td><td> name of created surface     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_sweep.tcl">ic_geo_cre_srf_sweep.tcl</a>.
## </ul>
proc ic_geo_cre_srf_sweep { family name gen drv {bld_topo 0}} {
#
#   Last Modified ---
#   01/28/02 --	AWM 
#	     -- created.
#
    global projlib
#
    set new_fam [ic_geo_new_family $family]
#
    set seldrv ""
    set drvnums  ""
    set del_list ""
    if {[llength $drv] > 1} {
	#
	#  if len > 1 drv is a vector
	set drvnum $drv
    } else {
	#
	#  if len == 1 drv is a curve name
        if [catch {$projlib get_number_by_name curve $drv} seldrv] {
	    return -code error "$seldrv, $drv"
        }
	#
        if [catch {ic_geo_cvt_uns_to_bsc TMP_CRV CVT_CRV $drv} cvtList] {
            return -code error "Error: $cvtList"
        } else {
            foreach bsc $cvtList {
                if [catch {$projlib get_number_by_name curve $bsc} res] {
                    return -code error "$res, $drv"
                } else {
                    lappend drvnums $res
                }
                if {$bsc != $drv} {
                    lappend del_list $bsc
                }
            }
        }
        set drvnum [lindex $drvnums 0]
    }
    #
    set srfNames ""
    foreach obj $gen {
        if [catch {$projlib get_number_by_name curve $obj} selgen] {
	    return -code error "$selctr, $obj"
	}
	#
        if [catch {ic_geo_cvt_uns_to_bsc TMP_CRV CVT_CRV $obj} cvtList] {
            return -code error "Error: $cvtList"
        } else {
            foreach bsc $cvtList {
                if [catch {$projlib get_number_by_name curve $bsc} res] {
                    return -code error "$res, $drv"
                } else {
		    if [catch {gk_cre_srf_sweep $family $name \
			$res $drvnum $selgen $seldrv $bld_topo} srf] {
			return -code error "Error creating sweep: $srf"
		    } else {
			lappend srfNames $srf
		    }
		    if {$bsc != $obj} {
		        lappend del_list $bsc
		    }
                }
            }
        }
	#
    }
    foreach bsc $del_list {
	ic_delete_geometry curve names $bsc 0
    }
    #
    if {$bld_topo && [llength $srfNames] > 1} {
        ic_geo_build_topo_on_srfs $srfNames
    }
    #
    foreach srf $srfNames {
	update_surface_display $srf
    }
    display_update geo $new_fam
    return $srfNames
}

## Determine whether two curves are oriented in parallel or opposite
## directions.
## <table border>
## <tr><td><b>crv1    </b></td><td> curve 1 name                </td></tr>
## <tr><td><b>crv2    </b></td><td> curve 2 name                </td></tr>
## <tr><td><b>return  </b></td><td> 1 if opposite 0 otherwise   </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Main use of this function is to diagnose failures in some of
##      the surface construction codes.
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_sweep.tcl">ic_geo_cre_srf_sweep.tcl</a>.
## </ul>
proc ic_geo_crv_is_opposite { crv1 crv2} {
#
#   Last Modified ---
#   02/03/02 -- AWM 
#            -- created.
#
    global projlib
    #
    if [catch {$projlib get_number_by_name curve $crv1} crv1Num] {
            return -code error "Error retrieving curve $crv1Num\n"
    }
    if [catch {$projlib get_number_by_name curve $crv2} crv2Num] {
            return -code error "Error retrieving curve $crv2Num\n"
    }
    if [catch {gk_crv_is_opposite $crv1Num $crv2Num} res] {
        return -code error "Error: $res"
    }
    return $res
}
set dont_record_command(ic_geo_crv_is_opposite) 1

## Determine whether a curve bounds a surface
## <table border>
## <tr><td><b>crv     </b></td><td> curve  name                </td></tr>
## <tr><td><b>return  </b></td><td> number of surfaces bounded </td></tr>
## </table>
##
proc ic_geo_crv_is_edge { crv } {
#
    global projlib
    #
    if [catch {$projlib get_number_by_name curve $crv} crvNum] {
            return -code error "Error retrieving curve $crvNum\n"
    }
    if [catch {gk_crv_is_edge $crvNum} res] {
        return -code error "Error sterilize imperfection: $res"
    }
    return $res
}
set dont_record_command(ic_geo_crv_is_edge) 1

##  Activate repair function for degenerate bsplines in the tetin reader.
##  For now these functions are turned off by default.
##  <table border>
##  <tr><Td><b>switch   </b></td><td> 0 for off; 1 for on</td></tr>
##  </table>
proc ic_geo_fix_degen_geom {{switch 0}} {
     gk_fix_degen_geom $switch
}

## Find parameter of closest point on surface
## <table border>
## <tr><td><b>srf   </b></td><td> name of surface   </td></tr>
## <tr><td><b>pnt   </b></td><td> test point	    </td></tr>
## <tr><td><b>want_ext</b></td><td> want extended output </td></tr>
## <tr><td><b>return</b></td><td> uv pair	    </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The uv coordinates will be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_find_nearest_srf_pnt.tcl">ic_geo_find_nearest_srf_pnt.tcl</a>.
## </ul>
proc ic_geo_find_nearest_srf_pnt { srf pnt {want_ext 0}} {
    global projlib
#
#   Expand any points passed as entity names
    set exp_pnt $pnt
    if {[llength $pnt] == 1} {
#
#	Hopefully a point entity
	if [catch {ic_geo_get_point_location $pnt} coords]  {
	    return -code error "Error parsing point data"
	} else {
	    set exp_pnt $coords
	}
    }
    #
    set srf_num [$projlib get_number_by_name surface $srf]
    #
    if [catch {gk_find_nearest_srf_pnt $srf_num $exp_pnt $want_ext} uv_pnt] {
	return -code error $uv_pnt
    }
    #
    #	Strip off a level of listing
    set uv_pnt [lindex $uv_pnt 0]
    #
    return $uv_pnt
}

set dont_record_command(ic_geo_find_nearest_srf_pnt) 1

## Find parameter of closest point on curve
## <table border>
## <tr><td><b>crv   </b></td><td> name of curve	</td></tr>
## <tr><td><b>pnt   </b></td><td> test point	</td></tr>
## <tr><td><b>return</b></td><td> t parameter	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The t parameter will be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_find_nearest_crv_pnt.tcl">ic_geo_find_nearest_crv_pnt.tcl</a>.
## </ul>
proc ic_geo_find_nearest_crv_pnt { crv pnt } {
    global projlib
#
#   Expand any points passed as entity names
    set exp_pnt $pnt
    if {[llength $pnt] == 1} {
#
#	Hopefully a point entity
	if [catch {ic_geo_get_point_location $pnt} coords]  {
	    return -code error "Error parsing point data"
	} else {
	    set exp_pnt $coords
	}
    }
    #
    set crv_num [$projlib get_number_by_name curve $crv]
    #
    if [catch {gk_find_nearest_crv_pnt $crv_num $exp_pnt} par] {
	return -code error $par
    }
    #
    return $par
}
set dont_record_command(ic_geo_find_nearest_crv_pnt) 1

## get the dist of coords from the nearest surface in <em>surface_family</em>.

proc ic_geo_distance_from_surfaces {surfs coords} {
 
    if {"" == $surfs} {
	mess "No surfaces specified\n"
	return 1e+38
    }
    set coords_proj [ic_geo_project_coords surface $surfs $coords {0 0 0}]
    if {"" == $coords_proj} {
	mess "Could not project coords $coords to surfaces $surfs\n"
	return 1e+38
    }
    return [ic_geo_pnt_dist $coords $coords_proj]
}
set dont_record_command(ic_geo_distance_from_surfaces) 1

## get nearest surface to coords from a list of surfaces...  

proc ic_geo_nearest_surface_list {coords surfaces} {
    set surf_dist ""
    foreach s $surfaces {
	lappend surf_dist [list $s [ic_geo_distance_from_surfaces $s $coords]]
    }
    return [lindex [lindex [lsort -index 1 -real $surf_dist] 0] 0]
}

## Get the normal vector of a curve at a parameter
## <table border>
## <tr><td><b>par   </b></td><td> curve t parameter		</td></tr>
## <tr><td><b>crv   </b></td><td> list of curves to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The return string will be a list of 3-tuples
## <li> The input uv coordinates should be unitized.
## </ul>
proc ic_geo_get_crv_nrm { par crv } {
    global projlib
#
    set nums ""
    foreach obj $crv {lappend nums [$projlib get_number_by_name curve $obj] }
    if [catch {gk_get_crv_nrm $par $nums} res] {
        return -code error $res
    }
    return $res
}
set dont_record_command(ic_geo_get_crv_nrm) 1

## Get a position on a curve at a parameter
## <table border>
## <tr><td><b>par   </b></td><td> curve t parameter		</td></tr>
## <tr><td><b>crv   </b></td><td> list of curves to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The input uv coordinates should be unitized.
## <li> The return string will be a list of 3-tuples
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_get_crv_pos.tcl">ic_geo_get_crv_pos.tcl</a>.
## </ul>
proc ic_geo_get_crv_pos { par crv } {
    global projlib
#
    set nums ""
    foreach obj $crv {lappend nums [$projlib get_number_by_name curve $obj] }
    if [catch {gk_get_crv_pos $par $nums} res] {
        return -code error $res
    }
    return $res
}
set dont_record_command(ic_geo_get_crv_pos) 1

## Get the binormal vector of a curve at a parameter
## <table border>
## <tr><td><b>par   </b></td><td> curve t parameter		</td></tr>
## <tr><td><b>crv   </b></td><td> list of curves to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The input uv coordinates should be unitized.
## </ul>
proc ic_geo_get_crv_binrm { par crv } {
    global projlib
#
    set nums ""
    foreach obj $crv {lappend nums [$projlib get_number_by_name curve $obj] }
    if [catch {gk_get_crv_binrm $par $nums} res] {
        return -code error $res
    }    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}
set dont_record_command(ic_geo_get_crv_binrm) 1

## Create one or more bspline curves from an unstructured curve
## <table border>
## <tr><td><b>family  </b></td><td> family for new curves       </td></tr>
## <tr><td><b>base    </b></td><td> base name of created curves </td></tr>
## <tr><td><b>uns     </b></td><td> name(s) of unstructured curve(s)</td></tr>
## <tr><td><b>return  </b></td><td> name of created curves      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> If the input curve is a b-spline curve it will be returned 
##	without modification as the output curve
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cvt_uns_to_bsc.tcl">ic_geo_cvt_uns_to_bsc.tcl</a>.
## </ul>
proc ic_geo_cvt_uns_to_bsc { family base uns} {
#
#   Last Modified ---
#   03/01/02 --	AWM 
#	     -- created
#
    global projlib
#
    set new_fam [ic_geo_new_family $family]
#
    set crvNames ""
    foreach obj $uns {
	if [catch {$projlib get_number_by_name curve $obj} crvNum] {
	    return -code error "Error retrieving curve $obj\n"
	}
	#
	if [catch {gk_cvt_uns_to_bsc $family $base $crvNum} res] {
	    return -code error "Error creating curve: $res"
	} else {
	    #
	    #   the utility returns proj integer id's
	    set res [lindex $res 0]
	    foreach crv_no $res {
		set nb [define_geom_object curve $crv_no]
		update_geom_visible_obj $nb
		lappend crvNames [$projlib get_name curve $crv_no]
	    }
	}
    }
    if [llength [ic_geo_get_objects all $new_fam] ] {
    	display_update geo $new_fam
	}
    return $crvNames
}

## Compute the area of one or more surfaces
## <table border>
## <tr><td><b>srfs    </b></td><td> list of one or more surfaces </td></tr>
## <tr><td><b>return  </b></td><td> area of surfaces             </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Surface area is computed from projlib's facetization of the geometry;
##	the results will be influenced by the value of the triangulation tolerance
##	when the part was read.
## <li> Example usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_srf_area.tcl">ic_geo_srf_area.tcl</a>.
## </ul>
proc ic_geo_srf_area { {srfs ""} } {
#
#   Last Modified ---
#   03/17/02 -- AWM -- Created
#
    global projlib
#
    ic_undo_suspend
    if {$srfs == ""} {
        set srfs [ic_geo_get_objects surface]
    }
    set srf_nums ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
            return -code error $res
        } else {
            lappend srf_nums $res
        }   
    }
    if [catch {gk_srf_area  $srf_nums } area] {
        ic_undo_resume
        return -code error $area
    }
    ic_undo_resume
    return $area
}

## sort surfaces by their surface area.  Args is arguments for the sort.

proc ic_geo_sort_by_srf_area {surf_list {args ""}} {
    set ordered ""
    foreach s $surf_list {
        set area 0
        foreach ss $s {
            if ![llength [ic_geo_check_objects_exist surface $ss]] {continue}
            set area [expr $area + [ic_geo_srf_area $ss]] 
        }
        lappend ordered [list $area $s]
    }
    set cmd [concat  "lsort -index 0 -real " $args [list $ordered]]
    #mess "cmd is $cmd\n"
    set ordered [eval $cmd]
    set surfs ""
    foreach s $ordered {
        lappend surfs [lindex $s 1]
    }
    return $surfs
}

## Trim a surface back to its active area.
## <table border>
## <tr><td><b>srfs    </b></td><td> list of one or more surfaces </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> A form of data reduction; trims the undisplayed portion of 
##	a b-spline away.
## <li> Unless the underlying surface is reduced by at least 5% in
##	the u or v coordinate, the surface will be left unmodified.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_srf_area.tcl">ic_geo_srf_area.tcl</a>.
## </ul>
proc ic_geo_reduce_face { srfs } {
#
#   Last Modified ---
#   03/25/02 -- AWM -- Created
#
    global projlib
#
    set srf_nums ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} srf_num] {
            return -code error $srf_num
        }   
        if [catch {gk_reduce_face $srf_num } res] {
            return -code error $res
        }
    }
}

## Get the tangent vector of a curve at a parameter
## <table border>
## <tr><td><b>par   </b></td><td> curve t parameter		</td></tr>
## <tr><td><b>crv   </b></td><td> list of curves to evaluate	</td></tr>
## <tr><td><b>return</b></td><td> list of 3-tuple of doubles	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The tangent vector will be the unnormalized derivative vector with
##      respect to the unitized parameterization
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The input uv coordinates should be unitized.
## </ul>
proc ic_geo_get_crv_tan { par crv } {
    global projlib
#
    set nums ""
    foreach obj $crv {lappend nums [$projlib get_number_by_name curve $obj] }
    if [catch {gk_get_crv_tan $par $nums} res] {
        return -code error $res
    }    #
    #	Strip off a level of listing
    set res [lindex $res 0]
    return $res
}
set dont_record_command(ic_geo_get_crv_tan) 1

## Tangentially extend a curve
## <table border>
## <tr><td><b>crvs  </b></td><td> list of curves to extend   </td></tr>
## <tr><td><b>dist  </b></td><td> distance (relative) of ext.</td></tr>
## <tr><td><b>srtend</b></td><td> extend start (0), end(1)   </td></tr>
## <tr><td><b>return</b></td><td> Names of extended curves   </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> The length of the extension will be roughly "dist*curve length"
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> If the curve has <i>topology</i> (i.e. references surfaces or vertices)
##      it will be copied rather than modified.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> Example usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_mod_crv_tanext.tcl">ic_geo_mod_crv_tanext.tcl</a>.
## </ul>
proc ic_geo_mod_crv_tanext {crvs dist srtend} {
    global projlib
#
#   History---
#   04/26/02 -- AWM
#            -- Created
    if { $dist == "" } {
        set dist "0.1"
    }
    set nums   ""
    set output ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} num] {
            return -code error "$num, $obj"
        } else {
            if [catch {gk_mod_crv_tanext $num $dist $srtend} res] {
                return -code error $res
            } else {
                set nb [$projlib get_number curve $res]
                set nb [define_geom_object curve $nb]
                update_geom_visible_obj $nb
            }
            lappend nums $res
        }
    }
    return $output
}

## Tangentially extend a surface
## <table border>
## <tr><td><b>srfs  </b></td><td> list of surfaces to extend   </td></tr>
## <tr><td><b>dist  </b></td><td> distance (relative) of ext.  </td></tr>
## <tr><td><b>edge  </b></td><td> index of edge to extend      </td></tr>
## <tr><td><b>return</b></td><td> Names of modified surfaces   </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The <i>dist</i> parameter is unitless and will be scaled by
##	the lengths of the u or v constant control point rows.
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The edge indicator is set as follows:
##      <UL>
##      <li> 1 V-Min direction
##      <li> 2 U-Min direction
##      <li> 3 V-Max direction
##      <li> 4 U-Max direction
##      </ul>
## <li> The list <i>srfs</i> contains surface <i>surface names</i>.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_mod_srf_tanext.tcl">ic_geo_mod_srf_tanext.tcl</a>.
## </ul>
proc ic_geo_mod_srf_tanext {srfs dist srtend {bld_topo 0}} {
    global projlib
#
#   History---
#   04/26/02 -- AWM
#            -- Created
    set nums ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
            return -code error "$res, $obj"
        } else {
            lappend nums $res
        }
    }
    if { $dist == "" } {
        set dist "0.1"
    }
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    if {[catch {gk_mod_srf_tanext $nums $dist $srtend} res]} {
        return -code error $res
    } else {
        if {!$bld_topo} {
            foreach obj $srfs {
                set nb [$projlib get_number surface $obj]
                set nb [define_geom_object surface $nb]
                update_geom_visible_obj $nb
            }
        } else {
            ic_geo_build_topo_on_srfs $srfs "" -1 1 0 1
        }
    }
    if $resume {
        ic_undo_resume
    }
    return $res
}

## Extend a surface
## <table border>
## <tr><td><b>srfs</b></td><td>list of surfaces to extend</td></tr>
## <tr><td><b>dist</b></td><td>distance of extension</td></tr>
## <tr><td><b>edge</b></td><td>curve at edge to extend</td></tr>
## <tr><td><b>return</b></td><td>Names of modified surfaces</td></tr>
## </table>
proc ic_geo_mod_srf_ext {srfs dist edge {bld_topo 0}} {
    global projlib

    set nums ""
    set numc ""
    set topo_srfs ""
    set debug 0
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
            return -code error "$res, $obj"
        } else {
            lappend nums $res
        }
        set edges [ic_geo_get_srf_edges $srfs]
        foreach crv $edges {
            set topo_srfs [concat $topo_srfs [ic_geo_incident curve $crv 1]]
        }
    }
    if [catch {$projlib get_number_by_name curve $edge} res] {
        return -code error "$res, $edge"
    } else {
       set numc $res
    }
    if { $dist == "" } {
        set dist "0.1"
    }
    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }
    if {[catch {extend_surface_at_edge $nums $dist $numc $debug} res]} {
        if $resume { ic_undo_resume }
        if {$res == ""} {
            set res "unknown error"
        }
        return -code error $res
    } else {
        if {!$bld_topo} {
            foreach obj $srfs {
                set nb [$projlib get_number surface $obj]
                set nb [define_geom_object surface $nb]
                update_geom_visible_obj $nb
            }
        } else {
            set toler -1
            if {$debug > 0} {
                ic_mess "Build topo on \"$topo_srfs\" with tolerance $toler\n" red
            }
            ic_geo_build_topo_on_srfs $topo_srfs "" $toler 1 0 1
        }
    }
    if $resume {
        ic_undo_resume
    }
    return $res
}

## Match two curves
## <table border>
## <tr><td><b>crv1    </b></td><td> name of first curve          </td></tr>
## <tr><td><b>crv2    </b></td><td> name of second curve         </td></tr>
## <tr><td><b>crv1end </b></td><td> curve1 end indicator         </td></tr>
## <tr><td><b>crv2end </b></td><td> curve2 end indicator         </td></tr>
## <tr><td><b>modes   </b></td><td> 5 element list of flags      </td></tr>
## <tr><td><b>return  </b></td><td> Names of modified curves     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The curve end parameters, crv1end and crv2end, take the values
##	<table>
##      <tr><td> closest endpoint </td><td> 0 </td></tr>
##      <tr><td> start point      </td><td> 1 </td></tr>
##      <tr><td>   end point      </td><td> 2 </td></tr>
##      </table>
## <li> The <i>modes</i> argument is an optional 5 element list of 
##	flags addressing the following functions
##      <table border>
##      <tr><td> mode[0] </td><Td> <table> 
##                                 <tr><td> 0	</td><td> point only </td></tr>
##                                 <tr><td> 1	</td><td> point and tangent (default) </td></tr>
##                                 <tr><td> 2	</td><td> point, tangent, and curvature </td></tr>
##                                 <tr><td> 3	</td><td> point and curvature </td></tr>
##				   </table>
##      <tr><td> mode[1] </td><Td> <table> 
##                                 <tr><td> 1	</td><td> geometric matching (default)</td></tr>
##                                 <tr><td> 2	</td><td> exact matching </td></tr>
##				   </table>
##      <tr><td> mode[2] </td><Td> <table> 
##                                 <tr><td> 0	</td><td> do not change order </td></tr>
##                                 <tr><td> 1	</td><td> permit change of order (default)</td></tr>
##				   </table>
##      <tr><td> mode[3] </td><Td> <table> 
##                                 <tr><td> 0	</td><td> both splines matched (default) </td></tr>
##                                 <tr><td> 1	</td><td> only first spline changed </td></tr>
##				   </table>
##      <tr><td> mode[4] </td><Td> <table> 
##                                 <tr><td> 0	</td><td> 3d matching (default) </td></tr>
##                                 <tr><td> 1	</td><td> 4d matching </td></tr>
##				   </table>
##      </table>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_mod_crv_match_crv.tcl">ic_geo_mod_crv_match_crv.tcl</a>.
## </ul>
proc ic_geo_mod_crv_match_crv {crv1 crv2 {crv1end 0} {crv2end 0} {modes ""}} {
    global projlib
#
#   History---
#   05/16/02 -- AWM
#	     -- Created
#   10/11/05 -- VG modes validation: set "" (default) if wrong input (med crash)
	if {[llength $modes] != 5} {set modes ""}
    
    if [catch {$projlib get_number_by_name curve $crv1} crv1num] {
	return -code error "$crv1num, $crv1"
    }
    if [catch {$projlib get_number_by_name curve $crv2} crv2num] {
	return -code error "$crv2num, $crv2"
    }

    if [catch {gk_mod_crv_match_crv $crv1num $crv2num $crv1end $crv2end $modes} res] {
        return -code error $res
    } else {
	foreach obj $res {
	    if [catch {$projlib get_number_by_name curve $obj} nb] {
		return -code error "$nb, $obj"
	    } else {
	        set nb [define_geom_object curve $nb]
		update_geom_visible_obj $nb
	    }
	}
        return $res
    }
}

## Match curve and a point
## <table border>
## <tr><td><b>crv     </b></td><td> name of curve                </td></tr>
## <tr><td><b>pnt     </b></td><td> name of point                </td></tr>
## <tr><td><b>crvend  </b></td><td> curve end indicator          </td></tr>
## <tr><td><b>return  </b></td><td> Name of modified curve      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The curve end parameter, crvend takes the values
##	<table>
##      <tr><td> closest endpoint </td><td> 0 </td></tr>
##      <tr><td> start point      </td><td> 1 </td></tr>
##      <tr><td>   end point      </td><td> 2 </td></tr>
##      </table>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
proc ic_geo_mod_crv_match_pnt {crv pnt {crvend 0} {modes ""}} {
    global projlib
#
#   History---
#   09/26/02 -- AWM
#	     -- Created
    
    if [catch {$projlib get_number_by_name curve $crv} crvnum] {
	return -code error "$crvnum, $crv"
    }
    if [catch {$projlib get_number_by_name point $pnt} pntnum] {
	return -code error "$pntnum, $pnt"
    }

    if [catch {gk_mod_crv_match_pnt $crvnum $pntnum $crvend} res] {
        return -code error $res
    } else {
	foreach obj $res {
	    if [catch {$projlib get_number_by_name curve $obj} nb] {
		return -code error "$nb, $obj"
	    } else {
	        set nb [define_geom_object curve $nb]
		update_geom_visible_obj $nb
	    }
	}
        return $res
    }
}

## Create one or more offset surfaces 
## <table border>
## <tr><td><b>family  </b></td><td> family containing surface   	</td></tr>
## <tr><td><b>name    </b></td><td> base name of created surface     	</td></tr>
## <tr><td><b>base    </b></td><td> surface(s) to offset        	</td></tr>
## <tr><td><b>offset  </b></td><td> distance to offset  		</td></tr>
## <tr><td><b>all_conn</b></td><td> Offset connected surfs if set	</td></tr>
## <tr><td><b>stitch  </b></td><td> Preserve connected edges if set	</td></tr>
## <tr><td><b>return  </b></td><td> name(s) of created surface(s)     	</td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Negative offsets are allowed.
## <li> If more than one surface is given to the routine, offsets will be oriented
##	relative to the first surface if the two surfaces are related by an edge
##	adjacency chain.
## <li> If the "all_conn" flag is set, all surfaces connected to the first surface
##	by an edge adjacency chain will be offset.
## <li> If the "stitch" flag is set, the offsets of two surfaces sharing an edge
##      will be extended tangentially so that the offset surfaces also share an edge
## <li> For an annotated example of usage see 
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_offset.tcl">ic_geo_cre_srf_offset.tcl</a>.
## </ul>
proc ic_geo_cre_srf_offset { family name base offset {all_conn 0} {stitch 0}} {
#
    global projlib
#
    set new_fam [ic_geo_new_family $family]
#
    set srfNames ""
    set baseNums ""
    set unsNames ""
    set bspNames ""

    foreach obj $base {
	if [catch {$projlib get_number_by_name surface $obj} srfNum] {
	    return -code error "Error retrieving surface $obj\n"
	} else {
# 58609: ncp limit set 200 in each direction		
		set ncp [lindex [ic_geo_srf_data $obj ncp] 0]
		if {([lindex $ncp 0] > 200) || ([lindex $ncp 1] > 200)} {
			mess "Surface $obj has too many points. Reapproximate.\n" red
			return  
		}
		
	    switch [$projlib get_object_type surface $srfNum] {
		parametric {
            	    lappend baseNums $srfNum
		    lappend bspNames $obj
		}
		mesh {
            	    lappend unsNames $obj
		}
	    }
	}
    }
    if [llength baseNums] {
	#
	#  This helps reduce problems with periodics
	ic_geo_reduce_face $bspNames
	#
    	if [catch {gk_cre_srf_offset $family $name \
	    $baseNums $offset $all_conn $stitch} res] {
            return -code error "Error creating offset: $res"
    	} else {
	    foreach obj $res {
		set nb [$projlib get_number surface $obj]
	    	set nb [define_geom_object surface $nb]
	    	update_geom_visible_obj $nb
	    	lappend srfNames $obj
                set edges [ic_geo_get_srf_edges $obj]
                foreach crv $edges {
                    set eb [$projlib get_number curve $crv]
                    set eb [define_geom_object curve $eb]
                    update_geom_visible_obj $eb
                    if [catch {ic_geo_crv_get_end $crv 0} endPt] {
		    } else {
                        set pb [$projlib get_number point $endPt]
                        set pb [define_geom_object point $pb]
                        update_geom_visible_obj $pb
		    }
                    if [catch {ic_geo_crv_get_end $crv 1} endPt] {
		    } else {
                        set pb [$projlib get_number point $endPt]
                        set pb [define_geom_object point $pb]
                        update_geom_visible_obj $pb
		    }
                }
	    }
    	}
    }
    if [llength unsNames] {
	foreach uns $unsNames {
	    if [catch {ic_geo_offset $family $name $uns $offset 1} $res] {
		return -code error "Error creating offset: $res"
    	    } else {
		set nb [$projlib get_number surface $res]
	    	set nb [define_geom_object surface $nb]
	    	update_geom_visible_obj $nb
	    	lappend srfNames $res
	    }
    	}
    }
    display_update geo $family
    return $srfNames
}

## Automatically creates a body for each closed volume of surfaces as
## determined by the connectivity produced from build topology.
## <table border>
## <tr><td><b>fam</b></td><td>Family for bodies</td></tr>
## <tr><td><b>buildtopo</b></td><td>Build topology if non-zero</td></tr>
## <tr><td><b>tol</b></td><td>Tolerance for the optional build topology function</td></tr>
## <tr><td><b>multi</b></td><td>Old style assembly naming if non-zero</td></tr>
## <tr><td><b>newm</b></td><td>Use the new schema if non-zero</td></tr>
## <tr><td><b>surf</b></td><td>Initial surface</td></tr>
## </table>

proc ic_geo_build_bodies {{fam LIVE} {buildtopo 0} {tol 0.01} {multi 0} {newm 0} {surf ""} {assem 0} {from_solids 0}} {
    global projlib

    if {$newm == 0 && $surf != ""} {
        mess "Old approach can't take the \"surf\" parameter.\n" red
        return 0
    }
    if {$surf != ""} {
        mess "Warning: Make sure that the normal of manually specified initial surface points outside in order to build the inner body.\n" red
    }
    if {$buildtopo} {
        ic_geo_fixup 1
        ic_build_topo $tol
        ic_geo_delete_unattached
    }
    if {$newm} {
        foreach b [ic_geo_get_objects body] {
            ic_delete_geometry body names $b 0
        }
    }
    if {$newm && $from_solids} {
        set nsolids [ic_geo_count_solids_without_material]
        if $nsolids {
            mess "Found $nsolids existing solid(s)\n"
            set nbodies [ic_geo_build_material_from_solids $fam 0 $assem]
            return $nbodies
        } 
    }
    
    set shfam  SHEET
    set bdyfam $fam
    set matfam $fam
    ic_geo_new_family $shfam
    ic_geo_new_family $bdyfam
    ic_geo_new_family $matfam
    set sn -1
    if {$surf != "" && [catch {$projlib get_number_by_name surface $surf} sn]} {
       return -code error $sn
    }
    set nbodies [$projlib build_bodies $bdyfam $multi $newm $sn]
    clear_geom_objects body
    clear_geom_objects material
    if $nbodies {
        define_geom_objects body
        define_geom_objects material
    }
    
    if {$assem && $newm} {
        set i 1
        foreach b [ic_geo_get_objects body $bdyfam] {
            ic_geo_new_family $bdyfam/BODY.$i 0
            ic_geo_set_part body $b $bdyfam/BODY.$i 0
            #ic_geo_set_name body [ic_geo_get_objects body $bdyfam/BODY.$i] $bdyfam/BODY.$i 1 0
            incr i
        }
    }
    
    if {!$assem && $nbodies == "1"} {
        ic_geo_set_name body [ic_geo_get_objects body $bdyfam] $bdyfam 1 0
    }
    ic_geo_update_visibility body $bdyfam 1
    update_geom_visible body p
    
    if {$nbodies == 1} {
        mess "1 solid body created\n" blue
    } else {
        mess "$nbodies solid bodies created\n" blue
    }
    return $nbodies
}

proc ic_geo_build_material_from_solids {{fam ""} {quiet 0} {assembly 0}} {
    global projlib batch_mode
    
    if !$batch_mode { set ta [tdv_active 0] }
    set failed ""; set ignored ""; set added ""; set noshells ""
    foreach n [$projlib build_material_from_solids ""] {
        set name [$projlib get_name body [lindex $n 1]]
        switch -- [lindex $n 0] {
            -1 { lappend ignored $name }
            -2 { lappend failed $name }
            -3 { lappend noshells $name }
            default { lappend added $name }
        }
    }
    foreach type "body material" {
        clear_geom_objects $type
	    define_geom_objects $type
    }
    set new 0
    foreach name $added {
        if {$assembly && $fam != ""} {
            set part "$fam/${name}_MATPOINT"
        } else {
            set part ${name}_MATPOINT
        }
        ic_geo_set_part body $name $part 0
        ic_geo_set_name body "[ic_geo_get_objects body $part]" $part 1 0 
        ic_geo_set_name material [ic_geo_get_body_matlpnt $part] $part.1 0 0
        incr new
    }
    if !$quiet {
        if [llength $failed] {
            mess "Failed to add [llength $failed] material point(s) for solid body parts(s): $failed\n" red
        }
        if [llength $noshells] {
             mess "Ignored [llength $noshells] solid bodies without shells\n"
        }
        if [llength $added] {
            mess "Added [llength $added] material point(s) to solid bodies\n"
            if $new {
                mess "Created $new new solid body part(s)\n"
            }
        } else {
            if {[llength $failed] == 0} {
                mess "All existing solid bodies contain a material point\n"
            }
        }
    }
    ic_gui_update
    if !$batch_mode { tdv_active $ta }
    return [llength $added]
}

proc ic_geo_remove_solids_without_material {{quiet 0}} {
    global projlib
    
    set removed [$projlib build_material_from_solids remove] 
    foreach type "body material" {
        clear_geom_objects $type
	    define_geom_objects $type
	    update_geom_visible $type p
    }
    ic_delete_empty_parts
    set len [llength $removed]
    if !$quiet {
        mess "Removed $len bodies without material point\n"
    }
    return $len
}

proc ic_geo_count_solids_without_material {} {
    global projlib
    
    set count [$projlib build_material_from_solids count] 
    set len [llength $count]
    return $len
}
set dont_record_command(ic_geo_count_solids_without_material) 1

proc ic_geo_solids_without_material_names {{part ""}} {
    global projlib
    
    set bdy ""
    foreach "n" [$projlib build_material_from_solids count] {
        set solid [$projlib get_name body [lindex $n 1]]
        if {$part == ""} {
            lappend bdy $solid
        } else {
            if {$part == $solid} {
               lappend bdy $solid 
            }
        }
    }
    return $bdy
}
set dont_record_command(ic_geo_solids_without_material_names) 1

proc ic_geo_solids_without_material_meshing_params {names args} {
    global projlib

    set ret ""
    foreach n $names {
        set num [$projlib get_number_by_name body $n]
        if {$num < 0} { return "" }
        set ret [eval $projlib set_meshing_params body $num $args]
    }
    return $ret
}

proc ic_set_meshing_params_body {num args} {
    global projlib
    
    set ret ""
    if {[llength $num] > 1} {
        foreach n $num {
            eval ic_set_meshing_params_body $n $args
        }
        return ""
    }
    if {[ic_geo_check_objects_exist body $num] == ""} {
        return ""
    } elseif {![regexp {^[0-9]+$} $num dummy]} {
        set num [$projlib get_number body $num]
    }
    if {$num < 0} { return "" }
    set ret [eval $projlib set_meshing_params body $num $args]
    set obj [$projlib get_object body $num]
    if {$obj != ""} { $obj signal_change 0 }
    if {$args != ""} { $projlib configure -modified 1 }
    return $ret
}

## Create volume from material point name, <b>matlpt</b>.

proc ic_geo_create_volume { matlpt {name ""} {fam LIVE}} {
    global projlib batch_mode

    set used [ic_geo_check_objects_exist body $name]
    if {$used != ""} {
	    mess "Warning: body name $name already in use\n" red
    }
    if {$name == "" || $used != ""} {
	    set name [ic_geo_new_name body $fam.]
    }
    if {[llength $matlpt] > 1} {
	    set nbody [$projlib create_volume $matlpt $name $fam]
    } else {
	    if {$matlpt == ""} { return }
	    if [catch {set mpt [$projlib get_number_by_name material $matlpt]} res] {
	        mess "$res\n" red
	        return ""
	    }
	    set nbody [$projlib create_volume_from_matlpnt $mpt $name $fam]
    }
    set bdy ""
    if {$nbody != ""} {
	    set nobj [define_geom_object body $nbody]
	    update_geom_visible_obj $nobj
	    set mpt [$projlib get_body_matlpnt $nbody]
	    set nn [define_geom_object material $mpt]
	    update_geom_visible_obj $nn
	    set bdy [$projlib get_name body $nbody]
        mess "Material point body: $name created\n" blue
    }
    return $bdy
}

## Updates the current defined bodies in the model, by removing nonexistent ones
## and adding any new ones to the display.

proc ic_geo_reset_bodies {} {
    global projlib batch_mode

    clear_geom_objects body
    foreach b [$projlib list_objects body] {
        set nobj [define_geom_object body $b]
        update_geom_visible_obj $nobj
    }
}

## Create a body from the collection of surfaces, <b>surfs</b>.
## The new body will be given the name, <b>name</b>, in
## the family, <b>fam</b>.

proc ic_geo_create_body { surfs {name ""} {fam ""} {quiet 0}} {
    global projlib batch_mode

    if {$fam == ""} {
        set fam LIVE
    }
    if ![ic_geo_check_family $fam] {
        ic_geo_new_family $fam
    }

    set used [ic_geo_check_objects_exist body $name]
    if {$used != ""} {
        if !$quiet { mess "Warning: body name $name already in use\n" red }
    }
    if {$name == "" || $used != ""} {
        set name [ic_geo_new_name body $fam.]
    }

    set nbody [eval $projlib create_body $name $fam $surfs]
    set bdy ""
    if {$nbody == ""} {
        if !$quiet { mess "No solid body created\n" red }
    } else {
        if !$quiet { mess "Solid body: $name created\n" blue }
        set nobj [define_geom_object body $nbody]
        update_geom_visible_obj $nobj
        set mpt [$projlib get_body_matlpnt $nbody]
        set nn [define_geom_object material $mpt]
        update_geom_visible_obj $nn
        set bdy [$projlib get_name body $nbody]
    }
    return $bdy
}

## Return the material point name associated with the body, <b>bdy</b>.
## Return empty string if no material point name is associated with the body, <b>bdy</b>.

proc ic_geo_get_body_matlpnt {bdy} {
    global projlib

    set num [$projlib get_number_by_name body $bdy]
    set mpt [$projlib get_body_matlpnt $num]
    if {$mpt == ""} { return "" }
    set mptname ""
    if {$mpt != -1} {
        set obj [$projlib get_object material $mpt]
        if {$obj != ""} {
            set mptname [$obj get -name]
        }
    }
    return $mptname
}
set dont_record_command(ic_geo_get_body_matlpnt) 1

## Compute a <i>radius</i> of a b-spline surface
## <table border>
## <tr><td><b>srfs    </b></td><td> list of one or more surfaces   </td></tr>
## <tr><td><b>return  </b></td><td> list of computed surface radii </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The radius is the maximum chord length of the control point rows.
## </ul>
proc ic_geo_srf_radius { srfs } {
#
#   Last Modified ---
#   06/17/02 -- AWM
#	     -- created
#
    global projlib
#
#   This code can handle multiple selections
    set lens ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
 	    return -code error $res
	} else {
	    switch [$projlib get_object_type surface $res] {
		parametric {
		    if [catch {gk_srf_radius $res} len] {
			return -code error $len
		    }
		}
		mesh {
		    return -code error "Unstructure surface in ic_geo_srf_radius\n"
		    #set len [$projlib get_surface_bars_length $res]
		}
	    }
	    lappend lens $len
	}
    }
    return $lens
}
set dont_record_command(ic_geo_srf_radius) 1

## Create an offset surface from a generator curve and axis
## <table border>
## <tr><td><b>family  </b></td><td> family containing surface   </td></tr>
## <tr><td><b>name    </b></td><td> name of created surface     </td></tr>
## <tr><td><b>gen     </b></td><td> generator curve(s)          </td></tr>
## <tr><td><b>base    </b></td><td> axis base point             </td></tr>
## <tr><td><b>zaxis   </b></td><td> axis direction vector       </td></tr>
## <tr><td><b>srtang  </b></td><td> start angle (degrees)	</td></tr>
## <tr><td><b>endang  </b></td><td> end angle  (degrees)	</td></tr>
## <tr><td><b>return  </b></td><td> name of created surface     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## <li> For an annotated example of usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_srf_offset_edge.tcl">ic_geo_cre_srf_offset_edge.tcl</a>.
## </ul>
proc ic_geo_cre_srf_offset_edge { family name crv offset} {
#
#   Last Modified ---
#   05/25/02 -- AWM
#	     -- Created
#
    global projlib
#
    set new_fam [ic_geo_new_family $family]
#
    if [catch {$projlib get_number_by_name curve $crv} crvNum] {
        return -code error "Error retrieving curve $crv\n"
    }
    if [catch {gk_cre_srf_offset_edge $family $name \
    	$crvNum $offset} res] {
        return -code error "Error creating offset: $res"
    } else {
    	set nb [$projlib get_number surface $res]
    	set nb [define_geom_object surface $nb]
    	update_geom_visible_obj $nb
    	lappend srfNames $res
    }
    display_update geo $new_fam
    return $srfNames
}

## Given a body name, <b>bdy</b>, it returns the names of the surfaces,
## curves, and points belonging to the body.
## These are returned in the form of argument pairs where the first name is the entity
## type and the second name is the entity name.

proc ic_geo_body_lower_entities { bdy } {
    global projlib

    set num [$projlib get_number_by_name body $bdy]
    set ents [$projlib get_body_lower_entities $num]
    return $ents
}
set dont_record_command(ic_geo_body_lower_entities) 1

proc ic_geo_body_part_lower_entities { part } {
    global projlib
    
    set ents ""
    foreach bdy [ic_geo_get_objects body $part] {
        set num [$projlib get_number_by_name body $bdy]
        lappend ents [$projlib get_body_lower_entities $num]
    }
    return $ents
}
set dont_record_command(ic_geo_body_part_lower_entities) 1

## Create point and b-spline geometry from a plot3d file.
## <table border>
## <tr><td><b>fit_tol  </b></td><td> approximation tolerance </td></tr>
## <tr><td><b>pnt_fam  </b></td><td> family for point entities </td></tr>
## <tr><td><b>pnt_prefix </b></td><td> prefix for point names  </td></tr>
## <tr><td><b>crv_fam  </b></td><td> family for curve entities </td></tr>
## <tr><td><b>crv_prefix </b></td><td> prefix for curve names  </td></tr>
## <tr><td><b>srf_fam  </b></td><td> family for surface entities </td></tr>
## <tr><td><b>srf_prefix </b></td><td> prefix for surface names  </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> MED must be initialized by loading a tetin file or opening
##      an empty part (see <i>ic_empty_tetin</i>).
## <li> The approximation tolerance is relative.  It will be scaled
##      by the pointset radius to form an absolute tolerance.
##      It has a default value of 0.001.
## <li> This routine is called by <i>ic_geo_cre_geom_input</i>
## </ul>
proc ic_geo_cre_geom_plot3d { \
        in_file		 {fit_tol 0.0001} \
	{pnt_fam PNT} 	 {pnt_prefix pnt} \
	{crv_fam CRV} 	 {crv_prefix crv} \
	{srf_fam SRF} 	 {srf_prefix srf} \
	              } {
#
#   Last Modified ---
#   10/19/02 -- AWM
#	     -- Created
#
    create_empty_tetin_if_needed
    #
    set output_pnt_list ""
    set output_crv_list ""
    set output_srf_list ""
    #
    set nblocks		""
    set block_counts	""
    set block		""
    set cur_block	0
    set n_block_pnts	0
    #
    set total_pnts      0
    set x_coor		""
    set y_coor		""
    set z_coor		""
    #
    if [catch {open $in_file "r"} instream] {
        return -code error "cannot open file $in_file for reading"
    } else {
	foreach line [split [read $instream] \n] {
	    if [regexp {^[#C/c$]}     $line dummy dummy] continue;
	    if [regexp {^[ 	]*$} $line dummy dummy] continue;
            if [regexp {^LEVEL}      $line dummy dummy] {
		regsub {\/} $line {_} pnt_name
		regsub {\/} $line {_} crv_name
		regsub {\/} $line {_} srf_name
		continue;
            }

	    if [regexp {,} $line dummy dummy] {
		regsub -all {,} $line { } line
	    }
            if {[llength $line] == 1 && $nblocks == ""} {
                set nblocks $line
                continue
            }
            set indx 0
            if {[llength $line] > 1 && [llength $block_counts] < $nblocks} {
                while {[llength $line] > $indx} {
                    lappend block [lindex $line $indx]
                    incr indx
                    if {[llength $block] == 3} {
                        lappend block_counts $block
			set n_pnts [expr [lindex $block 0] * [lindex $block 1] * [lindex $block 2]]
                        set block ""
                    }
                }
		if {$n_block_pnts == 0 && [llength $block_counts] > 0} {
		    set tmp [lindex $block_counts 0]
		    set n_block_pnts [expr [lindex $tmp 0] * [lindex $tmp 1] * [lindex $tmp 2]]
		}
                continue
            }

	    if {[llength $line] > 0} {
		foreach x $line {
		    if {[llength $x_coor] < $n_block_pnts} {
			lappend x_coor $x
		    } elseif {[llength $y_coor] < $n_block_pnts} {
			lappend y_coor $x
		    } elseif {[llength $z_coor] < $n_block_pnts} {
			lappend z_coor $x
		    }
		}
	    }
	    if {[llength $z_coor] == $n_block_pnts} {
		set block [lindex $block_counts $cur_block]
		set nppc  [lindex $block 0]
		set ncrv  [lindex $block 1]
		set nlev  [lindex $block 2]
		if {$pnt_prefix != ""} {
		    #
		    #   Create points
		    set pindx 0
		    while {$pindx < $n_block_pnts} {
			set pnt ""
			set name [ic_geo_new_name point $pnt_prefix]
			lappend pnt [lindex $x_coor $pindx]
			lappend pnt [lindex $y_coor $pindx]
			lappend pnt [lindex $z_coor $pindx]
			set pnt_ent [ic_geo_cre_pnt $pnt_fam $name $pnt]
			lappend output_pnt_list $pnt_ent
			incr pindx
		    }
		}
		if {$crv_prefix != ""} {
		    #
		    #   Create curves
		    set pindx 0
		    set cindx 0
		    while {$cindx < $ncrv} {
			set pnt_list ""
			while {[llength $pnt_list] < $nppc} {
			    set pnt ""
			    lappend pnt [lindex $x_coor $pindx]
			    lappend pnt [lindex $y_coor $pindx]
			    lappend pnt [lindex $z_coor $pindx]
			    incr pindx
			    lappend pnt_list $pnt
			}
			set name [ic_geo_new_name curve $crv_prefix]
			if [catch {ic_geo_cre_bsp_crv_n_pnts \
			    $crv_fam $name $pnt_list $fit_tol} ent_name] {
			    return -errorinfo "$ent_name"
			}
			lappend output_crv_list $ent_name
			incr cindx
		    }
		}
		if {$srf_prefix != ""} {
		    #
		    #   Create surfaces
		    set pindx 0
		    set sindx 0
		    while {$sindx < $nlev} {
			set pnt_list ""
			set n_pnt [expr $ncrv*$nppc]
			while {[llength $pnt_list] < $n_pnt} {
			    set pnt ""
			    lappend pnt [lindex $x_coor $pindx]
			    lappend pnt [lindex $y_coor $pindx]
			    lappend pnt [lindex $z_coor $pindx]
			    incr pindx
			    lappend pnt_list $pnt
			}
			set name [ic_geo_new_name surface $srf_prefix]
			if [catch {ic_geo_cre_bsp_srf_by_pnt_array $srf_fam $name \
			    $nppc $ncrv \
			    $pnt_list $fit_tol} ent_name] {
			    return -errorinfo $ent_name
			}
			lappend output_srf_list $ent_name
			incr sindx
		    }
		}
		incr cur_block
		set x_coor ""
		set y_coor ""
		set z_coor ""
		if {$cur_block < [llength $block_counts]} {
		    set tmp [lindex $block_counts $cur_block]
		    set n_block_pnts [expr [lindex $tmp 0] * [lindex $tmp 1] * [lindex $tmp 2]]
		}
 	    }
	}
	close $instream
    }
    set ret_val [list $output_pnt_list $output_crv_list $output_srf_list]
    return $ret_val
}

## Create the deboor points of a bspline surface
## <table border>
## <tr><td><b>srfs  </b></td><td> list of surfaces   </td></tr>
## <tr><td><b>return</b></td><td> Names of created points   </td></tr>
## </table>
proc ic_geo_cre_srf_db_pnts {srfs} {
    global projlib
#
#   History---
#   11/26/02 -- AWM
#	     -- Created
    set nums ""
    foreach obj $srfs {
	if [catch {$projlib get_number_by_name surface $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }

    if [catch {gk_cre_srf_db_pnts $nums} res] {
        return -code error $res
    } else {
	foreach obj $res {
    	    set nb [$projlib get_number point $obj]
    	    set nb [define_geom_object point $nb]
    	    update_geom_visible_obj $nb
	}
        return $res
    }
}

## Create the deboor points of a bspline curve
## <table border>
## <tr><td><b>crvs  </b></td><td> list of curves   </td></tr>
## <tr><td><b>return</b></td><td> Names of created points   </td></tr>
## </table>
proc ic_geo_cre_crv_db_pnts {crvs} {
    global projlib
#
#   History---
#   11/26/02 -- AWM
#	     -- Created
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }

    if [catch {gk_cre_crv_db_pnts $nums} res] {
        return -code error $res
    } else {
	foreach obj $res {
    	    set nb [$projlib get_number point $obj]
    	    set nb [define_geom_object point $nb]
    	    update_geom_visible_obj $nb
	}
        return $res
    }
}

## Read an OFF file (native format for Geomview)
## <table border>
## <tr><td><b>fam      </b></td><td> family for new geometry    </td></tr>
## <tr><td><b>name     </b></td><td> root name for new surfaces </td></tr>
## <tr><td><b>in_file  </b></td><td> input file                 </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Function reads triangulated surfaces from the input file and
##      creates unstructured surfaces in MED.
## <li> Only minimal coverage of the OFF format has been implemented.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_read_off_file.tcl">ic_geo_read_off_file.tcl</a>.
## </ul>
proc ic_geo_read_off_file {fam name in_file} {
#
#   Last Modified ---
#   03/07/03 -- AWM
#	     -- Created
#
    if ![file exists $in_file] {
	return -code error "File $in_file not found\n"
    }

    create_empty_tetin_if_needed
    #
    set new_fam [ic_geo_new_family $fam]
    #
    if [catch {gk_read_off_file $fam $name $in_file} res] {
	return -code error $res
    } else {
	foreach srf $res {
    	    set nb [define_geom_object surface $srf]
    	    update_geom_visible_obj $nb
	}
    }
    return $res
}

## Read and triangulate a list of XYZ points
## <table border>
## <tr><td><b>fam      </b></td><td> family for new geometry    </td></tr>
## <tr><td><b>name     </b></td><td> root name for new surfaces </td></tr>
## <tr><td><b>in_file  </b></td><td> input file                 </td></tr>
## <tr><td><b>off_file </b></td><td> intermediate OFF file      </td></tr>
## <tr><td><b>mode     </b></td><td> fast, tight     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Function reads triangulated surfaces from the off file and
##      creates unstructured surfaces in MED.
## <li> Only minimal coverage of the OFF format has been implemented
## <li> <i>mode</i> can be used to specify fast execution or watertight model.
## </ul>
proc ic_geo_read_xyz_file {fam name in_file off_file {mode ""}} {
#
#   Last Modified ---
#   03/07/03 -- AWM
#	     -- Created
#
    if ![file exists $in_file] {
	return -code error "File $in_file not found\n"
    }
    #
    create_empty_tetin_if_needed
    #
    set new_fam [ic_geo_new_family $fam]
    set cocone_ver cocone
    if {$mode == "fast"}  {set cocone_ver "scocone -m 32000"}
    if {$mode == "tight"} {
        if [catch {ic_run_application_exec . bin tcocone "$in_file $off_file"} res] {
	    return -code error $res
        }
    } else {
        if [catch {ic_run_application_exec . bin $cocone_ver "$in_file"} res] {
	    return -code error $res
        } else {
	    cmd_mv $in_file.jv $off_file
        }
    }
    #
    if [catch {gk_read_off_file $fam $name $off_file} res] {
	return -code error $res
    } else {
	foreach srf $res {
    	    set nb [define_geom_object surface $srf]
    	    update_geom_visible_obj $nb
	}
    }
    return $res
}

## Determine whether one or more curves are circular
## <table border>
## <tr><td><b>crvs    </b></td><td> list of one or more curves   </td></tr>
## <tr><td><b>tol     </b></td><td> approximation tolerance      </td></tr>
## <tr><td><b>return  </b></td><td> list of true/false flags     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The tolerance defaults to 0.001*arc_length
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_crv_is_arc.tcl">ic_geo_crv_is_arc.tcl</a>.
## </ul>
proc ic_geo_crv_is_arc { crvs {tol -1}} {
#
#   Last Modified ---
    global projlib
#
#   This code can handle multiple selections
    set flags ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} res] {
 	    return -code error $res
	} else {
	    switch [$projlib get_object_type curve $res] {
		parametric {
		    if [catch {gk_crv_is_arc $res $tol} flag] {
			return -code error $flag
		    }
		}
		mesh {
		    #
		    #	mesh curves not yet supported
		    set flag 0
		}
	    }
	    lappend flags $flag
	}
    }
    return $flags
}
set dont_record_command(ic_geo_crv_is_arc) 1

## Get keypoints for the current geometry.  Dir is 0, 1, or 2
## If border is non-0 then add some slack

proc ic_geo_get_keypoints {dir border {bb ""}} {
    global tdv_default projlib
    global batch_mode
	
    if {$bb == ""} {
	if $batch_mode {
		set bb [ic_geo_model_bounding_box]
	} else {
		set bb [$tdv_default bbox interesting]
	}
    }
    if {$bb == ""} { return "" }
    set dif [expr [lindex [lindex $bb 1] $dir] - \
		 [lindex [lindex $bb 0] $dir]]
    set tol [expr $dif * 0.001]
    set stats [$projlib list_keypoints $dir $tol]
    if $border {
	set m1 [expr [lindex [lindex $bb 0] $dir] - $dif * $border]
	set m2 [expr [lindex [lindex $bb 1] $dir] + $dif * $border]
	set stats "$m1 $stats $m2"
    }
    return $stats
}
set dont_record_command(ic_geo_get_keypoints) 1

## Reverse the orientation of one or more curves
## <table border>
## <tr><td><b>crvs    </b></td><td> list of one or more curves   </td></tr>
## <tr><td><b>return  </b></td><td> error message on failure </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_reverse_crv.tcl">ic_geo_reverse_crv.tcl</a>.
## </ul>
proc ic_geo_reverse_crv { crvs } {
#
#   Last Modified ---
#   08/27/03 -- AWM
#	     -- created
#
    global projlib
#
#   This code can handle multiple selections
    set lens ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} res] {
 	    return -code error $res
	} else {
	    if [catch {gk_reverse_crv $res} res] {
		return -code error $res
	    }
	}   
    }
}


## Merge one or more curves and associated topology
## <table border>
## <tr><td><b>crvs  </b></td><td> list of curves to be joined</td></tr>
## <tr><td><b>require_topo</b></td><td> fail if topology will not merge </td></tr>
## <tr><td><b>return</b></td><td> Name of created curve      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains curve <i>curve names</i>.
## <li> If require_topo is set, the utility will fail if the associated
##      topology can't be merged.  If require_topo is not set, the utility
##      will create a new curve and preserve the original edges if the
##      associated topology cannot be updated.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_cre_edge_concat.tcl">ic_geo_cre_edge_concat.tcl</a>.
## </ul>
proc ic_geo_cre_edge_concat { crvs {require_topo 0}} {
    global projlib
#
#   History---
#   06/14/02 -- AWM -- Check for wrong number of curves passed
#   01/16/02 -- AWM
#	     -- Renamed to be consistant with Geometry Kernel nomencature;
#		updated and checked regression test.
    if {[llength $crvs] <= 1} {
	return -code error "Must select two or more curves"
    }
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {gk_cre_edge_concat $nums $require_topo} res] {
        return -code error $res
    } else {
        #
        #   define entity in display
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
        update_bsp_consistency
        $projlib configure -modified 1
        return $res
    }
}

## Make a histogram box 
## <table border>
## <tr><td><b>min</b></td><td>min pt of the box </td></tr>
## <tr><td><b>max</b></td><td>max pt of the box </td></tr>
## <tr><td><b>lblList</b></td><td>list of labels </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> Each label in <i>lblList</i> is a list of {lbl_text, lbl_pt, ispt}.  
## <li> If $<i>ispt</i>==1, a point will be drawn as well as the label.
## </ul>
##
proc ic_geo_create_histogram_box { min max lblList } {
    global marker_images 
    global tdv_default
    global batch_mode

#
#   History---
#   09/04/03 -- DBL -- Created
#
    if $batch_mode return

    set geo [tdv_prism_geo -point1 "$min" -point2 "$max"]
    $tdv_default add_image $geo
    lappend imageList $geo

    # create axis labels and min and max labels
    set i 0
    foreach lbl $lblList {
        set l    [lindex $lbl 0]
        set pt   [lindex $lbl 1]
        set ispt [lindex $lbl 2]
        if $ispt {
            set im${i} [tdv_point_im -point $pt -size 3 -color white]
            $tdv_default add_image [set im${i}]
            lappend marker_images [set im${i}]
            lappend imageList [set im${i}]
            incr i
        }
        set im${i} [tdv_text_im -point $pt -text "$l"]
        $tdv_default add_image [set im${i}] 
        lappend marker_images [set im${i}]
        lappend imageList [set im${i}]
        incr i
    }
    return $imageList
}


set dont_record_command(ic_vcalc) 1
set dont_record_command(ic_virtual) 1
## Build topology on a list of surfaces 
## <table border>
## <tr><td><b>srfs       </b></td><td> surface(s)        					  </td></tr>
## <tr><td><b>crvs       </b></td><td> optional curve(s)   					  </td></tr>
## <tr><td><b>tol        </b></td><td> merge tolerance     					  </td></tr>
## <tr><td><b>trim_srfs  </b></td><td> 1 -- trim surfaces; 			      0 otherwise </td></tr>
## <tr><td><b>concat_crvs</b></td><td> 1 -- concatinate edges that join tangentially; 0 otherwise </td></tr>
## <tr><td><b>quiet      </b></td><td> 1 -- suppress chatter; 			      0 otherwise </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> Merge tolerance will be determined from the bounding box
##      of the surfaces.
## <li> The merge tolerance defaults to 0.0001 * (min surface radius)
## </ul>
proc ic_geo_build_topo_on_srfs { srfs {crvs ""} {tol -1} {trim_srfs 0} {concat_crvs 0} {quiet 0}} {
#
#   Last Modified ---
#   09/25/03 -- AWM
#	     -- Created
#
    global projlib
#
    busy 1
    set srfNums ""
    foreach obj $srfs {
	if [catch {$projlib get_number_by_name surface $obj} srfNum] {
	    return -code error "Error retrieving surface $obj\n"
	} else {
	    lappend srfNums $srfNum
	}
    }
    set crvNums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} crvNum] {
	    return -code error "Error retrieving curve $obj\n"
	} else {
	    lappend crvNums $crvNum
	}
    }
    ic_undo_group_begin
    if [llength srfNums] {
    	if [catch {gk_build_topo_on_srfs $srfNums $crvNums $tol $trim_srfs $concat_crvs $quiet} res] {
	    busy 0
            return -code error "Error in build topo: $res"
    	}
    }
    #
    #  This next bit will create a performance issue on large parts.
    #  The alternative is to recode the build_topo_on_surfs function
    #  to return a list of created surfaces
    #
    reinit_geom_objects
    display_update geo 0
    $projlib configure -modified 1
    #
    ic_undo_group_end
    busy 0
    return
}

## Search for contact surfaces.
## <table border>
## <tr><td><b> surfaces </b></td><td> list of surface names </td></tr>
## <tr><td><b> distance </b></td><td> maximum distance </td></tr>
## <tr><td><b> family   </b></td><td> family name for contact surfaces</td></tr>
## <tr><td><b> return   </b></td><td> list of surface pairs </td></tr>
## </table>

proc ic_geo_contact_surfaces {surfaces {distance 0} {family ""} {debug 0}} {
    global projlib

    set nums ""
    foreach obj $surfaces {lappend nums [$projlib get_number_by_name surface $obj]}
    mess "Searching for contact surfaces within a distance of $distance.\n"
    busy 1
    ic_undo_group_begin
    set pairs [contact_surfaces $nums $distance $debug]
    set pairs_names ""
    foreach n $pairs {
        lappend pairs_names [$projlib get_name surface $n]
    }
    if {$family != ""} {
        ic_geo_set_family surface $family names $pairs_names
    }
    if {$debug} {
        clear_geom_objects
        define_geom_objects
        display_update geo 0
        update_fam_window
    }
    ic_undo_group_end
    busy 0
    return $pairs_names
}

## Map parameter data from a tetin file to the current model
## <table border>
## <tr><td><b>tetin </b></td><td> input tetin file </td></tr>
## <tr><td><b>what  </b></td><td> == 0 -  map all possible data	     </td></tr>
## <tr><td><b>-     </b></td><td> bit0 -  map global parameters	     </td></tr>
## <tr><td><b>-     </b></td><td> bit1 -  map family parameters	     </td></tr>
## <tr><td><b>-     </b></td><td> bit2 -  map prescribed points data </td></tr>
## <tr><td><b>-     </b></td><td> bit3 -  map curve data	     </td></tr>
## <tr><td><b>-     </b></td><td> bit4 -  map surface data	     </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_map_tetin_sizes.tcl">ic_geo_map_tetin_sizes.tcl</a>.
## </ul>
proc ic_geo_map_tetin_sizes {tetin {what 0}} {
#
#   Last Modified ---
#   10/17/03 -- AWM
#	     -- Created
#
#
    set res ""
    if [catch {open $tetin "r"} instream] {
        return -code error "Cannot open file $tetin for reading"
    } else {
	    close $instream
	    if [catch {gk_map_tetin_params $tetin $what} $res] {
	        return -code error "$res"
	    }
    }
    
    if [ic_wb2_is_running] {
        ic_wb2_update_parameters input
    }
    clear_geom_objects
    define_geom_objects
    display_update geo 0
    update_fam_window
    return $res
}


## Set (or get) the thickness of surfaces.
## <table border>
## <tr><td><b>surfaces</b></td><td>list of surface names</td></tr>
## <tr><td><b>order</b></td><td>order of thickness approximation</td></tr>
## <tr><td><b>thickness</b></td><td>order * order thickness values</td></tr>
## </table>

proc ic_geo_surface_thickness {surfaces order {thickness ""}} {
    global projlib

    set nums ""
    foreach obj $surfaces {lappend nums [$projlib get_number_by_name surface $obj]}
    busy 1
    ic_undo_group_begin
    set res 0
    if {$thickness == ""} {
        #
        #   get the n * n thicknesses
        #
        if [catch {surface_thickness $nums $order} res] {
            mess "$res\n" red
            return 2
        }
    } else {
        #
        #   set the n * n thicknesses
        #
        if [catch {surface_thickness $nums $order $thickness} res] {
            mess "$res\n" red
            return 3
        }
        clear_geom_objects
        define_geom_objects
    }
    ic_undo_group_end
    busy 0
    return $res
}

## Determine whether a surface is within a volume bounded by one or
## more surface families.
## <table border>
## <tr><td><b>srf   </b></td><td> test surface    		</td></tr>
## <tr><td><b>fams  </b></td><td> list of families     	</td></tr>
## </table>
proc ic_geo_srf_in_srf_fam_set {srf fams} {
    global projlib
#
#   08/10/03 -- AWM
#	     -- Created
#
    set srf_id [$projlib get_number_by_name surface $srf]
    set fam_nums ""
    foreach obj $fams {
	if [catch {ic_geo_lookup_family_pid $obj} fam_id] {
	    return -code error "Error: $fam_id" 
	} else {
	    if [llength $fam_id] {
	        lappend fam_nums $fam_id
	    }
	}
    }
    if [catch {gk_srf_in_srf_fam_set $srf_id $fam_nums} res] {
        return -code error $res
    } 
    return [lindex $res 0]
}

## Close planar holes in a collection of surfaces
## <table border>
## <tr><td><b>srf   </b></td><td> test surface    		</td></tr>
## <tr><td><b>fams  </b></td><td> list of families     	</td></tr>
## </table>
proc ic_geo_cre_srf_over_holes {fam srfs} {
    global projlib
#
#   08/10/03 -- AWM
#	     -- Created
#
    set new_fam [ic_geo_new_family $fam]
    #
    set srf_nums ""
    foreach obj $srfs {
	if [catch {$projlib get_number_by_name surface $obj} srf_id] {
	    return -code error "Error: $srf_id" 
	} else {
	    lappend srf_nums $srf_id
	}
    }
    if [catch {gk_cre_srf_over_holes $fam $srf_nums} res] {
        return -code error $res
    } else { 
	ic_geo_delete_family TEMP_TSF_FAM
	#
	#   define entity in display
	foreach obj $res {
	    set nb [$projlib get_number surface $obj]
	    set nb [define_geom_object surface $nb]
	    update_geom_visible_obj $nb
	    display_update geo $new_fam
	}
    }
    return
}

# ---------------------------------------------------

# Subset stuff

## Check if a geometry subset exists

proc ic_geo_subset_exists {name} {
    global projlib
    if {$projlib == ""} { return 0 }
    return [lmember [$projlib subset_list] $name]
} 
set dont_record_command(ic_geo_subset_exists) 1

## Copy the stuff from one subset to another.

proc ic_geo_subset_copy {oldname newname} {
    global projlib
    if {$projlib == ""} return
    eval $projlib subset_add $newname [ic_geo_subset_get_items $oldname]
} 

## Clear out everything from a subset

proc ic_geo_subset_clear {name} {
    global projlib
    if {$projlib == ""} return    
    $projlib subset_clear $name
} 

## Return an unused geometry subset name with the given prefix
## Note that this gives names unique for both geometry and mesh

proc ic_geo_subset_unused_name {{pref "subset"}} {
    global projlib uns_cur
    
    if {$projlib != ""} {
	foreach ss [$projlib subset_list] { set found($ss) 1 }
    }
    if {$uns_cur != ""} {
	foreach map [$uns_cur list_maps] { set found([$map get -name]) 1 }
    }
    for {set i 0} {[info exists found($pref$i)]} {incr i} {}
    return $pref$i
} 
set dont_record_command(ic_geo_subset_unused_name) 1

## Delete a geometry subset.

proc ic_geo_subset_delete {name} {
    global projlib
    if {$projlib == ""} return
    $projlib subset_delete $name
} 

## Make a geometry subset visible or not.

proc ic_geo_subset_visible {name vis} {
    global projlib
    if {$projlib == ""} return
    $projlib subset_set_visible $name $vis
} 
set dont_record_command(ic_geo_subset_visible) 1

## List all the families that are represented in the named subset.

proc ic_geo_subset_list_families {name} {
    global projlib
    if {$projlib == ""} return
    foreach {t n} [$projlib subset_contents $name] {
        set fam([$projlib get_family $t $n]) 1
    }
    catch {unset fam()}
    return [array names fam]
} 
set dont_record_command(ic_geo_subset_list_families) 1

## List all the geometry subset names that currently exist.

proc ic_geo_subset_list {{pat *}} {
    global projlib
    if {$projlib == ""} return
    set names [$projlib subset_list]
    if {$pat == "*"} { return $names }
    set names2 ""
    foreach n $names {
	if [string match $pat $n] { lappend names2 $n }
    }
    return $names2
}
set dont_record_command(ic_geo_subset_list) 1

## Add items to a geometry subset.  If it doesn't exist it will be created.  The
## <b>items</b> argument is a list of type/name pairs.  The types can be on of
## <tt>point, curve, surface, material, density, loop, body, shell, lump, solid,</tt>
## and the names specify the desired object of that type.

proc ic_geo_subset_add_items {name items} {
    global projlib
    if {$projlib == ""} return
    set checked ""
    foreach "t n" $items { 
        if {[ic_geo_check_objects_exist $t $n] != ""} {
            append checked "$t $n "
        }
    }
    if {$checked != ""} {
        eval $projlib subset_add $name $checked
        ic_geo_subset_handle_bc_changes $checked $name 1
    }
} 

## Remove items from a geometry subset.  The items list is the same as for
## <b>ic_geo_subset_add_items</b>

proc ic_geo_subset_remove_items {name items} {
    global projlib
    if {$projlib == ""} return
    eval $projlib subset_remove $name $items
    ic_geo_subset_handle_bc_changes $items $name 0
} 

## Add or remove bc icons and groups based on addition or removal of objects in subsets

proc ic_geo_subset_handle_bc_changes {items subset add} {
    global projlib

    foreach {it1 it2} $items {
	set fam [ic_geo_get_family $it1 $it2]
	lappend on_fam($fam) "$it1 $it2"
    }
    foreach oldfam [array names on_fam] {
	set newfam [ic_boco_change_subset $oldfam subset $add]
	foreach it $on_fam($oldfam) {
	    set itype [lindex $it 0]
	    set iname [lindex $it 1]
            set num [$projlib get_number_by_name $itype $iname]
	    $projlib set_family $itype $num $newfam
	    ic_boco_add_or_remove_bc_icons $newfam $add $it
	}
    }
}

## Get items in a geometry subset.  This returns a list of type/name pairs.

proc ic_geo_subset_get_items {name} {
    global projlib
    if {$projlib == ""} return
    set ret ""
    foreach {t n} [$projlib subset_contents $name] {
	lappend ret $t [$projlib get_name $t $n]
    }
    return $ret
}
set dont_record_command(ic_geo_subset_get_items) 1

## Return the bounding box of all geometry in a named subset.

proc ic_geo_subset_bbox {name} {
    global projlib
    if {$projlib == ""} return
    return [ic_geo_bounding_box [$projlib subset_contents $name]]
} 
set dont_record_command(ic_geo_subset_bbox) 1

## Add one or more layers to a geom subset.  Args are the same as ic_geo_flood_fill

proc ic_geo_subset_add_layer {name all feat_angle bound_mode} {
    global projlib
    if {$projlib == ""} { return 0 }
    set cur [$projlib subset_contents $name]
    if [lmember $cur surface] { set what surface } else { set what curve }
    set stuff [ic_geo_flood_fill $what $cur $all $feat_angle $bound_mode]
    ic_geo_subset_add_items $name $stuff
    return [expr [llength $stuff] / 2]
} 

## Remove one or more layers from a geom subset

proc ic_geo_subset_remove_layer {name} {
    global projlib
    if {$projlib == ""} { return 0 }
    set cur [$projlib subset_contents $name]
    if [lmember $cur surface] { set what surface } else { set what curve }
    set names ""
    switch $what {
        surface {
            set cnames ""
            foreach "t n" $cur {
                if {$t == "surface"} {
                    lappend names [$projlib get_name surface $n]
                }
                if {$t == "curve"} {
                    lappend cnames [$projlib get_name curve $n]
                }
            }
            foreach n $names {
                foreach crv [ic_geo_get_attached_entities boundary surface $n] {
                    foreach srf [ic_geo_incident curve $crv] {
                        if [lmember $names $srf] {
                            if ![info exists surface($srf)] {
                                set surface($srf) 0
                            } else {
                                incr surface($srf)
                            }
                        }
                    }
                }
            }
            foreach srf [array names surface] {
                lappend count($surface($srf)) $srf
            }
            if ![info exists count] { return 0 }
            set remove ""
            foreach n [lsort -integer [array names count]] {
                foreach nn $count($n) {
                    lappend remove surface $nn
                    foreach cc [ic_geo_get_attached_entities boundary surface $nn] {
                        if {[lsearch $remove $cc] < 0 && [lmember $cnames $cc] && \
                              [llength [ic_geo_check_objects_exist curve $cc]]} {
                            lappend remove curve $cc
                        }
                    }
                }
                ic_geo_subset_remove_items $name $remove
                break
            }
        }
        curve {
            foreach "t n" $cur {
                if {$t == "curve"} {
                    lappend names [$projlib get_name curve $n]
                }
            }
            foreach n $names {
                foreach pt [ic_geo_boundary curve $n 0 0 0] {
                    foreach crv [ic_geo_incident point $pt 0] {
                        if ![lmember $names $crv] continue
                        if ![info exists curve($crv)] {
                            set curve($crv) 0
                        } else {
                            incr curve($crv)
                        }
                    }
                }
            }
            foreach crv [array names curve] {
                lappend count($curve($crv)) $crv
            }
            if ![info exists count] { return 0 }
            set remove ""
            foreach n [lsort -integer [array names count]] {
                foreach nn $count($n) {
                    lappend remove curve $nn
                }
                ic_geo_subset_remove_items $name $remove
                break
            }
        }
    }
    return 1
}

## Move the contents of all subsets to a part (name of subset)

proc ic_geo_subset_names_to_parts {} {
    set subsets ""
    foreach s [ic_geo_subset_list] {
        set items [ic_geo_subset_get_items "$s"]
        foreach "type ents" $items {
            set p [ic_geo_valid_name "$s" 1]
            ic_geo_new_family $p
            ic_geo_set_family $type "$p" names "$ents"
        }
        ic_geo_subset_delete "$s"
        append subsets " $s"
   }
   ic_delete_empty_parts
   return $subsets
}

## Get any curves associated as edges to a surface.
proc ic_geo_get_srf_edges {srf} {
    global projlib
    set edges ""
    if [catch {$projlib get_number_by_name surface $srf} res] {
        return -code error $res
    } else {
        if [catch {gk_get_srf_edges $res} edges] {
            return -code error $res
        }
    }
    return $edges
}
set dont_record_command(ic_geo_get_srf_edges) 1

## Get any curves associated as edges to a vertex.
proc ic_geo_get_vert_edges {pnt} {
    global projlib
    set edges ""
    if [catch {$projlib get_number_by_name point $pnt} res] {
        return -code error $res
    } else {
        if [catch {gk_get_vert_edges $res} edges] {
            return -code error $res
        }
    }
    return $edges
}
set dont_record_command(ic_geo_get_vert_edges) 1

## Calculate node lying on the bisector of the angle formed by nodes
## pnt1, pnt2, pnt3 in distance delta 
## if inverse: calculate the reverse bisector
proc ic_geo_calc_bisector_pnt {pnt1 pnt2 pnt3 len inverse} {
    return [calc_bisector_pnt $pnt1 $pnt2 $pnt3 $len $inverse]
}


## Trim a surface using a simple contour
## <table border>
## <tr><td><b>families</b></td><td> list of 2 family names    </td></tr>
## <tr><td><b>names   </b></td><td> list of 2 surface names   </td></tr>
## <tr><td><b>srf     </b></td><td> surface to trim           </td></tr>
## <tr><td><b>crvs    </b></td><td> list of trim curves      </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface names may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
proc ic_geo_cre_srf_simple_trim {families names srf crvs} {
    global projlib
    set new_fam1 [ic_geo_new_family [lindex $families 0]]
    set new_fam2 [ic_geo_new_family [lindex $families 1]]
    set fam1 [lindex $families 0]  
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {$projlib get_number_by_name surface $srf} srfId] {
		    return -code error "$srfId, $srf"
    }
    #  Make sure that surface has edges 
    if [catch {ic_geo_create_surface_edges $srf} res] {
        return -code error $res
    } 
    if [catch {gk_cre_srf_simple_trim $families $names $srfId $nums} res] {
        return -code error $res
    } else {
	#
	#   define entity in display
	foreach obj $res {
            set nb [$projlib get_number surface $obj]
            set nb [define_geom_object surface $nb]
            update_geom_visible_obj $nb
	}
	display_update geo $new_fam1
	display_update geo $new_fam2
        return $res
    }
}

## Set the simplification level in pixels (surfaces smaller than this size
## will be drawn as a box.  0 disables simplification.  A value of -1 just
## returns the level

proc ic_geo_set_simplification_level {pixels} {
    global geom_simplify_surfaces
    if {$pixels >= 0} {
	set geom_simplify_surfaces $pixels
    }
    return $geom_simplify_surfaces
}

## Check for zero thickness surfaces and assign to new family
## newfam is family name for surfaces with no thickness
## return_unassigned is option to return unassigned surfaces without changing family.  Default is 0 ; off

proc ic_surface_thickness_check {names {newfam ""} {return_unassigned 0}} {
    global projlib batch_mode
    if {$newfam == ""} { set newfam "ZERO_THICKNESS" }

#    foreach obj [geo_lookup surface all ""] {
#	    set name [$obj get -name]
#        set num [$projlib get_number_by_name surface $name]
#        mess [$projlib surface_thickness_check $num $newfam]
#	    update_geom_object $obj
#	    update_geom_visible_obj $obj
#    }
    set unassigned_surfs ""
    set assigned_surfs ""
    foreach name $names {
        set ret ""
        if {[ic_geo_check_objects_exist surface $name] == ""} continue
        set num [$projlib get_number_by_name surface $name]
        set ret [$projlib surface_thickness_check $num $newfam]
        switch $ret {
            mesh { mess "Can't find thickness for $name (mesh surface)\n" red }
            face { mess "Can't find thickness for $name (face surface)\n" red }
            unknown { mess "Unknown surface type\n" red }
            zero { lappend unassigned_surfs $name }
            default { 
                #mess "$name has thickness assigned\n" blue 
            }
        }
    }
    if [llength $unassigned_surfs] {
        mess "Surfaces \"$unassigned_surfs\" do not have thickness assigned.\n"
        if !$return_unassigned {ic_geo_set_part surface $unassigned_surfs $newfam}
    } else { 
        mess "No unassigned surfaces found.\n"
    }
    if {!$batch_mode } { update_fam_window }
    if $return_unassigned {return $unassigned_surfs}
}

## Close up a contour prior to trimming
## <table border>
## <tr><td><b>crvs    </b></td><td> list of curves      </td></tr>
## <tr><td><b>srf     </b></td><td> surface to trim          </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified surface names may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## </ul>
proc ic_geo_close_contour {crvs srf} {
    global projlib
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {$projlib get_number_by_name surface $srf} srfId] {
		    return -code error "$srfId, $srf"
    }
    #  Make sure that surface has edges 
    if [catch {ic_geo_create_surface_edges $srf} res] {
        return -code error $res
    }
    if [catch {gk_close_contour $nums $srfId} res] {
        return -code error $res
    } else {
	#
	#   define entity in display
	foreach obj $res {
            set nb [$projlib get_number surface $obj]
            set nb [define_geom_object surface $nb]
            update_geom_visible_obj $nb
	}
        return $res
    }
}

## Find parameter of pierce point on surface
## <table border>
## <tr><td><b>srf   </b></td><td> name of surface   </td></tr>
## <tr><td><b>pnt   </b></td><td> test point	    </td></tr>
## <tr><td><b>vec   </b></td><td> pierce direction  </td></tr>
## <tr><td><b>return</b></td><td> uv pair	    </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The uv coordinates will be unitized.
## <li> Example usage see
##      <a href="file:../../../icemcfd/samples/ProgrammersGuide/med_test/ic_geo_find_srf_prc_pnt.tcl">ic_geo_find_srf_prc_pnt.tcl</a>.
## </ul>
proc ic_geo_find_srf_prc_pnt { srf pnt vec} {
    global projlib
#
#   Expand any points passed as entity names
    set exp_pnt $pnt
    if {[llength $pnt] == 1} {
#
#	Hopefully a point entity
	if [catch {ic_geo_get_point_location $pnt} coords]  {
	    return -code error "Error parsing point data"
	} else {
	    set exp_pnt $coords
	}
    }
    #
    set srf_num [$projlib get_number_by_name surface $srf]
    #
    if [catch {gk_find_srf_prc_pnt $srf_num $exp_pnt $vec} uv_pnt] {
	return -code error $uv_pnt
    }
    #
    #	Strip off a level of listing
    set uv_pnt [lindex $uv_pnt 0]
    #
    return $uv_pnt
}
##  Return list of dormant points or curves
##
proc ic_geo_get_dormant {type {only_if_visible ""}} {
    global projlib
    if {$only_if_visible == "only_if_visible"} {
	set names [$projlib list_bsp_objects $type names only_if_dormant only_if_visible]
	} else {	
	set names [$projlib list_bsp_objects $type names only_if_dormant]
	}
	return $names
}
set dont_record_command(ic_geo_get_dormant) 1

##  Determine whether an entity is dormant
## Only points and curves can be dormant
proc ic_geo_get_dormant_entity {type name} {
    global projlib
    if {($type != "point") && ($type != "curve")} { return 0 }
    if ![llength $name] return ""
    set b [$projlib get_object_by_name $type $name]
    if ![llength $b] return ""
    set num [$b get -number] 
    if [catch {gk_get_dormant_entity $type $num} dormant] {
	return -code error $dormant
    }
    return $dormant
}
set dont_record_command(ic_geo_get_dormant_entity) 1

proc ic_geo_set_dormant_entity {type names set_to} {
    global projlib
	# names may be list to reduce records
	set n_ok  0
	foreach name $names {
    set num [$projlib get_number_by_name $type $name]
    #
    if [catch {gk_set_dormant_entity $type $num $set_to} dormant] {
	return -code error $dormant
    }
    #update hexa 
    if {$type == "curve" && ([ic_hex_blocking_loaded])} {
	ic_hex_clear_curve_association $name
    }
	# correction: above command make entity not visible, but does not reset bsp visibility
	set bsp [$projlib get_object $type $num]
	# Make visible depending on bsp -dormant (visibility)
	set vis [lindex [$bsp configure -dormant] end]
	$bsp configure -visible $vis 
	incr n_ok
    #
	} 
    return $n_ok
}
proc  ic_set_dormant_pickable {type how {only_parts ""}} {
## synchronized pickable & visible. Used in bbox
	global projlib 
	set bsplist [$projlib list_bsp_objects $type only_if_dormant] 
	if ![llength $bsplist] return
	set check_parts [llength $only_parts]
	foreach part $only_parts {
		set tmp_arr($part) 1
	}
	foreach bsp $bsplist {
		if $check_parts {
			set fam [$bsp get -family]
			if ![info exists tmp_arr($fam)] continue 
		}
		$bsp configure -pickable $how -visible $how	-dormant $how					
    }
	$projlib configure -modified 1
}
## Return list of faceted surfaces

proc ic_get_facets {type list} {
    set subset ""
    foreach ent $list {
        set obj_type [ic_geo_get_object_type $type $ent]
        if {$obj_type == "mesh"} {
            lappend subset $ent
        }
    }
#    mess "Writing facets: $subset  ...\n"
    return $subset
}
set dont_record_command(ic_get_facets) 1

##  return a list of essential curves
##
##  A  curve is "essential" when it bounds two surfaces which 
##  meet at an angle (measured by surface normals) exceeds a threshold
##  angle.  The function identifies the essential curves in the specified 
##  families.
##
## <table border>
## <tr><td><b>angle </b></td><td> threshold angle in degrees </td></tr>
## <tr><td><b>fams  </b></td><td> names of families to search</td></tr>
## </table>
  
proc ic_geo_filter_curves {angle fams} {
    if [catch {gk_filter_curves $angle $fams} crvs] {
	return -code error $crvs
    }
    return $crvs
}
set dont_record_command(ic_geo_filter_curves) 1

## Create a bridge curve between two curves
## <table border>
## <tr><td><b>fam     </b></td><td> family of created curve 	</td></tr>
## <tr><td><b>name    </b></td><td> name of created curve 	</td></tr>
## <tr><td><b>crv1    </b></td><td> curve 1 name                </td></tr>
## <tr><td><b>crv2    </b></td><td> curve 2 name                </td></tr>
## <tr><td><b>end1    </b></td><td> curve 1 end indicator	</td></tr>
## <tr><td><b>end2    </b></td><td> curve 2 end indicator	</td></tr>
## <tr><td><b>mag1    </b></td><td> magnitude of start vector   </td></tr>
## <tr><td><b>mag2    </b></td><td> magnitude of end   vector   </td></tr>
## <tr><td><b>return  </b></td><td> Name of curve vertex	</td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The curve end parameters, end1, end2, take the values
##	<table>
##      <tr><td> point closest to other crv </td><td> 0 </td></tr>
##      <tr><td> start point      	    </td><td> 1 </td></tr>
##      <tr><td>   end point                </td><td> 2 </td></tr>
##      </table>
## <li> 0 &lt; mag1, mag2 &lt; 1
## </ul>
##
proc ic_geo_cre_bridge_crv { fam name crv1 crv2 {end1 0} {end2 0} {mag1 0.3} {mag2 0.3}} {
#
#
    global projlib
    #
    set new_fam [ic_geo_new_family $fam]
    #
    if [catch {$projlib get_number_by_name curve $crv1} crv1Num] {
            return -code error "Error retrieving curve $crv1Num\n"
    }
    if [catch {$projlib get_number_by_name curve $crv2} crv2Num] {
            return -code error "Error retrieving curve $crv2Num\n"
    }
    if [catch {gk_cre_bridge_crv $fam $name $crv1Num $crv2Num $end1 $end2 $mag1 $mag2} res] {
        return -code error "Error: $res"
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
    }
    return $res
}

## Create the projection of a curve onto a plane
## <table border>
## <tr><td><b>fam     </b></td><td> family of created curve 	</td></tr>
## <tr><td><b>name    </b></td><td> name of created curve 	</td></tr>
## <tr><td><b>crv1    </b></td><td> curve name                  </td></tr>
## <tr><td><b>return  </b></td><td> Name of created curve 	</td></tr>
## </table>
##
##
proc ic_geo_cre_pln_crv { fam name crv base nrm} {
#
#
    global projlib
    #
    set new_fam [ic_geo_new_family $fam]
    #
    if [catch {$projlib get_number_by_name curve $crv} crvNum] {
            return -code error "Error retrieving curve $crvNum\n"
    }
    if [catch {gk_cre_pln_crv $fam $name $crvNum $base $nrm} res] {
        return -code error "Error: $res"
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
    }
    return $res
}

##  Find the least square plane through three or more points
##  <table border>
##  <tr><td><b>pnts    </b></td><td> list of 3 or more points    </td></tr>
##  <tr><td><b>return  </b></td><td> {base} {normal} of plane 	</td></tr>
##  </table>
proc ic_geo_pln_n_pnts { pnts } {
#
#
    global projlib
#
#   Expand any points passed as entity names
    set  exp_pnts $pnts
    set  indx 0
    set  srt_pnt  ""
    set  end_pnt  ""
    set  end_indx [llength $pnts]
    incr end_indx -1
    foreach pnt $pnts {
	if {[llength $pnt] == 1} {
#
#           Hopefully a point entity
            if [catch {ic_geo_get_point_location $pnt} coords]  {
		return -code error "Error parsing point data"
	    } else {
	        set exp_pnts [lreplace $exp_pnts $indx $indx $coords]
		if {$indx ==         0} {set srt_pnt $pnt}
		if {$indx == $end_indx} {set end_pnt $pnt}
	    }
	}
        incr indx
    }
    if [catch {gk_pln_n_pnts $exp_pnts } res] {
        return -code error "Error: $res"
    }
    return $res
}

## Returns each entity number (recognized in the batch enterpreter)
## associated with each entity name in <b>ent_names</b>.
## <b>ent_names</b> can be a list but they must all be the same type
## defined by <b>type</b>.  In this case, the return is a list of numbers in the
## same order as the entity names were given.

proc ic_geo_sub_get_numbers_by_names { type ent_names } {
    global projlib
    #
    # jka: tested with ic_uns_subset_get_vertices_on_curves; 03 May 2004
    #
    if ![ic_geo_is_loaded] {
	mess "Error: no valid geometry seems to be loaded\n" red
	return ""
    }

    set ent_nums ""
    foreach ent $ent_names {

	if [catch {$projlib get_number_by_name $type $ent} ent_num] {
	    mess "Error retrieving $type \"$ent\"\n"
	} else {
	    lappend ent_nums $ent_num
	}
    }

    return $ent_nums
}
set dont_record_command(ic_geo_sub_get_numbers_by_names) 1

##  Determine whether an point is marked
##
proc ic_geo_get_pnt_marked {name} {
    global projlib

    set num [$projlib get_number_by_name point $name]
    #
    if [catch {gk_get_pnt_marked $num} marked] {
	return -code error $marked
    }
    #
    #
    return $marked
}
set dont_record_command(ic_geo_get_pnt_marked) 1

##  set the marked flag on a point
proc ic_geo_set_pnt_marked {name set_to} {
    global projlib

    set num [$projlib get_number_by_name point $name]
    #
    if [catch {gk_set_pnt_marked $num $set_to} marked] {
	return -code error $marked
    }
    #
    return $marked
}

##  return a list of all marked points
proc ic_geo_get_all_marked_pnts {} {
    global projlib
    #
    if [catch { gk_get_all_marked_pnts } marked] {
	return -code error $marked
    }
    #
    return $marked
}
set dont_record_command(ic_geo_get_all_marked_pnts) 1

## Embed a curve into a surface
## <table border>
## <tr><td><b>srf     </b></td><td> surface             </td></tr>
## <tr><td><b>crvs    </b></td><td> list of curves      </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> No checks are performed to determine whether the curves are
##      actually on the surface.
## </ul>
proc ic_geo_add_embedded_crv {srf crvs} {
    global projlib
    set nums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {$projlib get_number_by_name surface $srf} srfId] {
		    return -code error "$srfId, $srf"
    }
    if [catch {gk_add_embedded_crv $srfId $nums} res] {
        return -code error $res
    } else {
        return $res
    }
}

## Embed a point into a surface
## <table border>
## <tr><td><b>srf     </b></td><td> surface             </td></tr>
## <tr><td><b>pnts    </b></td><td> list of points      </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> No checks are performed to determine whether the points are
##      actually on the surface.
## </ul>
proc ic_geo_add_embedded_pnt {srf pnts} {
    global projlib
    set nums ""
    foreach obj $pnts {
	if [catch {$projlib get_number_by_name point $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend nums $res
	}
    }
    if [catch {$projlib get_number_by_name surface $srf} srfId] {
		    return -code error "$srfId, $srf"
    }
    if [catch {gk_add_embedded_pnt $srfId $nums} res] {
        return -code error $res
    } else {
        return $res
    }
}

## Check if a curve is on a surface
## <table border>
## <tr><td><b>crv     </b></td><td> curve               </td></tr>
## <tr><td><b>srf     </b></td><td> surface             </td></tr>
## <tr><td><b>tol     </b></td><td> tolerance           </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> If a negative value is passed for the tolerance, the utility
##      will use an internally computed tolerance
## </ul>
proc ic_geo_is_crv_on_srf {crv srf {tol -1}} {
    global projlib

    if [catch {$projlib get_number_by_name curve $crv} crvId] {
		    return -code error "$crvId, $crv"
    }

    if [catch {$projlib get_number_by_name surface $srf} srfId] {
		    return -code error "$srfId, $srf"
    }
    if [catch {gk_is_crv_on_srf $crvId $srfId $tol} res] {
        return -code error $res
    } else {
        return $res
    }
}
set dont_record_command(ic_geo_is_crv_on_srf) 1


## Register a curve (this is uxed by Turbogrid)
## <table border>
## <tr><td><b>crv_name  </b></td><td> name of created curve	    </td></tr>
## </table>

proc ic_geo_register_crv {crv_name new_fam} {
    global projlib
        set nb [$projlib get_number curve $crv_name]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
	$projlib configure -modified 1
}

## Create a new curve by midlining two existing curves
## <table border>
## <tr><td><b>crvs  </b></td><td> list of 2 curves           </td></tr>
## <tr><td><b>tol   </b></td><td> tolerance                  </td></tr>
## <tr><td><b>family</b></td><td> family containing curve    </td></tr>
## <tr><td><b>return</b></td><td> Name of created midline curve      </td></tr>
## </table>
##
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> The list <i>crvs</i> contains 2 curves or curves of first set <i>curve names</i>.
## <li> The list <i>crvs2</i> contains curves of second set <i>curve names</i>.
## </ul>
proc ic_geo_cre_midline_crv {{crvs ""} tol {debug 0} {crvs2 ""} {fam ""}} {
#
#   History---
#   03/02/05 -- Ulrike

    global projlib
#
    set debug 0

    if {$debug} {
        mess "crvs = \"$crvs\"\n" red
        if {$crvs2 != ""} {
            mess "crvs2 = \"$crvs2\"\n" red
        }
    }
    set nums ""
    set side 0
    set side2 0
    foreach obj $crvs {
        lappend nums [$projlib get_number_by_name curve $obj]
    }
    if {$crvs2 != ""} {
        set side [llength $nums]
        if {$debug} {
           mess "$side curves belong to first set.\n" red
        }
        foreach obj $crvs2 {
            lappend nums [$projlib get_number_by_name curve $obj]
	    incr side2
        }
        if {$debug} {
           mess "$side2 curves belong to second set.\n" red
        }
    }

    if {[llength $nums] < 2} {
        return -code error "Please select at leaset two curves"
    }


    set crv1 [lindex $nums 0 ]
    if {$fam == ""} {
	set fam [ $projlib get_family curve $crv1 ]
    }

    ic_mess "Creating midline for family \"$fam\".\n"

    if { $tol == "" } {
        set tol "0.0"
    }

    set resume 0
    if ![ic_undo_suspended] {
        ic_save_model_for_undo
        ic_undo_suspend
        set resume 1
    }

    set ncrvs [llength $crvs]
    set ncrvs2 [llength $crvs2]
    if {$crvs2 != ""} {
	set name1 "concat1"
	set nums ""
	set concat1 [ic_geo_duplicate curve [lindex $crvs 0]]
	for {set i 1} {$i < $ncrvs && $ncrvs > 1} {incr i} {
	   lappend concat1 [ic_geo_duplicate curve [lindex $crvs $i]]
	   vid_concat_crvs $fam $name1.$i $concat1 
	   set concat1 $name1.$i
	}
	lappend nums [$projlib get_number_by_name curve $concat1]

	set name2 "concat2"
	set concat2 [ic_geo_duplicate curve [lindex $crvs2 0]]
	for {set i 1} {$i < $ncrvs2 && $ncrvs2 > 1} {incr i} {
	   lappend concat2 [ic_geo_duplicate curve [lindex $crvs2 $i]]
	   vid_concat_crvs $fam $name2.$i $concat2 
	   set concat2 $name2.$i
	}
	lappend nums [$projlib get_number_by_name curve $concat2]
    }
    if {$debug} {
	   ic_mess "nums = $nums\n" red
    }
	
    set res ""
    if [catch {geoclean_midcurve $fam $nums $tol $debug} res] {
	mess "$res\n" red
	return ""
    }
    if {$ncrvs2>0 && !$debug} {
	if {$ncrvs>1} {
	 ic_delete_geometry curve names "$concat1"
	}
	if {$ncrvs2>1} {
	 ic_delete_geometry curve names "$concat2"
	}
    }

    if $resume {
        ic_undo_resume
    }
    #   define entity in display
#    mess "$res\n" 
    set name [$projlib get_name curve $res]
    set nb [$projlib get_number curve $res]
    set nb [define_geom_object curve $nb]
#    mess "nb = $nb\n"
    update_geom_visible_obj $nb
    display_update geo $fam
    $projlib configure -modified 1
    return $name
}


#================================
set dont_record_command(ic_mess) 1


#--------------------------------------------------
# get/set length units
# if fullname is not zero, returns fullname, else abreviation
# returns one of
#   um  - microns
#   mm  - millimeters
#   cm  - centimeters
#   m   - meters
#   km  - kilometers
#   uin - microinches
#   mil - mils
#   in  - inches
#   ft  - feet
#   mi  - miles
# or empty string if unitless

proc ic_geo_get_units {{fullname 0}} {
    global projlib
    if {$projlib == ""} {return ""}
    set units [$projlib get_length_units]
    if {$units != ""} {
        switch -glob $units {
            nm - nanome* {
                if $fullname {return nanometers}
                return nm
            }
            um - micron* {
                if $fullname {return microns}
                return um
            }
            mm - mill* {
                if $fullname {return millimeters}
                return mm
            }
            cm - ce* {
                if $fullname {return centimeters}
                return cm
            }
            m - me* {
                if $fullname {return meters}
                return m
            }
            km - ki* {
                if $fullname {return kilometers}
                return km
            }
            uin - microi* {
                if $fullname {return microinches}
                return uin
            }
            mil - mils - th* {
                if $fullname {return mils}
                return mil
            }
            in* {
                if $fullname {return inches}
                return in
            }
            ft - fe* {
                if $fullname {return feet}
                return ft
            }
            mi - mile* {
                if $fullname {return miles}
                return mi
            }
        }
    }
    return ""
}
set dont_record_command(ic_geo_get_units) 1

proc ic_geo_set_units {units} {
    global projlib
    if {$projlib != ""} {
        if {$units == "micrometers"} { set units "microns" }
        $projlib set_length_units $units
    }
}

## Finds all the points attached to a list of curves
proc ic_geo_get_points_from_curves { curves } {
     return [ic_geo_get_attached_entities boundary curve $curves]
}
set dont_record_command(ic_geo_get_points_from_curves) 1

## Test routine
##
proc ic_geo_test_cmd {vec pnt crvs srfs} {
    global projlib
    set cnums ""
    foreach obj $crvs {
	if [catch {$projlib get_number_by_name curve $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend cnums $res
	}
    }
    #
    set snums ""
    foreach obj $srfs {
	if [catch {$projlib get_number_by_name surface $obj} res] {
	    return -code error "$res, $obj"
	} else {
	    lappend snums $res
	}
    }
    #
    if [catch {gk_test_cmd $vec $pnt $cnums $snums} res] {
        return -code error $res
    } else {
        return $res
    }
}

## Create a bspline ellipse from center, start point, second point
## <table border>
## <tr><td><b>family  </b></td><td> family containing curve         </td></tr>
## <tr><td><b>name    </b></td><td> name of created curve           </td></tr>
## <tr><td><b>center  </b></td><td> ellipse center                  </td></tr>
## <tr><td><b>srt_pnt </b></td><td> crv point on ellipse major axis </td></tr>
## <tr><td><b>next_pnt</b></td><td> crv point not on major axis     </td></tr>
## <tr><td><b>srtang  </b></td><td> start angle (degrees)           </td></tr>
## <tr><td><b>endang  </b></td><td> end angle (degrees)             </td></tr>
## <tr><td><b>return  </b></td><td> name of created curve           </td></tr>
## </table>
## <b>Notes:</b>
## <ul>
## <li> The specified curve name may be modified to resolve name collisions
## <li> If the function returns with the error status set, the
##      result string will contain an error message.
## <li> If endang < srtang or (endang - srtang) > 360, the angle will
##      be adjusted by adding 360 increments.
## <li> Positions may be specified explicitly or using names of
##      prescribed points
## </ul>
## </ul>
proc ic_geo_cre_crv_ell { family name center srt_pnt next_pnt \
    {srtang 0} {endang 360} } {
    global projlib
    
    create_empty_tetin_if_needed
    
#
    set new_fam [ic_geo_new_family $family]
#
#   Check to see if center was passed as a name
    if {[llength $center] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $center} res]  {
	    return -code error "Error parsing center data: $center"
       	} else {
            set center $res
       	}
    }
#
#   Check to see if sp was passed as a name
    if {[llength $srt_pnt] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $srt_pnt} res]  {
	    return -code error "Error parsing start point data: $srt_pnt"
       	} else {
            set srt_pnt $res
       	}
    }
#
#   Check to see if center was passed as a name
    if {[llength $next_pnt] == 1} {
#
#      	Hopefully a point entity
       	if [catch {ic_geo_get_point_location $next_pnt} res]  {
	    return -code error "Error parsing next_pnt data: $next_pnt"
       	} else {
            set next_pnt $res
       	}
    }
#
    if [catch {gk_cre_crv_ell $family $name $center $srt_pnt \
            $next_pnt $srtang $endang } res] {
        return -code error $res
    } else {
	$projlib configure -modified 1
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	display_update geo $new_fam
        return $res
    }
}


proc ic_geo_root_surface_built {} {
    global projlib

    return [$projlib root_surface_built]
}
set dont_record_command(ic_geo_root_surface_built) 1


## Improve one or more edges
## <table border>
## <tr><td><b>crvs    </b></td><td> list of one or more curves </td></tr>
## </table>
##
proc ic_geo_improve_edge { crvs } {
#
#   Last Modified ---
#   07/17/06 -- AWM -- Created
#
    global projlib
#
    set crv_nums ""
    foreach obj $crvs {
        if [catch {$projlib get_number_by_name curve $obj} res] {
 	    return -code error $res
	} else {
	    lappend crv_nums $res
	}   
    }
    if [catch {gk_improve_edge $crv_nums } area] {
	return -code error $area
    }
    return 
}


## Surface test routine
## <table border>
## <tr><td><b>srfs    </b></td><td> list of one or more surfaces </td></tr>
## </table>
##
proc ic_geo_just_do_it { srfs } {
#
#   Last Modified ---
#   07/17/06 -- AWM -- Created
#
    global projlib
#
    set srf_nums ""
    foreach obj $srfs {
        if [catch {$projlib get_number_by_name surface $obj} res] {
 	    return -code error $res
	} else {
	    lappend srf_nums $res
	}   
    }
    if [catch {gk_just_do_it $srf_nums } area] {
	return -code error $area
    }
    return 
}



proc ic_geo_srf_off_crv { crv offset srf } {
#
#   Last Modified ---
#   07/17/06 -- AWM -- Created
#
    global projlib
#
    set srf_num ""
    if [catch {$projlib get_number_by_name surface $srf} srf_num] {
        return -code error $srf_num
    }

    set crv_num ""
    if [catch {$projlib get_number_by_name curve $crv} crv_num] {
        return -code error $crv_num
    }
    if [catch {gk_srf_off_crv $crv_num $offset $srf_num } res] {
	return -code error $res
    } else {
        set nb [$projlib get_number curve $res]
        set nb [define_geom_object curve $nb]
        update_geom_visible_obj $nb
	#display_update geo $new_fam
        return $res
    }
}

## Get the list of families for prism meshing.

proc ic_geo_get_prism_families {} {
    global projlib
    if {$projlib == ""} {return ""}
    set prism_fams ""
    foreach fam [ic_geo_list_families] {
        set prism [$projlib get_family_param $fam prism]
        if {$prism != "" && $prism != 0} {
            lappend prism_fams $fam
        }
    }
    return $prism_fams
}
set dont_record_command(ic_geo_get_prism_families) 1

## Set the list of families for prism meshing. If excl==1, then
## the any previous prism families are reset.

proc ic_geo_set_prism_families {prism_fams {excl 1}} {
    global projlib
    if {$projlib == ""} return
    if $excl {
        foreach fam [ic_geo_get_prism_families] {
            $projlib set_family_param $fam prism ""
        }
    }
    foreach fam $prism_fams {
        $projlib set_family_param $fam prism 1
    }
}

## Get the prism meshing parameters for a family

proc ic_geo_get_prism_family_params {fam} {
    global projlib
    if {$projlib == ""} {return ""}
    set params ""
    foreach {p n} {height height hratio ratio nlay n_layers prism_height_limit height_limit law law} {
        set v [$projlib get_family_param $fam $p]
        if {$v != ""} {
            lappend params $n $v
        }
    }
    return $params
}
set dont_record_command(ic_geo_get_prism_family_params) 1

## Set the prism meshing parameters for a family

proc ic_geo_set_prism_family_params {fam args} {
    global projlib
    if {$projlib == ""} return
    foreach {p v} $args {
        if {$p == "height"} {
            $projlib set_family_param $fam height $v
        } elseif {$p == "ratio" || $p == "hratio"} {
            $projlib set_family_param $fam hratio $v
        } elseif {$p == "n_layers" || $p == "nlay"} {
            $projlib set_family_param $fam nlay $v
        } elseif {$p == "prism_height_limit" || $p == "height_limit"} {
            $projlib set_family_param $fam prism_height_limit $v
        } elseif {$p == "law"} {
            $projlib set_family_param $fam law $v
        } else {
            mess "Unknown prism part parameter - $p\n" red
        }
    }
}

# ic_geo_objects duplicates some functions.
# Advantage: options combination
# arguments: type [option] ... [option]
#
# type: any valid type; 
# projlib always return TclOK
# some args, like "dormant" are valid only for specific type; will be ignored if invalid;
# 
# arguments and default values: [...]
#
# names number : [names]
#   
# only_if_faceted only_if_param : [faceted and param]
#   
# even_if_dormant only_if_dormant : [not dormant]
#  
# only_check_image : [check both - geometry entity and image (bsp_ object)]
#
# only_if_visible only_if_blanked: [all objects]
#

proc ic_geo_objects {type args} {
	global projlib
	if {[lsearch $args "number"] >= 0} {
		return [eval $projlib list_bsp_objects $type $args]
	}
	# names:
	set names ""
	foreach bsp [eval $projlib list_bsp_objects $type $args] {
		lappend names [$bsp get -name]
	}
	return $names 
}
set dont_record_command(ic_geo_objects) 1

proc ic_geo_shrink_tetinfile {infile outfile} {
    global batch_mode
 
    if {$infile == "" || $outfile == ""} return 
    if ![file exists $infile] return
    
    if !$batch_mode { busy 1 }
    mess "Reading tetin file [file tail $infile]..."
    set x 0; set skip 0
    catch { unset line }
    set f [open $infile r]
    while {![eof $f]} {
        set line($x) [string trim [gets $f]]
        if {[string match "//*" $line($x)] || $line($x) == ""} {
            incr skip
            continue
        }
        incr x
    }
    close $f
    mess "done\n"
    if !$skip {
        mess "Nothing found to remove\n"
        if !$batch_mode { busy 0 }
        return
    }
    mess "Found "
    if !$batch_mode { 
        mess "$skip" blue
    } else {
        mess "$skip"
    }
    mess " line(s) to remove\n"
    set f [open $outfile w]
    for {set n 0} {$n < $x} {incr n} {
      puts $f "$line($n)"
    }
    close $f
    if !$batch_mode { busy 0 }
    mess "Shrinked tetin file [file tail $infile] saved as [file tail $outfile]\n"
}

proc ic_geo_define_geom_objects {{type ""}} {
   clear_geom_objects
   define_geom_objects $type
}

proc ic_geo_convert_units {from to} {

    set scale 0
    set scaleFrom 0
    set scaleTo 0
    set from [string tolower $from]
    set to [string tolower $to]
    switch $from {
        nanometers - nm { set scaleFrom 1.0e-9 }
        microns - micrometers - um { set scaleFrom 0.000001 }
        millimeters - mm { set scaleFrom 0.001 }
        centimeters - cm { set scaleFrom 0.01 }
        meters - m { set scaleFrom 1.0 }
        kilometers - km { set scaleFrom 1000.0 }
        microinches - uin { set scaleFrom 2.54e-8 }
        mil - mils { set scaleFrom 2.54e-5 }
        inches - in { set scaleFrom 0.0254 }
        feet - ft { set scaleFrom 0.3048 }
        miles - mi { set scaleFrom 1609.344 }
        default { mess "Unkown unit \"$from\"\n" red }
    }
    switch $to {
        nanometers - nm { set scaleTo 1.0e9 }
        microns - micrometers - um { set scaleTo 1000000.0 }
        millimeters - mm { set scaleTo 1000.0 }
        centimeters - cm { set scaleTo 100.0 }
        meters - m { set scaleTo 1.0 }
        kilometers - km { set scaleTo 0.001 }
        microinches - uin { set scaleTo 39370078.740157 }
        mil - mils { set scaleTo 39370.078740157 }
        inches - in { set scaleTo 39.370078740157 }
        feet - ft { set scaleTo 3.280839895 }
        miles - mi { set scaleTo 0.000621371192237 }
        default { mess "Unkown unit \"$to\"\n" red }
    }
    set scale [expr $scaleFrom * $scaleTo]
    return $scale
}

proc ic_geo_find_ngh_curves_angle_limit {limit {want_dormant 0}} {
     global projlib
     $projlib find_ngh_curves_angle_limit $limit $want_dormant
}

## Reads a TGLib Size Function Background Grid
## <br>Usage: ic_hex_create_tglib_size_functions -tglib_sfbgrid_file fname -remove_existing -create_callbacks
## <br>Ex: eval ic_hex_create_tglib_size_functions -tglib_sfbgrid_file ./example.sf -remove_existing
## <p>Argument Descriptions:
## <table border>
## <tr><td><b>-tglib_sfbgrid_file</td><td>full path to a tglib size function background grid file</td></tr>
## </table>
## <br>Optional arguments:
## <table border>
## <tr><td><b>-remove_existing</td><td>An existing size function background grid will be remoced.</td></tr>
## <tr><td><b>-create_callbacks</td><td>Callback functions will be set for the usage of the size functions in e.g. the paver.</td></tr>
## </table>
proc ic_geo_create_tglib_sfbgrid {args} {
    global projlib

    if {$args == ""} { return "" }
    set res [eval $projlib create_tglib_sfbgrid $args]
    ic_mess $res
    return $res
}

proc ic_geo_recreate_all_geometry {} {
    global projlib
    
    foreach type "point curve surface material body" {
        foreach item [ic_geo_get_objects $type ""] {     
            set num [$projlib get_number $type $item]
            if {$num < 0} {
                mess "$type $item id out of range\n"
                continue
            }
            set obj [$projlib get_object $type $num]
            if {$obj != ""} {
                update_geom_object $obj
                $obj signal_change 1
            } else {
                define_geom_object $type $num
            }
        }
    }
}
set dont_record_command(ic_geo_recreate_all_geometry) 1
