# that have to do with loading and displaying that data are in
# guibase/projlib.tcl
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc geo_check_available_space {} {
    set need [expr [ic_geo_memory_used] / (1024 * 1024)]
    if {$need < 10} { return 1 } ;# not enough to worry about
    set have [expr [cmd_freemem] / (1024 * 1024)]
    if !$have { return 1 }
    if {$have > $need * 1.5} { return 1 } ;# May need some tuning
    
    set mess "You are running low on free memory.  The currently loaded\
		tetin file uses $need MB and you have only $have MB free\
		(including swap), and\
		this may not be enough.  You can unload the current tetin\
		file, go ahead anyway with the mesher, or hit cancel,\
		exit ICEM CFD, start it up again, and don't load the tetin\
		file."
    switch [tk_dialog .low_mem "Low memory" $mess "" -1 \
		"Unload" "Go ahead" "Cancel"] {
		    0 {
			file_unload tetin
			return 1
		    }
		    1 {
			return 1
		    }
		    2 {
			return 0
		    }
		}
    return 0
}

proc update_project_mode {} {
    global options
    ic_geo_project_mode $options(project_active)
}

proc pick_geom_entity {what} {
    while 1 {
	set names [geo_select $what]
	if {$names == ""} return
	foreach name $names {
	    set stats [ic_geo_stats $what $name]
	    set fam [ic_geo_get_family $what $name]
	    mess "name $name family $fam $stats\n"
	}
    }
}

proc blank_geom_entity {type { how "select" } } {
    switch $how {
	select {
	    while 1 {
		set names [geo_select $type]
		if {$names == ""} return
		ic_geo_object_visible $type $names 0
	    }
	}
	all {
	    ic_geo_update_visibility $type "*skip*" 0
	}
	unblank_all {
	    ic_geo_update_visibility $type "*skip*" 1
	}
	reverse {
	    ic_geo_update_visibility $type "*skip*" -1
	}
	unblank_adjacent - unblank_boundary {
	    if {$how == "unblank_adjacent"} {
		set which_one incident
	    } else {
		set which_one boundary
	    }
	    switch "$how $type" {
		"unblank_adjacent surface" { set ntype curve } 
		"unblank_adjacent curve"   { set ntype point }
		"unblank_boundary curve"   { set ntype surface }
		"unblank_boundary point"   { set ntype curve }
		default return
	    }
	    
	    set names [geo_select $ntype]
	    foreach name $names {
#		mess "$name\n"
		set inc [ic_geo_$which_one $ntype $name]
#		mess "$inc\n"
		ic_geo_object_visible $type $inc 1
	    }
	}
	unblank_by_name {
	    set names [question_box .unblank_by_name Name "Enter the name(s) of the $type.\n" "" ]
	    ic_geo_object_visible $type $names 1
	}
	default {
	    error "unhandled case blank_geom_entity $type $how"
	}
    }
}

proc restrict_geom_entity {what} {
    while 1 {
	set names [geo_select $what]
	if {$names == ""} return
	ic_geo_update_visibility $what "*skip*" 0
	ic_geo_object_visible $what $names 1
    }
}

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

proc old__geo_change_famboco {{nfb ""}} {
    global file_name
    
    if {$file_name(tetin) == ""} { error "No tetin file loaded" }
    
    set dir [file dirname $file_name(tetin)]
    if {$nfb == ""} {
	set fb [ic_boco_get_for_tetin]
	if ![string match */* $fb] { set fb $dir/$fb }
	
	set nfb [file_selection -message "Select the family_boco file\
		name\n to use for this tetin file.  Note\
		that\npicking a new file name here will not\
		load\nthe data but just change the place\
		that\nit will be saved to." -new_ok 1 -default $fb]
	if {$nfb == ""} return
    }
    if {[file dirname $nfb] == $dir} { set nfb [file tail $nfb] }
    ic_boco_set_for_tetin $nfb
    mess "Set family_boco file to $nfb\n"
}

proc boco_edit_sol_show_fam {fam on} {
    global fam_visible
    if {!$on || $fam_visible($fam)} {
	ic_show_geo_selected family [list $fam] $on
	ic_uns_show_selected family [list $fam] $on white 0
    }
}

proc geo_famboco_edit {} {
    global solution famboco_info famboco_data
    global fam_visible file_name solution
    
    if ![ic_boco_is_loaded] {
	    if {[info exists file_name(family_boco)] && [file_is_family_boco $file_name(family_boco)]} {
            mess "Loading family boco file $file_name(family_boco)\n"
		    ic_boco_load $file_name(family_boco)
	        set file_name(family_boco_loaded) 1
	        set solution(solver) [ic_boco_solver]
        } else {
		    file_loadfamboco ""
	    }
    }
    if {$solution(solver) == "" || $solution(solver) == "Generic"} {
	    set solution(solver) Generic
	    mess "Warning: current solver is undefined (generic). Perhaps you'd like to select some other.\n" red
	    solution_select
	    if {$solution(solver) == "" || $solution(solver) == "Generic"} {
	        mess "Error: current solver is still undefined (generic)\n" red
	        return 0
	    }
    }
    set sol $solution(solver)
    catch { unset famboco_data }
    foreach f [array names fam_visible] {
        set famboco_data($f) [ic_boco_get $f]
    }
    if ![famboco_edit $sol boco_edit_sol_show_fam] { return 0 }
    foreach f [array names famboco_data] {
        fam_check_new $f
        ic_boco_set $f $famboco_data($f)
    }
    return 1
}

proc geo_famboco_load {} {
    global file_name family_boco
    
    if {$family_boco != ""} {
	set def $family_boco
    } elseif {$file_name(mesh_dir) == ""} {
	set def [pwd]
    } else {
	set def $file_name(mesh_dir)/family_boco
    }
    set file [med_file_select family_boco 0 "" "to load"]
    if {$file != ""} {
	set family_boco $file
	famboco_load $file
    }
}

proc geo_famboco_save {} {
    global file_name family_boco
    
    if {$family_boco != ""} {
	set def $family_boco
    } elseif {$file_name(mesh_dir) == ""} {
	set def [pwd]
    } else {
	set def $file_name(mesh_dir)/family_boco
    }
    set file [med_file_select family_boco 1 "" "to save"]
    if {$file != ""} {
	set family_boco $file
	famboco_save $file
    }
}

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

proc geo_params_edit_model {} {
    global show_refsize show_maxsize

    set show_refsize 0
    set show_maxsize 0
    set w .mparam_model

    set buts [list [list Apply   "geo_params_edit_model_apply"] \
		  dismiss]
    set d [form_init .mparam_model "Model mesh params" "" $buts]
    if {$d != ""} {
	form_colwidth $d 0 2 M
# reference size
	set ln 1
	form_label $d.orefl "Reference size" "$ln 0 -cols 2"
	form_entry $d.oref mparams(gref) float "$ln 2"
	form_checkbutton $d.orefshow "" show_refsize "$ln 3"
	form_label $d.orefshowl "display" "$ln 4 -cols 2"

# max size
	incr ln
	form_label $d.omaxl "Maximum size" "$ln 0 -cols 2"
	form_entry $d.omax mparams(gmax) float "$ln 2"
	form_checkbutton $d.omaxshow "" show_maxsize "$ln 3"
	form_label $d.omaxshowl "display" "$ln 4 -cols 2"

# natural size
	incr ln
	form_checkbutton $d.onatl "Natural size" mparams(gnat) "$ln 0 -cols 2"
	form_entry $d.onat mparams(gnatval) float "$ln 2 -cols 2" mparams(gnat)

# natural size refinement
	incr ln
	form_label $d.onrfl "Refinement" "$ln 1" mparams(gnat)
	form_entry $d.onrf mparams(gnatrefval) float "$ln 2 -cols 2" \
	    {mparams(gnat) }
	incr ln
# n cells in gap
	form_label $d.cgapl "Cells in gap" "$ln 1" mparams(gnat)
	form_entry $d.cgap mparams(gcgap) float "$ln 2 -cols 2" mparams(gnat)

# ignore wall thickness
	incr ln
	form_checkbutton $d.igw "Ignore wall thickness" mparams(igwall) \
	    "$ln 1 -cols -" mparams(gnat)

# edge criterion
	incr ln
	form_label $d.edgecl "Edge criterion" "$ln 0 -cols 2"
	form_entry $d.edgec mparams(gedgec) float "$ln 2 -cols 2"

# triangulation tolerance
	incr ln
	form_label $d.ttoll "Tri tolerance " "$ln 0 -cols 2"
	form_entry $d.ttol mparams(gttol) float "$ln 2"
	form_checkbutton $d.trel "" mparams(gtrel) "$ln 3"
	form_label $d.trell "unitless" "$ln 4 -cols 2"
	
	
	incr ln
	form_checkbutton $d.fastt "Fast transition" mparams(gfast) \
	    "$ln 0 -cols -"

	
# thin cuts.
	incr ln
	form_button $d.thinc "Define thin cuts" geo_thincuts \
	    "$ln 0 -cols - -fill x"
	incr ln
	form_button $d.per "Define periodicity" geo_periodic \
	    "$ln 0 -cols - -fill x"
	
	$d.orefshow configure -command "geo_params_update_show_size ref"
	$d.omaxshow configure -command "geo_params_update_show_size max"
	bind $d.oref <Return> "geo_params_edit_model_apply; geo_params_update_show_size ref"
	bind $d.omax <Return> "geo_params_edit_model_apply; geo_params_update_show_size max"

	form_finish bot
    }
    geo_params_get_model
    
    form_wait .mparam_model
    
    set show_refsize 0
    set show_maxsize 0
    geo_params_update_show_size ref
    geo_params_update_show_size max
}

proc geo_params_get_model {} {
    global mparams options
    
    set pnames {emax ehgt erat hrat ewid emin edev}
    
    if $options(show_factor) {
	set fact [ic_geo_get_ref_size]
    } else {
	set fact 1.0
    }
    
    set params [ic_get_meshing_params global 0]
    foreach {n v} $params {
	switch $n {
	    gnat {
		if {$v > 0} {
		    set mparams(gnat) 1
		    set mparams(gnatval) [expr $v / $fact]
		} else {
		    set mparams(gnat) 0
		    set mparams(gnatval) 1.0
		}
	    }
	    gnatref {
		if {$v > 0} {
		    set mparams(gnatrefval) $v
		} else {
		    set mparams(gnatrefval) 10.0
		}
	    }
	    gmax {
		set mparams($n) [expr $v / $fact]
	    }
	    default {
		set mparams($n) $v
	    }
	}
    }
}

proc geo_params_update_show_size {what} {
    global show_${what}size
    ic_geo_params_update_show_size $what [set show_${what}size]
}

proc geo_params_edit_model_apply {} {
    global mparams options
    
    if $mparams(gref) {
	set fact $mparams(gref)
    } else {
	set fact 1.0
    }
    set ofact [ic_geo_get_ref_size]
    foreach p {gnatval gmax} {
	set $p [expr $mparams($p) * $fact]
    }
    foreach p {gref gnat gnatrefval gedgec gcgap gttol gtrel gfast igwall} {
	set $p $mparams($p)
    }
    if $gnat { set gn $gnatval } else { set gn 0 }

    if 0 {
	foreach type {surface curve point material density loop} {
	    foreach name [ic_geo_get_objects $type] {
		geo_scale_meshing_params $type $name $ofact $fact
	    }
	}
    } else { ; # --JKA
	if {$fact != $ofact} {
	    ic_geo_scale_meshing_params all $fact
	}
    }
    
    # Update the global params
    ic_set_meshing_params global 0 gref $gref \
	gmax $gmax gnat $gn gnatref $gnatrefval gedgec $gedgec gcgap $gcgap \
	gttol $gttol gtrel $gtrel gfast $gfast igwall $igwall    
}

# this should not be used==>too many commands in replay; see above proc --JKA
proc old__geo_scale_meshing_params {type name ofact nfact} {
    set params [ic_get_meshing_params $type $name]
    set nparams ""
    foreach {n v} $params {
	if {($n != "erat") && ($n != "hrat") && ($n != "ewid")} {
	    set v [expr $v / $ofact * $nfact]
	}
	lappend nparams $n $v
    }
    eval ic_set_meshing_params $type \"$name\" $nparams
}

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

proc geo_params_number_on_curve { num {curves} } { 
    if {$curves == "" } {return "no curves selected\n"} 
    foreach  {type curve} $curves { 
	set length [ic_geo_crv_length $curve] 
	if {$num != "0"} {set size [expr $length / $num]} else {set size 0} 
	ic_set_meshing_params curve $curve emax $size 
    } 
} 

proc geo_params_changed { changed } { 
    global mparams 
    if {$changed == 1} { 
	switch $mparams(emax_optl) { 
            "Max size" { 
		if {$mparams(sel) != ""}  { 
                    geo_params_get_vals curve $mparams(sel) 
                    set mparams(emax_opt) $mparams(emax) 
		} 
            } 
            "Number of elements" { 
		if {($mparams(sel) != "")}  { 
                    set i 0 
                    set num2 0 
                    set last [expr [llength $mparams(sel)] / 2 ] 
                    foreach {type name} $mparams(sel) { 
			set emax [lindex [ic_get_meshing_params curve $name] 1] 
			set length [ic_geo_crv_length $name] 
			if {$emax == 0} {set num 0 } else {set num [expr $length / $emax]}
			set num [expr round($num) ] 
			if {($i > 0) && ($num2 != $num)}  { 
                            set mparams(emax_opt) "" 
                            return 
			} 
			set num2 $num 
			incr i
			if {$i == $last} {set mparams(emax_opt) $num} 
                    } 
		} 
            } 
            default { 
		mess "does not support $mparams(emax_optl) \n" 
            } 
	} 
	
    } 
} 

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

proc geo_entity_has_params {type} {
    switch $type {
	point - material { return 0 }
	default { return 1 }
    }
}

proc geo_params_edit {how} {
    global mparams geo_command_mode options mainwindow_menubar
    global geo_params_blank_done geometry_mode 
    
    # this is until the calling button can be greyed out base on type
    if ![geo_entity_has_params $how] {
	mess "Cannot set meshing parameters by $how\n" red
	return
    }
    
    if ![info exists geo_params_blank_done] { set geo_params_blank_done 0 }
    
    # This should be changed - you should be able to edit parameters for
    # all geometry types at once...
    # ...if you specify "entity" as how, you should now be able...--JKA
    if {$how == "family"} {
	set type family
    } elseif {$how != ""} {
	set type $how
    } elseif $mainwindow_menubar {
	set type $geometry_mode
    } else {
	set type $geo_command_mode
    }
    
    if {"y" == [string index $type end]} {
	set typeplur [string replace $type end end "ies"]
    } else { set typeplur ${type}s }
    
    set typen [string totitle $type]
    
    set w .mparam_$type
    set buts [list [list Apply   "geo_params_edit_apply $type" mparams(active)] \
		   [list Select  "geo_params_edit_select $type" mparams(active)] \
		   [list Dismiss "geo_params_edit_done $type $w" mparams(active)]]
    
    set mparams(active) 1
    
    set d [form_init $w "$typen mesh params" "" $buts]
    if {$d != ""} {
	if {$how == "family"} {
	    form_label $d.curfl "Families selected" {0 1}
	    form_entry $d.curf mparams(selfam) string {0 2}
	    $d.curf configure -state disabled
	}
	if {$how == "curve"} { 
	    #set mparams(emax_opt) $mparams(emax)
	    set emax_opts {{"Max size"} {"Number of elements"}}
	    form_optionmenu $d.emaxm mparams(emax_optl) $emax_opts {20 1} "" \
		    "geo_params_changed 1"
	    form_entry $d.emax mparams(emax_opt) float_blank {20 2}	   
	} elseif {$how != "loop"} {
	    form_label $d.emaxl "Size" {20 1}
	    form_entry $d.emax mparams(emax) float_blank {20 2}
	}
	if {$how != "loop"} {
	    form_label $d.eratl "Ratio" {22 1}
	    form_entry $d.erat mparams(erat) float_blank {22 2}

            if {$how != "density"} {
	        form_label $d.ehgtl "Height" {21 1}
	        form_label $d.eminl "Minimum size" {23 1}
	        form_label $d.edevl "Maximum deviation" {24 1}

                form_entry $d.ehgt mparams(ehgt) float_blank {21 2}
	        form_entry $d.emin mparams(emin) float_blank {23 2}
	        form_entry $d.edev mparams(edev) float_blank {24 2}
            }

            form_label $d.ewidl "Width" {25 1}
	    form_entry $d.ewid mparams(ewid) float_blank {25 2}
	} else {
	    form_label $d.etypl "Element type" {21 0}
            set mparams(etyp) -1
            set mparams(etyp2) NONE
            form_optionmenu $d.etyp mparams(etyp2) \
                {{"QUAD_4"} {"QUAD_4 (one TRI_3)"} \
                 {"QUAD_4 (several TRI_3)"} {"TRI_3"} \
                 {"TRI_3 (STL-like)"} {"STRUCTURED"} {"NONE"}} \
                 "21 1" "" "geo_params_etyp2_to_etyp"
	    form_label $d.ehgtl "Height" {22 0}
	    form_label $d.eratl "Ratio" {23 0}
	    form_label $d.ewidl "Width" {24 0}
	    form_entry $d.ehgt mparams(ehgt) float_blank {22 1}
	    form_entry $d.erat mparams(erat) float_blank {23 1}
	    form_entry $d.ewid mparams(ewid) float_blank {24 1}
	}
	if {$type == "family"} {
	    form_checkbutton $d.intern "Internal Wall" \
		mparams(internal_wall) {26 1 -cols 2}
	
	    form_checkbutton $d.split "Split Wall" \
		mparams(split_wall) {27 1 -cols 2}
	
	    form_checkbutton $d.noadapt "Fix for Adaptation" \
		mparams(mom3d_no_adapt) {28 1 -cols 2}
	}
	
	form_checkbutton $d.blanks "Blank $typeplur already done" \
	    geo_params_blank_done {30 1 -cols 2}
	$d.blanks configure -command "geo_params_do_blank_done $type"
	if {$how != "loop"} {
	    form_checkbutton $d.showfactor "Show size params using ref size" \
	        options(show_factor) {31 1 -cols 2}
	    $d.showfactor configure -command "geo_params_update_sizes $type"
	}
	form_finish bot
    }
    geo_params_do_blank_done $type
    if {$how == "loop"} { geo_params_etyp2_to_etyp }
    geo_params_edit_select $type
}

proc geo_params_do_blank_done {type} {
    global geo_params_blank_done geo_command_mode
    global mainwindow_menubar geometry_mode
    
    if !$geo_params_blank_done {
	if {$type == "family"} {
	    update_geom_visible all v
	} else {
	    ic_geo_params_blank_done $type 1  
	}
	return
    }
    set types $type
    if {$type == "family" || $type == "entity"} {
	set types "surface curve point material loop density"
    }
    foreach tt $types {
	set bf [ic_geo_params_blank_done $tt]
	set n [llength $bf]
	if $n {
	    mess "Blanked $n ${tt}s that already have params\n"
	    if {$type != "family" && $type != "entity"} {
		foreach b $bf {
		    set famfound([ic_geo_get_family $tt $b]) 1
		}
		mess "In families: [lsort [array names famfound]]\n"
	    }
	}
    }
}

proc geo_params_edit_done {type w} {
    global mparams geom
    
    ic_reset_geo_selected
    set mparams(sel) ""
    if {$type == "family"} {
	update_geom_visible all v
    } else {
	ic_geo_params_blank_done $type 1
    }
    form_done $w
}

proc geo_params_edit_select {type} {
    global mparams geom
    
    ic_reset_geo_selected
    if {$type == "family"} {
	set mparams(active) 0
	set selfam [select_families 0 1 0]
	set mparams(active) 1
	set mparams(selfam) $selfam
	if {$selfam == ""} return
	set sel $selfam
	set selobjs [join [ic_geo_get_objects all $selfam]]
    } else {
	set selfam ""
	set sel ""
	set mparams(active) 0
	if {$type == "entity"} {
	    foreach n [geo_select $type] {
		lappend sel [lindex $n 0] [lindex $n 1]
            }
	} else {
	    foreach n [geo_select $type] {
		lappend sel $type $n
	    }
	}
	set selobjs $sel
	set mparams(active) 1
    }
    if {$sel == ""} return
    
    geo_params_get_vals $type $sel
    set mparams(sel) $sel
    if {$type == "curve"}  { geo_params_changed 1 }
    if {$type == "loop"}   { geo_params_etyp_to_etyp2 }
    ic_show_geo_selected mixed $selobjs 1
}

proc geo_params_update_sizes {type} {
    global mparams
    
    switch $type {
	family { set sel $mparams(selfam) }
	allfamilies { set sel [ic_geo_list_families] }
	allparts { 
	    # This is for performance improvement
	    set mparams(vfams) [ic_list_volume_families]
            # Only parts with geom objects
	    set sel [ic_geo_list_parts "" 1] 
	}
	default { set sel $mparams(sel) }
    }
    geo_params_get_vals $type $sel
}

proc geo_params_edit_apply {type} {
    global options mparams
    
    # Let's make sure the user has finished ...
    if [geo_select force_done] {
	after 1 "geo_params_edit_apply $type"
	return
    }
    if $options(show_factor) {
	set fact [ic_geo_get_ref_size]
    } else {
	set fact 1.0
    }

    set params ""
    if { $type == "curve" && $mparams(emax_opt) != ""} {
	if {($mparams(emax_optl) == "Max size")  } {
	    set mparams(emax) $mparams(emax_opt)
	    lappend params emax [expr $mparams(emax) * $fact]
	} elseif {$mparams(emax_optl) == "Number of elements"} {
	    geo_params_number_on_curve $mparams(emax_opt) $mparams(sel)
	} else {
	    mess "Does not support $mparams(emax_optl)\n"
	}
    } elseif {$mparams(emax) != ""} {
	lappend params emax [expr $mparams(emax) * $fact]
    }
    
    foreach p {ehgt emin edev} {
	if {$mparams($p) != ""} {
	    lappend params $p [expr $mparams($p) * $fact]
	}
    }
    foreach p {erat hrat ewid nlay etyp} {
	if {$mparams($p) != ""} {
	    lappend params $p $mparams($p)
	}
    }
    if {($type == "family") || ($type == "part")} {
	
	# no_adapt and internal_wall are family meshing parameters
	
	foreach p {internal_wall split_wall} {
	    if {$mparams($p) != ""} {
		#if {[lindex $mparams($p) 0] == 1} {
		    lappend params $p $mparams($p)
		#}
	    }
	}
	foreach fam $mparams(selfam) {
	    if $options(apply_all) {
		eval ic_geo_set_family_params $fam $params
	    } elseif $options(remove_all) {
		eval ic_geo_set_family_params $fam reset_crv_inf $params
	    } else {
		eval ic_geo_set_family_params $fam no_crv_inf $params
	    }
	}
    } else {
	set opt [ic_select_geometry_option]
	switch [lindex $opt 0] {
	    all {
		mess "ic_set_meshing_params ${type}_all \"\" $params\n" blue
		eval ic_set_meshing_params ${type}_all \"\" $params
	    }
	    families {
		foreach fam [lindex $opt 1] {
		    eval ic_set_meshing_params ${type}_fam \
			    $fam $params
		}
	    }
	    default {
		foreach {t n} $mparams(sel) {
		    eval ic_set_meshing_params $t $n $params
		}
	    }
	}
    }
    geo_params_do_blank_done $type
}

proc geo_params_get_vals {type sel} {
    global mparams options

    # Size information is stored in tetin
    if ![ic_geo_is_loaded] {
	ic_empty_tetin
    }

    if $options(show_factor) {
	set fact [ic_geo_get_ref_size]
    } else {
	set fact 1.0
    }
     
    set pnames {emax ehgt erat hrat ewid nlay emin edev etyp}
    set fpnames {internal_wall split_wall}
    
    switch $type {	
	family {
	    foreach p $fpnames { set mparams($p) "undef" }
	    set ents ""
	    foreach fam $sel {
		if {$fam == "ORFN"} continue
		foreach n $fpnames {		
		    set v [ic_geo_get_family_param $fam $n]
		    if {($mparams($n) == "undef") || $mparams($n) == $v} {
			set mparams($n) $v
		    } else {
			set mparams($n) 0
		    }
		}
		set ents [ic_geo_get_objects all $fam]
	    }
	    geo_params_get_vals all $ents
	}
	allfamilies {
	    foreach fam $sel {
		if {$fam == "ORFN"} continue

		foreach n $fpnames {				    
		    set mparams($fam\_$n) [ic_geo_get_family_param $fam $n]
		}

		set ents [ic_geo_get_objects all $fam]
		geo_params_get_vals all $ents

		foreach n $pnames {				    
		    set mparams($fam\_$n) $mparams($n)
		}
	    }
	}
	allparts {
	    foreach part $sel {
		if {$part == "ORFN"} continue
		
		# This is not really correct
		set vfams $mparams(vfams)
		
		foreach fam [ic_geo_list_families_in_part $part] {
		    foreach n $fpnames {
			set p [ic_geo_get_family_param $fam $n]
			if {$p != ""} {
			    set mparams(${part}_$n) $p
			}
		    }
		    
		    set ents [ic_geo_get_objects all $fam]
		    set get_vals 0
		    if {$ents != ""} {
		        if {[lsearch $vfams $fam] >= 0} {
		            foreach {n v} $ents {
		                if {$n == "curve" || $n == "surface"} {
		                    set get_vals 1
		                    break
		                }
		            }
		        } else {
		            set get_vals 1
		        }
		    }
		    if {$ents != "" && $get_vals} {
			geo_params_get_vals all $ents		    
			foreach n $pnames {				
			    set mparams(${part}_$n) $mparams($n)
			}
		    }
		}
	    }
	}
	default {

	    set pnames {emax ehgt erat hrat ewid nlay emin edev etyp emethod}
	    set inf_params {ehgt erat hrat ewid nlay}
	    foreach p $pnames {	set mparams($p) "undef" }

	    foreach {type name} [join $sel] {		   
		set params [ic_get_meshing_params $type $name]
		foreach {n v} $params {
		    if {$type == "curve" && $options(apply_all) == 0 && [lsearch $inf_params $n] > -1} {
			continue
		    }
		    switch $n {
			erat - hrat - ewid - nlay - etyp - emethod { }
			default {
			    set v [format %g [expr $v / $fact]]
			}
		    }
		    if {($mparams($n) == "undef") || ($mparams($n) == $v)} {
			set mparams($n) $v
		    } else {
			set mparams($n) ""
		    }
		}
	    }
	}
    }

    foreach p $pnames {
	if {(![info exists mparams($p)]) || $mparams($p) == "undef"} { 
	    set mparams($p) "" 
	}
    }
    if { $type == "curve" } {
	set mparams(emax_opt) $mparams(emax) 
    }
}

proc geo_params_etyp2_to_etyp {{back 0}} {
    global mparams
    set convert {"QUAD_4" 2 "QUAD_4 (one TRI_3)" 4 \
                 "QUAD_4 (several TRI_3)" 3 \
                 "TRI_3" 0 "TRI_3 (STL-like)" 1 \
                 "STRUCTURED" 5 "NONE" -1}
    foreach {n v} $convert {
        if {$back == 0 && $n == "$mparams(etyp2)"} {set mparams(etyp) $v}
        if {$back == 1 && $v == "$mparams(etyp)"} {set mparams(etyp2) $n}
    }
}

proc geo_params_etyp_to_etyp2 {} {
    global mparams
    set convert {2 "QUAD_4" 4 "QUAD_4 (one TRI_3)" \
                 3 "QUAD_4 (several TRI_3)" \
                 0 "TRI_3" 1 "TRI_3 (STL-like)" \
                 5 "STRUCTURED" -1 "NONE" -1}
    foreach {n v} $convert {
        if {$mparams(etyp) == $n} {
            set mparams(etyp2) $v
            form_optionmenu_update .mparam_loop.main.etyp mparams(etyp2)
            break
        }
    }
}

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

proc geo_create_add {var what} {
    set stuff [geo_select $what]
    foreach s $stuff {
	uplevel 1 lappend $var [list [list $what $s]]
    }
}

proc geo_create_clear {var what} {
    uplevel 1 set $var \"\"
}

proc geo_create_surface_boundary {} {
    ic_undo_group_begin
    foreach name [geo_select curve] {
	ic_geo_create_surface_edges $name
    }
    ic_undo_group_end
}

proc geo_create_surface_segment {} {
    set objs [geo_select surface]
    if {$objs == ""} return

    ic_show_geo_selected surface $objs 1
    ic_undo_group_begin
    switch [ic_geo_get_object_type surface $objs] {
	mesh  { geo_create_surface_segment_fac $objs }
	param {	geo_create_surface_segment_param $objs }
	default { error "Only select all facet or all parametric curves" }
    }
    ic_undo_group_end
    ic_show_geo_selected surface $objs 0
}

proc geo_create_surface_segment_param {objs} {
    if { [llength $objs] > 1} {
	mess "Only one parametric surface per trim operation\n" red
	mess "Trimming [lindex $objs 0]\n" red
    }
    set crvs [geo_select curve]
    if {$crvs == ""} return
    ic_undo_group_begin
    ic_geo_trim_surface [lindex $objs 0] $crvs
    ic_undo_group_end
}

proc geo_create_surface_segment_fac { objs } {
    global geo_create last_geometry_created
    
    set d [form_init .geo_create_surface_segment "Segment surface"]
    if {$d != ""} {
	#form_radiobutton $d.id "By id" geo_create(surface,segment,how) id {0 0 -cols 2}
	form_radiobutton $d.angle "By angle" geo_create(surface,segment,how) \
	    angle {5 0 -cols 2}
	form_radiobutton $d.curve "By curve" geo_create(surface,segment,how) \
	    curve {10 0 -cols 2}
	form_radiobutton $d.plane "By plane" geo_create(surface,segment,how) \
	    plane {15 0 -cols 2}
	form_radiobutton $d.conn "By connectivity" geo_create(surface,segment,how) \
	    connect {20 0 -cols -}
	form_colwidth $d 0 4 M
	
	set act {{geo_create(surface,segment,how) angle}}
	#form_label $d.angle_l "Angle" {6 1} $act
	form_entry $d.angle_e geo_create(surface,segment,angle) float \
	    {5 2 -cols 2} $act
	form_label $d.mintl "Min triangles" {7 0 -cols 2} $act
	form_entry $d.mint geo_create(surface,segment,mintri) int \
	    {7 2 -cols 2} $act
	
	set act {{geo_create(surface,segment,how) curve}}
	#form_label $d.curve_sl "Curves" {12 1} $act
	form_entry $d.curve_se geo_create(surface,segment,curves) string \
	    {10 2 -cols 2} $act
	form_button $d.curve_ss Select "geo_create_add \
		geo_create(surface,segment,curves) curve" {12 2} $act
	form_button $d.curve_sc Clear "geo_create_clear \
		geo_create(surface,segment,curves) curve" {12 3} $act
	form_label $d.mint2l "Min triangles" {13 0 -cols 2} $act
	form_entry $d.mint2 geo_create(surface,segment,mintri) int \
	    {13 2 -cols 2} $act
	
	set act {{geo_create(surface,segment,how) plane}}
	form_label $d.plane_pl "Point" {16 1} $act
	form_label $d.plane_nl "Normal" {17 1} $act
	form_entry $d.plane_p geo_create(surface,segment,plane_p) string \
	    {16 2} $act
	form_entry $d.plane_n geo_create(surface,segment,plane_n) string \
	    {17 2 -cols 2} $act
	$d.plane_p configure -width 6
	form_button $d.plane_ps "Select" \
	    "disp_get_location geo_create(surface,segment,plane_p) 1 \"the point\" 1" \
	    {16 3}
	
	form_checkbutton $d.keep "Keep old surface" \
	    geo_create(surface,segment,keep) {30 0 -cols -}
	
	form_finish bot
    }
    if [form_wait .geo_create_surface_segment] {
	busy 1
	set curvenames ""
	foreach c $geo_create(surface,segment,curves) {
	    lappend curvenames [lindex $c 1]
	}
	ic_undo_group_begin
	set nobjs ""
	foreach name $objs {
	    set new [ic_geo_create_surface_segment $name \
			 $geo_create(surface,segment,how) \
			 angle $geo_create(surface,segment,angle) \
			 mintri $geo_create(surface,segment,mintri) \
			 plane_p $geo_create(surface,segment,plane_p) \
			 plane_n $geo_create(surface,segment,plane_n) \
			 keep_old $geo_create(surface,segment,keep) \
			 curves $curvenames]
	    set nobjs [concat $nobjs $new]
	}
	ic_undo_group_end
	mess "Segmentation yields [llength $nobjs] new surfaces\n"
	set last_geometry_created(surface) $nobjs
	mess "Done.\n"
	busy 0
    }
}

proc geo_create_surface_from_ncurves {} {

    set curves [geo_select curve]
    if {$curves == ""} break

    ic_undo_group_begin
    ic_geo_gap_repair curves $curves do 3
    ic_geo_reset_data_structures
    ic_undo_group_end
}

proc geo_create_surface_from_curves {} {
    global geo_create env
    
    set buts {{Create {geo_create_surface_from_curves_doit}} dismiss}
    set d [form_init .geo_create_surface_from_curves "Create surface" "" \
	       $buts]
    if {$d != ""} {
	form_label $d.faml "Family" "0 0"
	form_entry $d.fame geo_create(surface,from_curves,fam) string "0 1"
	form_button $d.fams "Select" \
	    "select_family_set_var geo_create(surface,from_curves,fam)" "0 2"
	form_label $d.namel "Name" "1 0"
	form_entry $d.namee geo_create(surface,from_curves,name) string "1 1"
	form_label $d.tol  "Tolerance" "2 0"
	form_entry $d.tole geo_create(surface,from_curves,tol) string "2 1"
	
	form_finish bot
    }
    
    form_wait .geo_create_surface_from_curves
    
}

proc geo_cre_srf_from_contour {} {
    global geo_create env
    
    set buts {{Create {geo_cre_srf_from_contour_doit}} dismiss}
    set d [form_init .geo_cre_srf_from_contour "Create surface" "" \
	       $buts]
    if {$d != ""} {
	form_label $d.faml "Family" "0 0"
	form_entry $d.fame geo_create(surface,from_contour,fam) string "0 1"
	form_button $d.fams "Select" \
	    "select_family_set_var geo_create(surface,from_contour,fam)" "0 2"
	form_label $d.namel "Name" "1 0"
	form_entry $d.namee geo_create(surface,from_contour,name) string "1 1"
	form_label $d.tol  "Tolerance" "2 0"
	form_entry $d.tole geo_create(surface,from_contour,tol) string "2 1"
	
	form_finish bot
    }
    
    form_wait .geo_cre_srf_from_contour
    
}

proc geo_create_curve_isocurve_doit {} {
    global geo_create
    set fam  $geo_create(curve,isocurve,fam) 
    set name $geo_create(curve,isocurve,name) 
    set par  $geo_create(curve,isocurve,par)
    set sel  $geo_create(curve,isocurve,sel)

    set objs [select_geometry surface 1]
    if {$objs == ""} return

    set srf  [object_name_of_image $objs ]

    ic_undo_group_begin
    if [catch {ic_geo_cre_crv_iso_crv $fam $name $srf $par $sel} res] {
	mess "$res\n" red
	ic_undo_group_end
    } else {
	ic_undo_group_end
	update_fam_window
    }
}

set geo_create(curve,isocurve,sel) 0
set geo_create(curve,isocurve,par) 0.5
set geo_create(curve,isocurve,name) "isocurve"
set geo_create(curve,isocurve,fam) "CRVS"

proc geo_create_curve_isocurve {} {
    global geo_create env
    set geo_create(curve,isocurve,sel) 0
    set geo_create(curve,isocurve,sel) 0
    set buts {{Create {geo_create_curve_isocurve_doit}} dismiss}
    set d [form_init .geo_create_curve_isocurve "Create isocurve segments" "" \
	       $buts]
    if {$d != ""} {
	form_label $d.faml "Family" "0 0"
	form_entry $d.fame geo_create(curve,isocurve,fam) string "0 1"
	form_button $d.fams "Select" \
	    "select_family_set_var geo_create(curve,isocurve,fam)" "0 2"
	form_label $d.namel "Name" "1 0"
	form_entry $d.namee geo_create(curve,isocurve,name) string "1 1"
	form_label $d.par  "Parameter" "2 0"
	form_entry $d.pare geo_create(curve,isocurve,par) string "2 1"
	form_radiobutton $d.selu "U-Constant"  \
	    geo_create(curve,isocurve,sel) 0 {3 1 -cols 2}
	form_radiobutton $d.selv "V-Constant"  \
	    geo_create(curve,isocurve,sel) 1 {4 1 -cols 2}
	
	form_finish bot
    }
    
    form_wait .geo_create_curve_isocurve
    
}



proc geo_create_surface_points {{npts 4}} {
    global geo_create env
    
    set geo_create(surface,points,npts) $npts
    
    set buts {{Create {geo_create_surface_points_doit}} dismiss}
    set d [form_init .geo_create_surface_points_$npts "Create surface" "" \
	       $buts]
    if {$d != ""} {
	set bm $env(MED_ROOT)/lib/med_gui/create_surf_points_$npts.xbm
	form_label_bitmap $d.crbitmap @$bm {0 0 -cols -}

	set mall $d.all.m
	form_menubutton_regular $d.all "Select All" $mall "0 2"
	menu $mall
	$mall add command -label Screen -command \
	    "geo_select_surface_points_all med_get_local_location $npts"
	$mall add command -label "Pre  point" -command \
	    "geo_select_surface_points_all {geo_select_loc point} $npts"
	$mall add command -label "Surface node" -command \
	    "geo_select_surface_points_all {geo_select_loc surface_node} $npts"

	for {set i 1} {$i <= $npts} {incr i} {
	    form_label $d.lab$i "Point $i" "$i 0"
	    form_entry $d.ent$i geo_create(surface,points,pt$i) string "$i 1"
	    if 0 {
		form_button $d.sel$i "Select" \
		    "med_get_local_location geo_create(surface,points,pt$i)" \
		    "$i 2"
	    }
	    set m $d.sel$i.m
	    form_menubutton_regular $d.sel$i "Select" $m "$i 2"
	    menu $m
	    $m add command -label Screen -command \
		"med_get_local_location geo_create(surface,points,pt$i)"
	    $m add command -label "Pre  point" -command \
		"geo_select_loc point geo_create(surface,points,pt$i)"
	    $m add command -label "Surface node" -command \
		"geo_select_loc surface_node geo_create(surface,points,pt$i)"
	    
	}
	form_label $d.faml "Family" "$i 0"
	form_entry $d.fame geo_create(surface,points,fam) string "$i 1"
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(surface,points,fam)" "$i 2"
	incr i
	form_label $d.namel "Name" "$i 0"
	form_entry $d.namee geo_create(surface,points,name) string "$i 1"
	
	form_finish bot
    }
    
    for {set i 1} {$i <= $npts} {incr i} {
#use previous geo_create(surface,points,pt$i) 
	trace variable geo_create(surface,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(surface,points,pt$i); list"
	update_screen_label_point "Pt $i" geo_create(surface,points,pt$i)
    }
    
    form_wait .geo_create_surface_points_$npts
    
    for {set i 1} {$i <= $npts} {incr i} {
	trace vdelete geo_create(surface,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(surface,points,pt$i); list"
	update_screen_label_point "" geo_create(surface,points,pt$i)
    }
}

proc geo_select_surface_points_all {method npts} {
    set i 1
    while {$i <= $npts} {
	eval $method geo_create(surface,points,pt$i)
	incr i
    }
}

proc geo_create_surface_points_box {} {
    ic_undo_group_begin
    geo_create_surface_points 8
    ic_undo_group_end
}

proc geo_create_surface_points_doit {} {
    global geo_create

    ic_undo_group_begin
    
    switch $geo_create(surface,points,npts) {
	4 {
	    set faces { {1 2 3 4} }
	}
	8 {
	    set faces {
		{1 2 3 4} {5 6 7 8}
		{1 5 8 4} {2 6 7 3} 
		{1 2 6 5} {4 3 7 8}
	    }
	}
    }
    if [ic_geo_new_family $geo_create(surface,points,fam)] {
	update_fam_window
    }
    foreach f $faces {
	foreach i {0 1 2 3} {
	    set p$i $geo_create(surface,points,pt[lindex $f $i])
	}
	set snum [ic_geo_create_unstruct_surface_from_points \
		      $geo_create(surface,points,name) \
		      $geo_create(surface,points,fam) \
		      [list $p0 $p1 $p2 $p3]]
    }
    ic_undo_group_end
}

proc geo_create_curve_segment {} {
    global geo_create
    
    set objs [geo_select curve]
    if {$objs == ""} return

    ic_undo_group_begin
    
    ic_show_geo_selected curve $objs 1
    switch [ic_geo_get_object_type curve $objs] {
	mesh  { geo_create_curve_segment_mesh $objs }
	param { geo_create_curve_segment_param $objs }
	default { error "Only select all facet or all parametric curves" }
    }
    ic_show_geo_selected curve $objs 0
}

proc geo_create_curve_segment_param { objs } {
    global geo_create last_geometry_created

    set d [form_init .geo_create_curve_segment_param "Split curve at points"]
    if {$d != ""} {
	form_label $d.lab "Point(s)" {1 0}
	form_entry $d.ent geo_create(curve,segment,point) string {1 1}
	form_menubutton_regular $d.sel "Select" $d.sel.m {1 2}
	menu $d.sel.m
	$d.sel.m add command -label Screen -command \
		"geo_select_points screen geo_create(curve,segment,point)"
	$d.sel.m add command -label "Pre point" -command \
		"geo_select_points prescribed geo_create(curve,segment,point)"
	form_finish bot
    }

    if [form_wait .geo_create_curve_segment_param] {
	set nobjs ""
	ic_undo_group_begin
	foreach i $objs {
	    if { $geo_create(curve,segment,point) == "" } { 
		ic_undo_group_end; return 
	    }
	    if [catch {ic_geo_split_curve $i \
			   $geo_create(curve,segment,point) } new_curves ] {
		mess "Error:  $new_curves\n" red
	    } else {
		if {$new_curves != ""} {
		    eval lappend nobjs $new_curves
		}
	    }
	}
	if {$nobjs != ""} {
	    set last_geometry_created(curve) $nobjs
	}	
	ic_undo_group_end
    }
}

proc geo_select_points {type var} {
    upvar \#0 $var lvar
    
    set lvar ""
    switch $type {
	screen {
	    while 1 {
		set pt [med_get_local_location]
		if {$pt != ""} {
		    lappend lvar $pt
		} else {
		    break		    
		}
	    }
	} 
	prescribed {
	    set lvar [geo_select point]
	}
	default {
	    mess "geo_select_points: $type not supported\n" red
	}
    }
}

proc geo_create_curve_segment_mesh { objs } {
    global geo_create last_geometry_created
    
    set d [form_init .geo_create_curve_segment "Segment curve"]
    if {$d != ""} {
	form_radiobutton $d.angle "By angle" geo_create(curve,segment,how) \
		angle {5 0 -cols 2}
        form_radiobutton $d.point "By point" geo_create(curve,segment,how) \
		point {10 0 -cols 2}
	form_radiobutton $d.plane "By plane" geo_create(curve,segment,how) \
		plane {15 0 -cols 2}
	form_radiobutton $d.conn "By connectivity" geo_create(curve,segment,how) \
		connect {20 0 -cols -}
	form_colwidth $d 0 4 M
	
	set act {{geo_create(curve,segment,how) angle}}
	form_entry $d.angle_e geo_create(curve,segment,angle) float \
	    {5 2 -cols 2} $act
	form_label $d.mintl "Min edges" {7 0 -cols 2} $act
	form_entry $d.mint geo_create(curve,segment,minedge) int \
	    {7 2 -cols 2} $act
	
	set act {{geo_create(curve,segment,how) point}}
	form_label $d.ptl "Point" {11 1} $act
	form_entry $d.pte geo_create(curve,segment,point) string \
		{11 2} $act
	form_button $d.pts "Select" \
		"med_get_local_location geo_create(curve,segment,point)" \
		{11 3} $act

	set act {{geo_create(curve,segment,how) plane}}
	form_label $d.plane_pl "Point" {16 1} $act
	form_label $d.plane_nl "Normal" {17 1} $act
	form_entry $d.plane_p geo_create(curve,segment,plane_p) string \
	    {16 2} $act
	form_entry $d.plane_n geo_create(curve,segment,plane_n) string \
	    {17 2 -cols 2} $act
	$d.plane_p configure -width 6
	form_button $d.plane_ps "Select" \
	    "med_get_local_location geo_create(curve,segment,plane_p)" \
	    {16 3} $act
	
	form_checkbutton $d.keep "Keep old curve" \
	    geo_create(curve,segment,keep) {30 0 -cols -}
	
	form_finish bot
    }
    if [form_wait .geo_create_curve_segment] {
	busy 1
	ic_undo_group_begin
	set nobjs ""
	foreach bsp $objs {
	    switch $geo_create(curve,segment,how) {
		angle {
		    set new [ic_geo_create_curve_segment $bsp angle \
				 angle $geo_create(curve,segment,angle) \
				 minedge $geo_create(curve,segment,minedge) \
				 keep_old $geo_create(curve,segment,keep)]
		}
		point {
		    set new [ic_geo_create_curve_segment $bsp point \
			    point [ic_coords_into_global \
			    $geo_create(curve,segment,point)] \
			    keep_old $geo_create(curve,segment,keep)]
		}
		plane {
		    set new [ic_geo_create_curve_segment $bsp plane \
				 plane_p [ic_coords_into_global $geo_create(curve,segment,plane_p)] \
				 plane_n $geo_create(curve,segment,plane_n) \
				 keep_old $geo_create(curve,segment,keep)]
		}
		connect {
		    set new [ic_geo_create_curve_segment $bsp connect \
				 keep_old $geo_create(curve,segment,keep)]
		}
	    }
	    set nobjs [concat $nobjs $new]
	}
	mess "Segmentation yields [llength $new] curves\n"
	set last_geometry_created(curve) $new
	mess "Done.\n"
	ic_undo_group_end
	busy 0
    }
}

proc geo_create_curve_extract {} {
    global geo_create
    
    set objs [geo_select surface]
    if {$objs == ""} return

    set param_surfs ""
    set mesh_surfs ""
    foreach i $objs {
    	set type [ ic_geo_get_object_type surface $i] 
	if { $type == "mesh" } {
		lappend mesh_surfs $i
	} elseif { $type == "param" } {
		lappend param_surfs $i
	} else {
		mess "unhandled surface type $type, skipping\n"
	}
    }
    
    set append 0
    if { $mesh_surfs != "" } {
	geo_create_curve_extract_facet $mesh_surfs 0
	set append 1
    }
    if { $param_surfs != "" } {
	geo_create_curve_extract_param $param_surfs $append
    }
}
	
proc geo_create_curve_extract_param {objs append} {
    global geo_create last_geometry_created

    ic_undo_group_begin    
    set new_crvs [ic_geo_create_surface_edges $objs]
    ic_undo_group_end
    if $append {
	eval lappend last_geometry_created(curve) $new_crvs
    } else {
	set last_geometry_created(curve) $new_crvs
    }
    mess "Extraction yields [llength $new_crvs] curves\n"
}

proc geo_create_curve_extract_facet {objs append} {
    global geo_create last_geometry_created
    
    set d [form_init .geo_create_curve_extract "Extract curve"]
    if {$d != ""} {
	form_radiobutton $d.bound0 "Only interior" \
	    geo_create(curve,extract,bound) 0 {0 0 -cols 2}
	form_radiobutton $d.bound1 "Only boundary" \
	    geo_create(curve,extract,bound) 1 {1 0 -cols 2}
	form_radiobutton $d.bound2 "Both" \
	    geo_create(curve,extract,bound) 2 {2 0 -cols 2}
	form_label $d.angl "Angle" {5 0}
	form_entry $d.ang geo_create(curve,extract,angle) float {5 1}
	form_label $d.mintl "Min segments" {6 0}
	form_entry $d.mint geo_create(curve,extract,minedge) int {6 1}
	
	form_finish bot
    }
    if [form_wait .geo_create_curve_extract] {
	ic_undo_group_begin
	set nobjs ""
	foreach obj $objs {
	    set new [ic_geo_extract_curves $obj \
			 $geo_create(curve,extract,bound) \
			 $geo_create(curve,extract,angle) \
			 $geo_create(curve,extract,minedge)]
	    set nobjs [concat $nobjs $new]
	}
	mess "Extraction yields [llength $nobjs] curves\n"
	set last_geometry_created(curve) $nobjs
	ic_undo_group_end
    }
}

# This is the new version from Matt Middleton

proc geo_create_curve_intersect {} {
    set names ""
    foreach i {1 2} {
	set srfs [geo_select surface 0 "surfaces for set $i"]
	if {$srfs == ""} break
	lappend names $srfs
    }

    ic_undo_group_begin
    if {[llength $names] == 1} {
	# use the family of the first surface
	set names [lindex $names 0]
	set fam [ic_geo_get_family surface [lindex $names 0]]
	if [catch {ic_geo_intersect_surfaces $fam $names} res] {
	    mess "Error: $res\n" red
	} elseif {$res != ""} {
	    mess "Intersection curve $res created.\n"
	}
    } elseif {[llength $names] > 1} {
	if [catch {ic_geo_intersect_surfs_by_groups $names} res] {
	    mess "Error: $res\n" red
	} elseif {$res != ""} {
	    mess "[llength $res] intersection curves created\n"
	}
    }
    ic_undo_group_end
}

proc geo_create_curve_points {} {
    global geo_create
    
    set buts {{Create {geo_create_curve_points_doit}} dismiss}
    set d [form_init .geo_create_curve_points "Create curve" "" \
	       $buts]
    if {$d != ""} {
	form_radiobutton $d.how_2 "Create between 2 points" \
	    geo_create(curve,points,how) 2pts {0 0 -cols 3}
	form_radiobutton $d.how_m "Create between multiple points" \
	    geo_create(curve,points,how) mult {1 0 -cols 3}
	
	set act {{geo_create(curve,points,how) 2pts}}
	form_label $d.lab1 "Point 1" {5 0} $act
	form_entry $d.ent1 geo_create(curve,points,pt1) string {5 1} $act
	form_menubutton_regular $d.sel1 "Select" $d.sel1.m {5 2} $act
	
	form_label $d.lab2 "Point 2" {6 0} $act
	form_entry $d.ent2 geo_create(curve,points,pt2) string {6 1} $act
	form_menubutton_regular $d.sel2 "Select" $d.sel2.m {6 2} $act
	
	foreach n {1 2} {
	    set m $d.sel$n.m
	    menu $m
	    $m add command -label Screen -command \
		"med_get_local_location geo_create(curve,points,pt$n)"
	    $m add command -label "Pre  point" -command \
		"geo_select_loc point geo_create(curve,points,pt$n)"
	    $m add command -label "Surface node" -command \
		"geo_select_loc surface_node geo_create(curve,points,pt$n)"
	}
	form_label $d.faml "Family" {10 0}
	form_entry $d.fame geo_create(curve,points,fam) string {10 1}
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(curve,points,fam)" {10 2}
	form_label $d.namel "Name" {11 0}
	form_entry $d.namee geo_create(curve,points,name) string {11 1}
	
	form_finish bot
    }
    
    for {set i 1} {$i <= 2} {incr i} {
	set geo_create(curve,points,pt$i) "0 0 0"
	trace variable geo_create(curve,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(curve,points,pt$i); list"
	if {$geo_create(curve,points,how) == "2pts"} {
	    update_screen_label_point "Pt $i" geo_create(curve,points,pt$i)
	}
    }
    set cmd {
	if {$geo_create(curve,points,how) == "2pts"} {
	    update_screen_label_point_activate_all 1
	} else {
	    update_screen_label_point_activate_all 0
	} ; list }
    trace variable geo_create(curve,points,how) w $cmd
    
    form_wait .geo_create_curve_points
    
    for {set i 1} {$i <= 2} {incr i} {
	trace vdelete geo_create(curve,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(curve,points,pt$i); list"
	update_screen_label_point "" geo_create(curve,points,pt$i)
    }
    trace vdelete geo_create(curve,points,how) w $cmd
}

proc geo_create_curve_points_doit {} {
    global geo_create

    if {$geo_create(curve,points,fam) == ""} {
        mess "Needs family name to create curve.\n" red
        return
    }    
    if [ic_geo_new_family $geo_create(curve,points,fam)] { update_fam_window }

    ic_undo_group_begin
    switch $geo_create(curve,points,how) {
	2pts {
	    ic_geo_create_unstruct_curve_from_points \
		$geo_create(curve,points,name) \
		$geo_create(curve,points,fam) \
		[list $geo_create(curve,points,pt1) \
		     $geo_create(curve,points,pt2)]
	}
	mult {
	    while 1 {
		set cnum ""
		set i 1
		set pts ""
		while 1 {
		    set pt [disp_get_location "" 1 "the point" 1]
		    if {$pt == ""} break
		    set geo_create(curve,points,ipt$i) $pt
		    lappend pts $pt
		    update_screen_label_point "Pt $i" \
			geo_create(curve,points,ipt$i)
		    incr i
		}
		if {$i == 1} break
		for {set j 1} {$j < $i} {incr j} {
		    update_screen_label_point "" geo_create(curve,points,ipt$j)
		    unset geo_create(curve,points,ipt$j)
		}
		ic_geo_create_unstruct_curve_from_points \
		    $geo_create(curve,points,name) \
		    $geo_create(curve,points,fam) \
		    $pts
	    }
	}
    }
    ic_undo_group_end
}

proc geo_create_point_extract {} {
    global geo_create
    
    set objs [geo_select curve]
    if {$objs == ""} return
    
    ic_show_geo_selected curve $objs 1
    ic_undo_group_begin
    switch [ic_geo_get_object_type curve $objs] {
	mesh  { geo_create_point_extract_facet $objs }
	param { geo_create_point_extract_param $objs }
	default { error "Only select all faceted or all parametric surfaces" }
    }
    ic_undo_group_end
    ic_show_geo_selected curve $objs 0
}

proc geo_create_point_extract_param {names} {
    ic_undo_group_begin
    foreach name $names {
	ic_geo_create_curve_ends $name
    }
    ic_undo_group_end
}

proc geo_create_point_extract_facet { objs } {
    global geo_create last_geometry_created

    set d [form_init .geo_create_point_extract "Extract points"]
    if {$d != ""} {
	form_label $d.angl "Angle" {0 0}
	form_entry $d.ang geo_create(curve,extract,angle) float {0 1}
	form_finish bot
    }
    if [form_wait .geo_create_point_extract] {
	busy 1
	ic_undo_group_begin
	set new [ic_geo_extract_points $objs \
		       $geo_create(curve,extract,angle)]
	mess "Extraction yields [llength $new] points\n"
	set last_geometry_created(point) $new
	mess "Done.\n"
	ic_undo_group_end
	busy 0
    }
}

proc geo_create_point_screen {} {
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }

    ic_undo_group_begin    
    while 1 {
	set pt [select_location "a point" 1]
	if {$pt == ""} break
	ic_geo_cre_pnt $fam "" $pt
    }
    ic_undo_group_end
}

proc geo_create_point_midpoint {} {
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }
    
    ic_undo_group_begin
    while 1 {
	set pts ""
	set np 1
	while 1 {
	    set pt [select_location "point $np" 1]
	    if {$pt == ""} break
	    lappend pts $pt
	    incr np
	}
	if {$pts == ""} break
	ic_geo_cre_pnt $fam "" [midpoint_of_points $pts]
    }
    ic_undo_group_end
}

proc geo_create_point_explicit {} {
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }
    
    ic_undo_group_begin
    while 1 {
	set pt [question_box .expl_loc "Explicit location" \
	       "Input the cordinates separated by spaces." ""]
	if {$pt == ""} break
	ic_geo_cre_pnt $fam "" $pt
    }
    ic_undo_group_end
}

proc geo_create_material_screen {} {
    global geom_visible
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }

    ic_undo_group_begin    
    while 1 {
	set pt [select_location "a point" 1]
	if {$pt == ""} break
	set geom_visible(material) 1
	set name [ic_geo_cre_mat $fam "" $pt]
	mess "New material point $name created.\n"
    }
    ic_undo_group_end
}

proc geo_create_point_curveinter {} {
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }
   
    ic_undo_group_begin
    while 1 {
        set objs [geo_select curve]
        if {$objs == ""} {
	    ic_undo_group_end
	    return
	}
        if {[llength $objs] < 2} { error "need at least two curves" }

# Set the tol as a factor of average length of the curves
        set ncurves [llength $objs]
        set length 0
        foreach obj $objs {
            set length [expr $length+[ic_geo_feature_size curve $obj]]
        }

        set ave_length [expr $length/($ncurves + 0.0)]
        set tol [expr $ave_length/1000.0]
        set tol [question "Intersection tolerance?" $tol]
        if {$tol == ""} continue

	set np [ic_geo_create_points_curveinter $objs $tol $fam]
	set n [llength $np]
	if !$n {
	    mess "Warning: could not create any points\n" red
	} else {
	    mess "Created $n point(s)\n"
	}
    }
    ic_undo_group_end
}

proc geo_create_material_midpoint {} {
    global geom_visible
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }
    
    ic_undo_group_begin
    while 1 {
	set pts ""
	set np 1
	while 1 {
	    set pt [select_location "point $np" 1]
	    if {$pt == ""} break
	    lappend pts $pt
	    incr np
	}
	if {$pts == ""} break
        set geom_visible(material) 1
	set name [ic_geo_cre_mat $fam "" [midpoint_of_points $pts]]
	mess "New material point $name created.\n"
    }
    ic_undo_group_end
    update_geom_window
}

proc geo_create_material_explicit {} {
    global geom_visible
    set fam [select_families 0 0 1]
    if {$fam == ""} return
    if [ic_geo_new_family $fam] { update_fam_window }
    
    ic_undo_group_begin
    while 1 {
	set pt [question_box .expl_loc "Explicit location" \
	       "Input the cordinates separated by spaces." ""]
	if {$pt == ""} break
	set geom_visible(material) 1
	set name [ic_geo_cre_mat $fam "" $pt]
	mess "New material point $name created.\n"
    }
    ic_undo_group_end
}

proc midpoint_of_points {pts} {
    set x 0; set y 0; set z 0
    foreach p $pts {
	set x [expr $x + [lindex $p 0]]
	set y [expr $y + [lindex $p 1]]
	set z [expr $z + [lindex $p 2]]
    }
    set np [llength $pts]
    return [list [expr $x / ($np + 0.0)] \
		 [expr $y / ($np + 0.0)] \
		 [expr $z / ($np + 0.0)]]
}

proc geo_create_density_screen_defaults {} {
    global geo_create tdv_default

    set allbb [$tdv_default bbox interesting]
    if {$allbb == ""} return

    foreach xx {
	{1 0 0 1} {2 1 0 1} {3 1 1 1} {4 0 1 1}
	{5 0 0 0} {6 1 0 0} {7 1 1 0} {8 0 1 0}
    } {
	set geo_create(density,points,pt[lindex $xx 0]) \
	    [list [lindex [lindex $allbb [lindex $xx 1]] 0] \
		  [lindex [lindex $allbb [lindex $xx 2]] 1] \
		  [lindex [lindex $allbb [lindex $xx 3]] 2]]
    }
    set geo_create(density,points,size) 0
    set geo_create(density,points,width) 0
    set geo_create(density,points,ratio) 0
}

proc geo_create_density_points {} {
    global geo_create

    set npts $geo_create(density,points,npts)
    for {set i 1} {$i <= $npts} {incr i} {
        set geo_create(density,points,pt$i) ""
    }
    for {set i 1} {$i <= $npts} {incr i} {
        med_get_local_location geo_create(density,points,pt$i)
        if {$geo_create(density,points,pt$i) == ""} break
    }
}

proc geo_create_density_screen {{npts 8} {name ""}} {
    global geo_create env

    set minpts $npts
    if {$npts == 1} {
        set type Point
    } elseif {$npts == 2} {
        set type Line
    } elseif {$npts == 3} {
        set type Plane
    } else {
        set npts 8
        set minpts 4
        set type Volume
    }
    set geo_create(density,points,npts) $npts

    if {$name == ""} {
        set geo_create(density,points,name) [ic_geo_new_name density "density."]
    } else {
        set geo_create(density,points,name) $name
        set np [ic_geo_num_nodes density $name]
        for {set n 1} {$n <= $np} {incr n} {
            set geo_create(density,points,pt$n) \
                [ic_geo_get_node density $name [expr $n - 1]]
        }
	foreach {n v} [ic_get_meshing_params density $name] {
            switch $n {
                emax {
                    set geo_create(density,points,size) [format "%g" \
                        [expr $v / [ic_geo_get_ref_size]]]
                }
                ewid {set geo_create(density,points,width) $v}
                erat {set geo_create(density,points,ratio) $v}
            }
        }
    }

    set buts [list accept reset cancel {Select geo_create_density_points}]
    if {$npts > 3} {
        lappend buts {Outer geo_create_density_screen_defaults}
    }
    set d [form_init .geo_create_density_points_$npts \
	       "Create Density $type" "" $buts]
    if {$d != ""} {

	form_label $d.namel "Name" {0 0}
	form_entry $d.namee geo_create(density,points,name) string {0 1}

	form_label $d.sizel "Size" {1 0}
	form_entry $d.sizee geo_create(density,points,size) float {1 1}

	form_label $d.widthl "Width" {2 0}
	form_entry $d.widthe geo_create(density,points,width) float {2 1}

        form_label $d.ratl "Ratio" {3 0}
        form_entry $d.rate geo_create(density,points,ratio) float {3 1}

        form_label $d.labl "Density $type Location" {4 0 -cols -}

        if {$npts > 3} {
	    set bm $env(MED_ROOT)/lib/med_gui/create_surf_points_$npts.xbm
	    form_label_bitmap $d.crbitmap @$bm {5 0 -cols -}
	    form_label $d.blankl "To select fewer than 8 points,\nleave some fields blank." {6 0 -cols -}
        }
	for {set i 1} {$i <= $npts} {incr i} {
	    form_label $d.lab$i "Point $i" "1$i 0"
            if {$i <= $minpts} {
	        form_entry $d.ent$i geo_create(density,points,pt$i) coords "1$i 1"
            } else {
	        form_entry $d.ent$i geo_create(density,points,pt$i) string "1$i 1"
            }
	    form_button $d.sel$i "Select" \
		"med_get_local_location geo_create(density,points,pt$i)" \
		"1$i 2"
	}

	#form_checkbutton $d.stretch "Stretching" \
	#	geo_create(density,stretch) {103 0}
	#set act {{geo_create(density,stretch) 1}}
	#form_label $d.strfl "Stretch Factor" {104 0} $act
	#form_entry $d.strfe geo_create(density,stretch,factor)\
	#	float {104 1} $act
	#form_label $d.strvl "Stretch Direction" {105 0} $act
	#form_entry $d.strve geo_create(density,stretch,vector)\
	#	string {105 1} $act

	form_finish bot
    }

    if {$name == ""} {
        form_settitle .geo_create_density_points_$npts "Create Density $type"
    } else {
        form_settitle .geo_create_density_points_$npts "Modify Density $type"
    }

    for {set i 1} {$i <= $npts} {incr i} {
	trace variable geo_create(density,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(density,points,pt$i); list"
	update_screen_label_point "Pt $i" geo_create(density,points,pt$i)
    }

    set ok [form_wait .geo_create_density_points_$npts]

    set pts ""
    for {set i 1} {$i <= $npts} {incr i} {
	trace vdelete geo_create(density,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(density,points,pt$i); list"
	update_screen_label_point "" geo_create(density,points,pt$i)
	set p $geo_create(density,points,pt$i)
	if {$p != ""} {
	    if {[llength $p] > 1} {
		lappend pts [ic_coords_into_global $p]
	    } else {
		lappend pts $p
	    }
	}
    }
    if !$ok return

    if {$name != ""} {ic_delete_geometry density names $name}

# Density sizes are always w.r.t ref size
    set size [ expr $geo_create(density,points,size) \
                    *[ic_geo_get_ref_size] ]
    set ratio $geo_create(density,points,ratio)
    set width $geo_create(density,points,width)

    if {$geo_create(density,stretch)} {
	ic_geo_create_density $geo_create(density,points,name) \
	    $size $pts $width $ratio $geo_create(density,stretch)
    } else {
	ic_geo_create_density $geo_create(density,points,name) \
	    $size $pts $width $ratio
    }
}

proc geo_modify_density_screen {} {
    global geo_create
    set obj [geo_select density 1 "density to modify"]
    if {$obj == ""} return
    set npnts [ic_geo_num_nodes density $obj]
    geo_create_density_screen $npnts $obj
}

proc geo_create_loop_screen {} {
    global geo_create

    if [ic_count_elements BAR_2] {
	mess "To create a new curve for the loop from bar elements, hit 'n'\
		and then select a bar on the curve segment.\n"
	set make_new 1
    } else {
	set make_new 0
    }
    ic_undo_group_begin
    while 1 {
	set curves [geo_select curve 0 "curves for the loop" $make_new]
	if {$curves == ""} break
	set d [form_init .loopn "Create loop"]
	if {$d != ""} {
	    form_label $d.familyl Family {0 0}
	    form_label $d.namel Name {1 0}
	    form_entry $d.family geo_create(loop,screen,fam) string {0 1}
	    form_button $d.self "Select" \
		"select_family_set_var geo_create(loop,screen,fam)" {0 2}
	    form_entry $d.name geo_create(loop,screen,name) string {1 1}
	    form_finish bot
	}
	if ![form_wait .loopn] break
	
	set opt [ic_select_geometry_option]
	if {$opt != ""} {
	    set nloop [ic_geo_create_loop $geo_create(loop,screen,name) \
		$geo_create(loop,screen,fam) [lindex $opt 0] [lindex $opt 1] \
		0 ""]
	} else {
	    set nloop [ic_geo_create_loop $geo_create(loop,screen,name) \
		$geo_create(loop,screen,fam) names $curves 0 ""]
	}
	mess "New loop $nloop created.\n"
    }
    ic_undo_group_end
    update_geom_window
}

# create one loop from several surfaces

proc geo_create_loop_surfaces {{per_family 0}} {
    global geo_create
   
    ic_undo_group_begin
    while 1 {
        set surfs_selected [geo_select surface]
        if {$surfs_selected == ""} break

        foreach fam [ic_geo_list_families] {
            if {!$per_family} {
                set surfs $surfs_selected
            } else {
                set surfs ""
                foreach s $surfs_selected {
                    if {[ic_geo_get_family surface $s] == $fam} {
                        lappend surfs $s
                    }
                }
                if {$surfs == ""} continue;
            }

            catch {unset got}
            foreach s $surfs {
                set bounds [ic_geo_boundary surface $s]
                foreach c $bounds {
                    if [info exists got($c)] {
                        incr got($c)
                    } else {
                        set got($c) 1
                    }
                }
            }
            set curves ""
            foreach cn [array names got] {
                if {$got($cn) == 1} {
                    ic_show_geo_selected curve $cn 1
                    lappend curves $cn
                }
            }
            if {$curves == ""} { error "No curves are available.  You\
                may check the selected surfaces and/or run the Geometry\
                Repair function." }

            set d [form_init .loopsurfs "Create loop"]

            if {$d != ""} {
                form_frame $d.f flat 0 {0 0}

                form_label $d.f.familyl Family {0 0}
                form_entry $d.f.family geo_create(loop,screen,fam) string {0 1}

                form_button $d.f.self "Select" \
                    "select_family_set_var geo_create(loop,screen,fam)" {0 2}
                form_label $d.f.namel Name {1 0}
                form_entry $d.f.name geo_create(loop,screen,name) string {1 1}

                form_checkbutton $d.surface_check "Surface association" \
                    geo_create(loop,screen,association) {2 0}
                form_checkbutton $d.structured "Structured" \
                    geo_create(loop,screen,structured) {3 0}
                form_finish bot
            }
            set doit [form_wait .loopsurfs]
            foreach c $curves {
                ic_show_geo_selected curve $c 0
            }
            if !$doit break
            foreach s $surfs {
                set curvature [ic_surface_curvature $s]
                if {$curvature > 110} {
                    mess "Folded surface \"$s\" encountered " red
                    mess "(curvature = $curvature).\n" red
                }
            }
            if {$geo_create(loop,screen,association)} {
                set asurfs $surfs
            } else {
                set asurfs ""
            }
            if {$geo_create(loop,screen,fam) == ""} {
                if {$per_family} {
                    set loop_screen_fam $fam
                } else {
                    set loop_screen_fam "loops"
                }
            } else {
                set loop_screen_fam $geo_create(loop,screen,fam)
            }
            set nloop [ic_geo_create_loop $geo_create(loop,screen,name) \
                       $loop_screen_fam names $curves 0 $asurfs]
            mess "New loop $nloop created.\n"
            if $geo_create(loop,screen,structured) {   
                catch { unset tmp }
                foreach {sf pt} [ic_geo_surface_topological_corners $surfs] {                        
                    foreach p $pt {
                        if ![info exists tmp($p)] {
                            set tmp($p) 1
                        } else {
                            incr tmp($p)
                        }
                    }
                }
                set corners ""
                foreach p [array names tmp] {
                    if {$tmp($p) == 1} {
                        lappend corners $p
                    }
                }
                if {$corners != "" && [llength $corners] == 4} {
                    ic_geo_modify_loop $nloop $curves $asurfs "" $corners
                    ic_set_meshing_params loop $nloop etyp 5
                } else {
                    mess "Problem to create corners. Skipping \"Structured\"\
                          option.\n" red
                }
            }
            if {!$per_family} break
        }
    }
    ic_undo_group_end
    update_geom_window
}

# create loops from each surface

proc geo_create_loop_surface {} {
    global geo_create

    ic_undo_group_begin
    while 1 {
        set surfs [geo_select surface]
        if {$surfs == ""} break

        set curves [ic_geo_boundary surface $surfs]
        if {$curves == ""} { error "No curves are available.  You\
            may check the selected surfaces and/or run the Geometry\
            Repair function." }
        foreach c $curves {
            ic_show_geo_selected curve $c 1
        }

        set d [form_init .loopsurf "Create loops"]
        if {$d != ""} {
            form_frame $d.f flat 0 {0 0}
            form_label $d.f.familyl Family {0 0}
            form_label $d.f.namel Name {1 0}
            form_entry $d.f.family geo_create(loop,screen,fam) string {0 1}
            form_button $d.f.self "Select" \
                "select_family_set_var geo_create(loop,screen,fam)" {0 2}
            form_entry $d.f.name geo_create(loop,screen,name) string {1 1}
            form_checkbutton $d.surface_check "Surface association" \
                geo_create(loop,screen,association) {2 0}
            form_checkbutton $d.structured "Structured" \
                geo_create(loop,screen,structured) {3 0}
            form_finish bot
        }
        set doit [form_wait .loopsurf]
        foreach c $curves {
            ic_show_geo_selected curve $c 0
        }
        if !$doit break

        if {[llength $surfs] == 1} {
            #  work-a-round for {} problem from ic_geo_boundary
            lappend curves_tmp $curves
            set curves $curves_tmp
        }
        foreach s $surfs {
            set curvature [ic_surface_curvature $s]
            if {$curvature > 110} {
                mess "Folded surface \"$s\" encountered " red
                mess "(curvature = $curvature).\n" red
            }
        }
        if {$geo_create(loop,screen,association)} {
            set asurfs $surfs
        } else {
            set asurfs ""
        }
        set families ""
        if {$geo_create(loop,screen,fam) == ""} {
            foreach s $surfs {
                #  store family names of each surface
                #  if no general family name is given
                lappend families [ic_geo_get_family surface $s]
            }
        }
        set nloops [ic_geo_create_loop $geo_create(loop,screen,name) \
                    $geo_create(loop,screen,fam) names $curves 1 $asurfs $families]
        mess "New loop(s) $nloops created.\n"
        if $geo_create(loop,screen,structured) {
            set i 0
            foreach nloop $nloops {
                set sfs [lindex $surfs $i]
                catch { unset tmp }
                foreach {sf pt} [ic_geo_surface_topological_corners $sfs] {                        
                    foreach p $pt {
                        if ![info exists tmp($p)] {
                            set tmp($p) 1
                        } else {
                            incr tmp($p)
                        }
                    }
                }
                set crns ""
                foreach p [array names tmp] {
                    if {$tmp($p) == 1} {
                        lappend crns $p
                    }
                }
                if {$crns != "" && [llength $crns] == 4} {
                    set crvs [ic_geo_loop_get_objects $nloop "curve"]
                    set srfs [ic_geo_loop_get_objects $nloop "surface"]
                    if {$crvs != ""} {
                        ic_geo_modify_loop $nloop $crvs $srfs "" $crns
                        ic_set_meshing_params loop $nloop etyp 5
                    }
                } else {
                    mess "Problem to create corners. Skipping \"Structured\"\
                          option for loop $nloop.\n" red
                }
                incr i
            }
        }
    }
    ic_undo_group_end
    update_geom_window
}

# merge multiple loops and make one loop out of them (delete the old ones)

proc geo_modify_loop_merge_loops {} {
    global geo_create

    ic_undo_group_begin
    while 1 {
        set loops [geo_select loop]
        if {$loops == ""} break
        if {[llength $loops] <= 1} {
	    mess "Selection must contain two or more loops!\n" red
	    return
        }        
        set params [ic_get_meshing_params loop [lindex $loops 0]]       
	catch {unset got}
	catch {unset got_sf}
	catch {unset got_pt}
	catch {unset got_cr}
	set loops_to_delete ""
	set surfaces ""
	set points ""
	set corners ""
	foreach s $loops {
	    set bounds [ic_geo_boundary loop $s]
	    # only delete loops if we successfully got the boundary
	    if {"" != $bounds} { lappend loops_to_delete $s }
	    foreach c $bounds {
		if [info exists got($c)] {
		    incr got($c)
		} else {
		    set got($c) 1
		}
	    }
	    foreach sf [ic_geo_loop_get_objects $s "surface"] {
	        if ![info exists got_sf($sf)] {
	            set got_sf($sf) 1
	            lappend surfaces $sf
	        }
	    }
	    foreach pt [ic_geo_loop_get_objects $s "point"] {
	        if ![info exists got_pt($pt)] {
	            set got_pt($pt) 1
	            lappend points $pt
	        }
	    }
	    foreach cr [ic_geo_loop_get_objects $s "corner"] {
	        if ![info exists got_cr($cr)] {
	            set got_pt($cr) 1
	            lappend corners $cr
	        }
	    }
	}
	
	set curves ""
	foreach cn [array names got] {
	    # Skip the ones that show up multiple times
	    if {$got($cn) == 1} {
		ic_show_geo_selected curve $cn 1
		lappend curves $cn
	    }
	}
        if {"" == $curves} {
	    mess "couldn't get boundary of the selected loops\n" red
	    continue
	}
		
	set d [form_init .loopmerge "Merge loops"]
	
	if {$d != ""} {
	    form_frame $d.f flat 0 {0 0}
	    
	    form_label $d.f.familyl Family {0 0}
	    form_entry $d.f.family geo_create(loop,screen,fam) string {0 1}
	    
	    form_button $d.f.self "Select" \
		"select_family_set_var geo_create(loop,screen,fam)" {0 2}
	    form_label $d.f.namel Name {1 0}
	    form_entry $d.f.name geo_create(loop,screen,name) string {1 1}
	    
	    form_finish bot
	}
	set doit [form_wait .loopmerge]
	foreach c $curves {
	    ic_show_geo_selected curve $c 0
	}
	if {!$doit || ("" == $curves)} break
	
	# First delete the old ones, if we got the boundary
	ic_delete_geometry loop names $loops_to_delete
	
	if {$points != ""} {
	    catch {unset got_pt}
	    set tmp(points) ""
	    foreach c $curves {
	        set found 0
	        foreach p [ic_geo_boundary curve $c] {
	            if {[lsearch $points $p] != -1} {
	                set found 1
	                break
	            }
	        }
	        if {!$found && ([lsearch $points $p] != -1)} {
	            if ![info exists got_pt($p)] {
	                lappend tmp(points) $p
	                set got_pt($p) 1
	            }
	       }
	    }
	    set points $tmp(points)
	}
	if {$corners != ""} {
	    catch {unset got_cr}
	    set tmp(corners) ""
	    foreach c $curves {
	        foreach p [ic_geo_boundary curve $c] {
	            if {[lsearch $corners $p] != -1} {
	                if ![info exists got_cr($p)] {
	                    lappend tmp(corners) $p
	                    set got_cr($p) 1
	                }
	            }
	        }
	    }
	    set corners $tmp(corners)
	}
	
	set nloop [ic_geo_create_loop $geo_create(loop,screen,name) \
	    $geo_create(loop,screen,fam) names $curves 0 $surfaces \
	    "" $points $corners]
	foreach {n v} $params {
            ic_set_meshing_params loop $nloop $n $v
        }
        mess "Loops merged, new loop $nloop created.\n"
    }
    ic_undo_group_end
    update_geom_window
}

proc geo_modify_loop_merge_curves {} {
    global geo_create

    while 1 {
        set not_these ""
        set to_merge ""
        set mess "1 loop to modify"
        set loop [geo_select loop 1 "$mess"]
        if {$loop == ""} break        
        foreach l [ic_geo_get_objects loop] {
            set other(curve,$l) [ic_geo_loop_get_objects $l "curve"]
            if {$other(curve,$l) == ""} {
                mess "Couldn't get boundary of loop $l.\n" red
                return
            }
            catch { unset tmp }
            catch { unset other(prescribed,$l) }
            foreach c $other(curve,$l) {
                if ![info exists tmp(c,$c)] {
                    set tmp(c,$c) 1
                } else {
                    lappend other(prescribed,$l) $c
                }
            }
            set other(point,$l)   [ic_geo_loop_get_objects $l "point"]
            set other(surface,$l) [ic_geo_loop_get_objects $l "surface"]
            set other(corner,$l)  [ic_geo_loop_get_objects $l "corner"]
            set other(family,$l)  [ic_geo_get_family loop $l]
        }
        set crvs [ic_geo_loop_get_objects $loop "curve"]
        foreach c [ic_geo_get_objects curve] {
            if {[lsearch $crvs $c] == -1} {
                lappend not_these $c
            }
        }
        set mess "curve(s) of loop(s) to merge"
        set to_merge [geo_select curve 0 "$mess" 0 0 ""]
        if {$to_merge == ""} break
        set len_merge [llength $to_merge]
        if {$len_merge <= 1} {
	    mess "Selection must contain two or more curves!\n" red
	    return
        }
        catch { unset tmp }
        foreach item [array names other curve,*] {
            set l [lindex [split $item ,] 1]
            if {$l == $loop} continue
            foreach c $to_merge {
                if {[lsearch $other($item) $c] != -1} {
                    lappend tmp($l) $c
                }
            }
        }
        foreach l [array names tmp] {
            foreach c $to_merge {
                if {[lsearch $tmp($l) $c] == -1} {
                    set stop 1
                    set shared_l $l
                } else {
                    set shared_c $c
                }
            }
        }
        if [info exists stop] {
            mess "Problem to merge selected curves. The selected\
                  curve $shared_c does also belong to loop $shared_l.\n" red
            return
        }
        set emax 0.0; set enum 0
        foreach c $to_merge {
            if {[lsearch $not_these $c] != -1} {
                mess "Problem to merge selected curves. The selected\
                      curve $c does not belong to the selected loop.\n" red
                return
            } else {
                foreach {p v} [ic_get_meshing_params curve $c] {
                    if {$p == "emax"} {
                        set emax [expr $v + $emax]
                        incr enum
                    }
                }
            }
        }
        if {$emax > 0.0 && $enum >= 1} {
            set emax [expr $emax / $enum]
        }
        catch { unset modify }
        catch { unset skip_loop }
        foreach item [array names other curve,*] {
            set l [lindex [split $item ,] 1]
            foreach c $other($item) {
                if {[lsearch $to_merge $c] != -1} {
                    if ![info exists modify($l)] {
                        set modify($l) 1
                    } else {
                        incr modify($l)
                    }
                }
            }
            if [info exists modify($l)] {
                set modify($l) [expr $modify($l) / 2]
                if {$len_merge != $modify($l)} {
                    set skip_loop($l) 1
                }
            }
        }
        if [catch {ic_geo_cre_edge_concat $to_merge} res] {
	    mess "$res\n" red
	    break
        }

        set concat_curve $res
        ic_set_meshing_params curve $concat_curve emax $emax
        mess "Curves merged, new curve $concat_curve created.\n"
        foreach l [array names modify] {
            if [info exists skip_loop($l)] continue
            catch { unset curves }
            foreach c [ic_geo_loop_get_objects $l "curve"] {
                if {[lsearch $to_merge $c] == -1} {
                    append curves "$c "
                }
            }
            append curves "$concat_curve"
            if [info exists other(prescribed,$l)] {
                set do_append 1
                foreach c $to_merge {
                    if {[lsearch $other(prescribed,$l) $c] == -1} {
                        set do_append 0
                    }
                }
                if $do_append {
                    append curves " $concat_curve"
                }
            }
            set fam $other(family,$l)
            set pts $other(point,$l)
            set crn $other(corner,$l)
            set sfs $other(surface,$l)
            set params [ic_get_meshing_params loop $l]
            mess "Updating loop $l.\n"
            ic_delete_geometry loop names $l
            set nloop [ic_geo_create_loop $l $fam names $curves 0 $sfs "" $pts $crn]
            foreach {n v} $params {
                ic_set_meshing_params loop $nloop $n $v
            }
        }
    }
        
    update_geom_window
}

proc geo_modify_loop {action what {type ""}} {
    global geo_create
    
    if {$action == "merge"} {
        geo_modify_loop_merge_$what
        return
    }
    set mess "1 loop to modify"
    set loop [geo_select loop 1 "$mess"]
    if {$loop == ""} {
        return
    }
    set curves [ic_geo_loop_get_objects $loop "curve"]
    if {$curves == ""} {
        mess "Couldn't get boundary of the selected loop.\n" red
        return
    }
    set points [ic_geo_loop_get_objects $loop "point"]
    set corners [ic_geo_loop_get_objects $loop "corner"]
    set surfaces [ic_geo_loop_get_objects $loop "surface"]
    geo_modify_loop_$action $what $loop $points $curves $surfaces $corners $type
    update_geom_window
}

proc geo_modify_loop_delete {what loop points curves surfaces corners type} {

    set not_these ""
    set to_delete ""
    set new_items ""
    if {$what == "corner"} {
        set object point
    } else {
        set object $what
    }
    foreach item [ic_geo_get_objects $object] {
        if {[lsearch [set ${what}s] $item] == -1} {
            lappend not_these $item
        }
    }
    set mess "${what}(s) of loop to delete"
    set to_delete [geo_select $object 0 "$mess" 0 0 "$not_these"]
    if {$to_delete == ""} return
    set point_items $points
    set curve_items $curves
    set surface_items $surfaces
    set corner_items $corners
    foreach item [set ${what}s] {
        if {[lsearch $to_delete $item] == -1} {
            lappend new_items $item
        }
    }
    set ${what}_items $new_items
    if {$curve_items == ""} {
        ic_delete_geometry loop names $loop
        mess "Loop $loop deleted.\n"
        return
    }
    if {$new_items != "" || $to_delete != ""} {
        set params [ic_get_meshing_params loop $loop]
        ic_geo_modify_loop $loop $curve_items $surface_items $point_items $corner_items
        foreach {n v} $params {
            ic_set_meshing_params loop $loop $n $v
        }
        mess "Loop $loop modified.\n"
    }
}

proc geo_modify_loop_add {what loop points curves surfaces corners type} {
    global geo_create
    
    set not_these ""
    set to_add ""
    set new_items ""
    if {$what == "corner"} {
        set object point
    } else {
        set object $what
    }
    foreach item [ic_geo_get_objects $object] {
        if {[lsearch [set ${what}s] $item] != -1} {
            lappend not_these $item
        }
    }
    if {$what == "point" || $what == "corner"} {
        foreach p [ic_geo_get_objects point] {
            if {$what == "point"} {
                if {[ic_geo_incident point $p] != ""} {
                    if ![info exists tmp($p)] {
                        lappend not_these $p
                        set tmp($p) 1
                     }
                }
             } elseif {$what == "corner"} {
                set found 0
                foreach c [ic_geo_incident point $p] {
                    if {[lsearch $curves $c] != -1} {
                       set found 1
                       break
                    }
                }
                if !$found {
                    if ![info exists tmp($p)] {
                        lappend not_these $p
                        set tmp($p) 1
                    }
                } else {
                    set tmp($p) 1
                }
            }
        }
    }
    set mess "$type ${what}(s) to add to loop"
    set to_add [geo_select $object 0 "$mess" 0 0 "$not_these"]
    if {$to_add == ""} return

    if {$what == "curve" && $type == "prescribed"} {
        set split_loop [geo_modify_loop_add_prescribed $curves $surfaces \
        	$points $corners $to_add]
    } else {
        set split_loop "no_split"
    }
    set point_items $points
    set curve_items $curves
    set surface_items $surfaces
    set corner_items $corners
    set new_items [set ${what}s]
    foreach item $to_add {
        if {[lsearch [set ${what}s] $item] == -1} {
            lappend new_items $item
            if {$what == "curve" && $type == "prescribed"} {
                if {$split_loop == "no_split"} {
                    lappend new_items $item
                }
            }
        }
    }
    set params [ic_get_meshing_params loop $loop]
    set ${what}_items $new_items
    if {($new_items != "" || $to_add != "") && $split_loop == "no_split"} {
        ic_geo_modify_loop $loop $curve_items $surface_items $point_items $corner_items
        foreach {n v} $params {
            ic_set_meshing_params loop $loop $n $v
        }
        mess "Loop $loop modified.\n"
        
    }
    if {$split_loop == "no_split"} { return }
    set fam [ic_geo_get_family loop $loop]    
    ic_delete_geometry loop names $loop
    set nloop1 [ic_geo_create_loop $loop $fam names $geo_create(loop,crvs1) 0 \
    	$geo_create(loop,sf1) "" $geo_create(loop,pts1) $geo_create(loop,crn1)]
    foreach {n v} $params {
        ic_set_meshing_params loop $nloop1 $n $v
    }
    set nloop2 [ic_geo_create_loop $loop $fam names $geo_create(loop,crvs2) 0 \
    	$geo_create(loop,sf2) "" $geo_create(loop,pts2) $geo_create(loop,crn2)]
    foreach {n v} $params {
        ic_set_meshing_params loop $nloop2 $n $v
    }
    mess "Split loop $loop into loops $nloop1 and $nloop2.\n"
}

proc geo_modify_loop_add_prescribed {curves surfaces points corners to_add} {
    global geo_create

    set prescribed ""
    foreach c $curves {
        if ![info exists tmp(c,$c)] {
            set tmp(c,$c) 1
        } else {
            lappend prescribed $c
        }
        foreach p [ic_geo_boundary curve $c] {
            set tmp(p,$p) 1
        }
    }
    set i 0; set start ""; set end ""
    set start_point ""; set end_point "" 
    foreach c $to_add {
        foreach p [ic_geo_boundary curve $c] {
            if [info exists tmp(p,$p)] {
                if {$i == 0} {
                    set start $c
                    set start_point $p
                } elseif {$i == 1} {
                    set end $c
                    set end_point $p
                }
                incr i
            } else {
                if ![info exists tmp(closed,$p)] {
                    set tmp(closed,$p) 1
                } else {
                    incr tmp(closed,$p)
                }
            }
        }
    }
    set closed 1
    foreach p [array names tmp closed,*] {
        if {$tmp($p) < 2} {
            set closed 0
            break
        }
    }
    catch { unset tmp }
    set c1 ""; set c2 ""
    if {($start != "" && $end != "") && ($start_point != $end_point) && \
        ($i == 2) && ($closed)} { 
        set geo_create(loop,crvs) ""
        set pts [ic_geo_boundary curve $start]
        set all [geo_modify_loop_prescribed_curves $start \
        	$curves $to_add $pts $end_point]
        foreach item [array names geo_create loop,tmp,*] {
          unset geo_create($item)
        }
        set crvs ""
        foreach item $all {
            lappend crvs [lindex $item 1]
        }
        set exclude ""; set exclude_points ""
        foreach c $curves {
            if {[lsearch $crvs $c] == -1} {
                append exclude "$c "
                append exclude_points " [ic_geo_boundary curve $c]"
            }
        }
        set p1 [lindex [lindex [lindex $all 0] 0] 0]
        set p2 [lindex [lindex [lindex $all 0] 0] 1]
        if {$p1 != $start_point} {
            set p2 $p1
            set p1 $start_point
        }
        set stop 1
        while $stop {
            if {$p1 == $p2} break
            if {$stop == 0} break
            foreach item $all {
                set idx [lsearch [lindex $item 0] $p1]
                if {$idx != -1} {
                    lappend c1 [lindex $item 1]
                    if {$idx == 0} {
                        set p1 [lindex [lindex $item 0] 1]
                    } elseif {$idx == 1} {
                        set p1 [lindex [lindex $item 0] 0]
                    }
                    if [info exists last_points] {
                        if {[lsearch $last_points $p1] != -1} {
                            set stop 0
                            break
                        }
                    }
                    if {$p1 == $end_point} {
                        set stop 0
                        break
                    }
                    if {[lsearch $exclude_points $end_point] != -1} {
                        set stop 0
                        break
                    }
                    lappend last_points $p1
                }
            }
        }
        catch { unset last_points }
        if {$c1 == ""} {
          set stop 0
        } else {
          set stop 1
        }
        while $stop {
            if {$stop == 0} break
            foreach item $all {
                set idx [lsearch [lindex $item 0] $p2]
                if {$idx != -1} {
                    if {[lsearch $c1 [lindex $item 1]] == -1} {
                        if ![info exists tmp([lindex $item 1])] {
                            set tmp([lindex $item 1]) 1
                            lappend c2 [lindex $item 1]
                        } else {
                            set stop 0
                            break
                        }
                    }
                    if {$idx == 0} {
                       set p2 [lindex [lindex $item 0] 1]
                    } elseif {$idx == 1} {
                       set p2 [lindex [lindex $item 0] 0]
                    }
                    if {$p2 == $end_point} {
                        set stop 0
                        break
                    }
                    if {[lsearch $exclude_points $end_point] != -1} {
                        set stop 0
                        break
                    }
                    if {$p1 == $p2} {
                        set stop 0
                        break
                    }
                }
            }
        }
    }
    if {$c1 != "" && $c2 != ""} {
        foreach c $to_add { lappend c1 $c }
        foreach c $to_add { lappend c2 $c }
        set len1 [llength $c1]; set len2 [llength $c2]
        if {$len1 >= $len2} {
           foreach c $exclude { lappend c1 $c }
        } else {
           foreach c $exclude { lappend c2 $c }
        }
        foreach c $curves {
            if {([lsearch $c1 $c] == -1) && ([lsearch $c2 $c] == -1)} {
                return no_split
            }
        }
        set geo_create(loop,crvs1) $c1
        set geo_create(loop,crvs2) $c2
        geo_modify_loop_prescribed_surfaces $surfaces
        geo_modify_loop_prescribed_points $points
        geo_modify_loop_prescribed_corners $corners
        set type split
    } else {
        set type no_split
    }
    return $type
}

proc geo_modify_loop_prescribed_curves {start curves to_add points end} {
    global geo_create
   
    foreach c [ic_geo_incident point $points] {
        if {$start == $c} continue
        if {[lsearch $curves $c] == -1} continue
        if {[lsearch $to_add $c] != -1} continue
        if ![info exists geo_create(loop,tmp,$c)] {
            set geo_create(loop,tmp,$c) 1
            set points [ic_geo_boundary curve $c]
            lappend geo_create(loop,crvs) [list $points $c]
            if {[lsearch $points $end] == -1} {
                geo_modify_loop_prescribed_curves $c $curves $to_add $points $end
            }
        }
    }
    return $geo_create(loop,crvs)
}

proc geo_modify_loop_prescribed_surfaces {surfaces} {
    global geo_create
    
    set geo_create(loop,sf1) ""
    set geo_create(loop,sf2) ""
    if {$surfaces == ""} return
    foreach {i j} {sf1 crvs1 sf2 crvs2} {
        set geo_create(loop,$i) ""
        foreach s $surfaces {
            foreach c [ic_geo_boundary surface $s] {
                if {[lsearch $geo_create(loop,$j) $c] != -1} {
                    if ![info exists tmp($i,$s)] {
                        set tmp($i,$s) 1
                    } else {
                        incr tmp($i,$s)
                    }
                }
            }          
        }
    }
    foreach {i j} {sf1 sf2 sf2 sf1} {
        foreach item [array names tmp $i,*] {
            set sf [lindex [split $item ,] 1]
            if [info exists tmp($j,$sf)] {
                if {$tmp(sf1,$sf) == $tmp(sf2,$sf)} {
                    set tmp($sf) 1
                    continue
                } elseif {$tmp(sf1,$sf) > $tmp(sf2,$sf)} {
                    if ![info exists tmp($sf)] {
                        set tmp($sf) 1
                        lappend geo_create(loop,sf1) $sf
                    }
                } else {
                    if ![info exists tmp($sf)] {
                        set tmp($sf) 1
                        lappend geo_create(loop,sf2) $sf
                    }
                }
            } else {
                if ![info exists tmp($sf)] {
                    set tmp($sf) 1
                    lappend geo_create(loop,$i) $sf
                }
            }
        }
    }
}

proc geo_modify_loop_prescribed_points {points} {
    global geo_create

    set geo_create(loop,pts1) ""
    set geo_create(loop,pts2) ""    
    if {$points == ""} return
    foreach p $points {
        set pos(0) [ic_geo_get_point_location $p]
        foreach {i j} {1 crvs1 2 crvs2} {
            set crvs ""; set curves $geo_create(loop,$j)
            foreach c $curves { lappend crvs "curve $c" }
            set bb [ic_geo_bbox_of_entities $crvs]                
            set x [expr ([lindex [lindex $bb 0] 0] + \
                         [lindex [lindex $bb 1] 0]) / 2]
            set y [expr ([lindex [lindex $bb 0] 1] + \
                         [lindex [lindex $bb 1] 1]) / 2]
            set z [expr ([lindex [lindex $bb 0] 2] + \
                         [lindex [lindex $bb 1] 2]) / 2]
            set pos($i) [list $x $y $z]
            set dist($i) 0.0
            foreach n {0 1 2} {
                set m [expr {[lindex $pos(0) $n] - [lindex $pos($i) $n]}]
                set dist($i) [expr {$dist($i) + $m * $m}]
            }
            set dist($i) [expr sqrt($dist($i))]
        }
        if {$dist(1) <= $dist(2)} {
            lappend geo_create(loop,pts1) $p
        } else {
            lappend geo_create(loop,pts2) $p
        }
    }
}

proc geo_modify_loop_prescribed_corners {corners} {
    global geo_create
    
    set geo_create(loop,crn1) ""
    set geo_create(loop,crn2) ""
    if {$corners == ""} return
    foreach {i j} {crn1 crvs1 crn2 crvs2} {
        foreach c $geo_create(loop,$j) {
            foreach p [ic_geo_boundary curve $c] {
                if {[lsearch $corners $p] != -1} {
                    if ![info exists tmp($i,$p)] {
                        set tmp($i,$p) 1
                        lappend geo_create(loop,$i) $p
                    }
                }
            }
        }
    }
}

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

proc geo_delete {what} {
    global geometry_mode
    if {$what == "geometry_mode"} { set what $geometry_mode }
    ic_undo_group_begin    
    while 1 {
	set names [geo_select $what]
	if {$names == ""} {
	    ic_undo_group_end
	    return
	}
	set opt [ic_select_geometry_option]
	if {$opt != ""} {
	    ic_delete_geometry $what [lindex $opt 0] [lindex $opt 1]
	} else {
	    if {$what == "entity"} {
		foreach n $names {
		    ic_delete_geometry [lindex $n 0] names [lindex $n 1]
		}
	    } else {
		ic_delete_geometry $what names $names
	    }
	}
    }
}

proc geo_delete_last {what} {
    global last_geometry_created geometry_mode
    
    if {$what == "geometry_mode"} { set what $geometry_mode }
    
    if ![info exists last_geometry_created($what)] {
	mess "No ${what}s have been created by extraction or segmentation yet\n" red
    } else {
	ic_undo_group_begin
	ic_delete_geometry $what names $last_geometry_created($what)
	mess "Deleted [llength $last_geometry_created($what)] ${what}s\
		created by previous extraction or segmentation\n"
	unset last_geometry_created($what)
	ic_undo_group_end
    }
}

proc geo_delete_all {how type} {
    global geometry_mode
    
    if {$type == "geometry_mode"} { set type $geometry_mode }
    
    set mess "Really delete all $how ${type}s?"
    if [tk_dialog .delete_all "Delete all" $mess "" -1 \
	    Yes No] return
    
    ic_undo_group_begin
    set n [ic_delete_geometry $type $how ""]
    ic_undo_group_end

    mess "$n $how ${type}s deleted\n"
}

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

proc geo_import {source {infiles ""} {force_seg 1}} {
    global file_name data_available tdv_default
    global geom_visible batch_mode
    
    set from $file_name(project_dir)
    if {"" == $from} { set $from . }
    
    set home 1
    set no_orfn 1
    set could_seg 1
    switch $source {
	domain {
	    if {$infiles == ""} {
		set files [file_select_domainfiles import $from]
		if {$files == ""} return
	    } else {
		set files $infiles
	    }
	    set no_orfn 0
	}
	current {
	    if [ic_geo_is_loaded] {
		if ![ic_yes_or_no "Geometry data already exists.  Add the data from the current mesh to the existing geometry?"] {
		    mess "Not importing geometry.\n" red
		    return
		}
	    }
	    set files ""
	    set home 0
	    set no_orfn 0
	}
	plot3d {
	    set files [geo_import_type Plot3d plot3d $from $infiles]
	    if {$files == ""} return
	}
	patran {
	    set files [geo_import_type Patran patran $from $infiles]
	    if {$files == ""} return
	}
	stl {
	    set files [geo_import_type STL stl $from $infiles]
	    if {$files == ""} return
	    set could_seg 0
	}
	nastran {
	    set files [geo_import_type Nastran nastran $from $infiles]
	    if {$files == ""} return
	}
	rampant {
	    set files [geo_import_type Fluent rampant $from $infiles]
	    if {$files == ""} return
	}
	vrml {
	    set files [geo_import_type VRML vrml $from $infiles]
	    if {$files == ""} return
	}
	default {
	    # try to use a reader
	    if {"" == $infiles} {
		set infiles [file_selection -message \
			"Select the $source files." -default $from -multiple 1]
	    }
	    if {$infiles == ""} return
	    set files $from/tmp.domain
	    geo_import_reader $source $infiles $files
	}
    }
    
    set do_seg 0
    if $could_seg {
	if $force_seg {
	    set do_seg 1
	} else {
	    set do_seg [expr ![tk_dialog .seg_by_id "Segment" \
				   "Segment surfaces and curves by ID?" \
				   "" -1 "Yes" "No"]]
	}
    }
    
    if ![ic_geo_is_loaded] {
	ic_empty_tetin
	make_default_file_name tetin .tin
    }
    
    busy 1
    ic_geo_import_mesh $files $do_seg 1
    
    if {[ic_geo_num_objects curve] == 0} {
	# This might be a really huge surface.
	set tott 0
	foreach s [ic_geo_get_objects surface ""] {
	    incr tott [lindex [ic_geo_num_segments surface $s] 0]
	}
	if {$tott > 64000} {
	    mess "Warning: new surfaces have $tott triangles - by default not displaying them\n" red
	    set geom_visible(surface) 0
	} else {
	    set geom_visible(surface) 1
	}
	update_geom_visible surface v
    }
    
    update_geom_visible all a
    display_update geom
    
    if {!$batch_mode && $home} { tdv_home $tdv_default }
    busy 0
    mess "Done importing data.\n"
}

proc geo_import_type {name type from infiles} {
    global file_name
    
    set files ""
    if {$infiles == ""} {
	set infiles [file_selection -message \
			 "Select the $name files." -default $from -multiple 1]
	if {$infiles == ""} { return "" }
    }
    set n 0
    set outfiles ""
    set ddir $file_name(domains_dir)
    if {"" == $ddir} { set ddir . }
    foreach if $infiles {
	lappend outfiles $ddir/tmpdomain$n.uns
	incr n
    }
    # geo_import_$type returns either "" or a list where 1 = unstr and
    # 2 = str, followed by the domains.
    set ret [geo_import_$type $infiles $outfiles]
    if {$ret == ""} { return "" }
    
    if {[lindex $ret 0] == 2} {
	# structured
	# error "Can only import unstructured meshes as geometry"	
	set domains_dir [file dirname [lindex [lindex $ret 1] 0]]
	set ret2 [ic_convert_domains_to_unstruct $domains_dir]
    } else  {
	# unstructured
	set ret2 ""
	foreach r [lindex $ret 1] { lappend ret2 $r }
    }
    return $ret2
}

# This is from Matt Middleton

proc geo_import_str_to_cad {} {
    global file_name tdv_default

    if {![ic_str_is_loaded]} {
	set domains [domain_select $file_name(domains_dir) "Select structured domains." struct 1] 
	if {$domains == ""} return
    } else {
	if {[ic_str_domain_dimension 1] != 2} {
	    mess "You must use a surface only mesh.\n" red
	    mess "Go back to Hexa and write Multiblock->Surfaces\n" red
	    return
	}
	foreach d [ic_str_list_entities domain] { lappend domains $file_name(domains_dir)/domain.$d }
    }
    if [catch {ic_geo_import_str_to_cad $domains} res] {return [mess "$res\n" red]}
    if {$res == ""} return
    
    ic_geo_set_modified 1
    ic_visible geometry surface 1
    tdv_scale_to_fit $tdv_default
}

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

proc geo_export {switch} {
    global data_available geoexport
    
    set d [form_init .conv2mesh "Convert to mesh"]
    if {$d != ""} {
	form_frame $d.f1 flat 0 "0 0"
	
	form_label $d.f1.famll "Convert only families\n(blank = all)" {0 0}
	form_entry $d.f1.fame geoexport(fams) string {0 1}
	form_button $d.f1.fams "Select" geo_export_selfam {0 2}
	set geoexport(merge) 1
	form_frame $d.f2 flat 0 "1 0"
	form_checkbutton $d.f2.merge "Merge Curves and Surfaces \nwith the same family" \
            geoexport(merge) "0 0"
	form_finish bot
    }

    if [form_wait .conv2mesh] {
	busy 1
	ic_geo_export_to_mesh $geoexport(merge) $geoexport(fams)
	
	initialize_unstruct_visibility
	set data_available(unstruct) 1
	display_update unstruct ; #disp_new_stuff
	busy 0
	mess "Done exporting data.\n"
	
	if $switch { set_phase edit }
    }
}

proc geo_export_selfam {} {
    global geoexport

    set geoexport(fams) [select_families 0 1 0]
}

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

proc geo_get_current_mode {} {
    global geo_command_mode geometry_mode mainwindow_menubar
    
    if $mainwindow_menubar {
	return $geometry_mode
    } else {
	return $geo_command_mode
    }
}

proc geo_family {{type ""}} {
    global tdv_default

    if {$type == ""} {
	# This should be changed - you should be able to edit parameters for
	# all geometry types at once
	set type [geo_get_current_mode]
    }
    
    ic_undo_group_begin
    while 1 {
	set objs [geo_select $type]
	if {$objs == ""} break
	
	set fam [select_families 0 0 1]
	if {$fam == ""} break

	ic_geo_new_family $fam
	
	busy 1
	set pa [tdv_active 0]

	set opt [ic_select_geometry_option]
	if {$opt != ""} {
	    ic_geo_set_family $type $fam $opt $objs
	} else {
	    if {$type == "entity"} {
		foreach n $objs {
		    ic_geo_set_family [lindex $n 0] $fam names [lindex $n 1]
		}
	    } else {
		ic_geo_set_family $type $fam names $objs
	    }
	}
	
	update_fam_window
	tdv_active $pa
	busy 0
    }
    ic_undo_group_end
}

proc geo_replace_entity {{type ""}} {
    #- (Cf. Bug#: 2880 in Bugzilla)
    
    if {$type == ""} { set type [geo_get_current_mode] }
    
    #- the user is prompted to select an entity to be replaced (e1)
    set e1name [geo_select $type]
    #- the user is prompted to select an entity that will replace it (e2)
    set e2name [geo_select $type]
    ic_geo_replace_entity $type $e1name $e2name
}

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

proc geo_copymove {what} {
    global geo_move geometry_mode
    
    if {$what == "geometry_mode"} { set what $geometry_mode }
        
    set name ${what}s
    if {$what == "all"} {
	set name "all geometry"
    }
    set geo_move(type) $what
    set geo_move(entities) ""
    
    set buts {{Apply geo_do_copymove} dismiss}
    set d [form_init .geo_copymove_$what "Move/copy $name" "" $buts]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	
	form_frame $d.whatf flat 0 {0 0 -cols -}
	form_label $d.whatf.l Operation {0 0}
	form_radiobutton $d.whatf.m Move geo_move(what) move {0 1}
	form_radiobutton $d.whatf.c Copy geo_move(what) copy {0 2}

	form_label $d.ncopiesl "Num copies" {2 1}
	form_entry $d.ncopys geo_move(numcopies) int {2 2 -cols 2} \
		{{geo_move(what) copy}}
	
	if {$what != "all"} {
	    form_label $d.entsl Entities {3 1}
	    form_entry $d.ents geo_move(entities) string {3 2 -cols 2}
	    form_frame $d.entsel flat 0 {4 2 -cols 2 -fill none}
	    form_button $d.entsel.eadd "Add" \
		"geo_move_ent_add $what" {0 0}
	    form_button $d.entsel.erem "Remove" \
		"geo_move_ent_remove $what" {0 1}
	    form_button $d.entsel.clear "Clear" geo_move_clear \
		{0 2}
	}
	
	form_colwidth $d 0 4 M
	
	form_checkbutton $d.translate Translate geo_move(do_translate) \
		{10 0 -cols 2}
	form_button $d.transselect Select \
		"med_get_line_2pts \"\" geo_move(translate)" \
		{15 2} geo_move(do_translate)

	form_checkbutton $d.rotate "Rotate (degrees)" geo_move(do_rotate)\
		{20 0 -cols 2}
	form_checkbutton $d.scale Scale geo_move(do_scale) \
		{30 0 -cols 2}
	form_checkbutton $d.mirror Mirror geo_move(do_mirror) \
		{40 0 -cols 2}
	
	form_label $d.about "Transform about" {60 0 -cols 2}
	form_radiobutton $d.origin Origin geo_move(about) origin \
		{60 2 -cols 2}
	form_radiobutton $d.centr Centroid geo_move(about) centroid \
		{61 2 -cols 2}
	form_radiobutton $d.point Point geo_move(about) point \
		{62 2}
	
	form_entry $d.transamount geo_move(translate) coords \
		{10 2 -cols 2} geo_move(do_translate)
	
	form_entry $d.rotamount geo_move(rotate) string {20 2 -cols 2} \
		geo_move(do_rotate)
	form_frame $d.rotf flat 0 {21 2 -cols 2}
	form_radiobutton $d.rotf.x X geo_move(rotaxis) "1 0 0" {0 0} \
		geo_move(do_rotate)
	form_radiobutton $d.rotf.y Y geo_move(rotaxis) "0 1 0" {0 1} \
		geo_move(do_rotate)
	form_radiobutton $d.rotf.z Z geo_move(rotaxis) "0 0 1" {0 2} \
		geo_move(do_rotate)
	form_radiobutton $d.rotf.o Other geo_move(rotaxis) other \
	    {1 0 -cols 2} geo_move(do_rotate)
	form_entry $d.rotf.oe geo_move(rotaxis_other) float \
	    {1 2 -cols 2} \
	    {geo_move(do_rotate) {geo_move(rotaxis) other}}
	form_button $d.rotf.os "Select line" "med_get_line_2pts \
		geo_move(about_point) geo_move(rotaxis_other) \
		geo_move(about) point" {2 0 -cols 4} \
	    {geo_move(do_rotate) {geo_move(rotaxis) other}}	
	
	form_entry $d.scaleamount geo_move(scale) coords_float \
		{30 2 -cols 2} geo_move(do_scale)
	
	form_label $d.mirrnml "Norm" {41 1}
	form_entry $d.mirnmt geo_move(mirrornorm) coords \
		{41 2 -cols 2} geo_move(do_mirror)
	
	form_entry $d.centpoint geo_move(about_point) coords \
	    {62 3} {{geo_move(about) point}}
	form_button $d.centp_set "Select" \
	    "med_get_local_location geo_move(about_point)" \
	    {63 3} {{geo_move(about) point}}

        form_label $d.familyl Family {70 0}
        form_entry $d.family geo_move(family) string {70 1}
	form_button $d.self "Select" \
		"select_family_set_var geo_move(family)" {70 2}

	form_finish bot
    }
    geo_move_clear
    if {$what != "all"} {
	geo_move_ent_add $what
    }
    form_wait .geo_copymove_$what
    
    foreach s $geo_move(entities) {
	ic_show_geo_selected [lindex $s 0] [lindex $s 1] 0
    }
}

proc geo_do_copymove {} {
    global geo_move
    
    if {!$geo_move(do_translate) && \
	    !$geo_move(do_rotate) && \
	    !$geo_move(do_mirror) && \
	    !$geo_move(do_scale)} {
	mess "No operations were selected.\n" red
	return
    }
    
    ic_undo_group_begin
    if {$geo_move(type) == "all"} {
	set entities ""
	foreach ent [ic_geo_get_objects all] {
	    foreach {t n} $ent {
		lappend entities [list $t $n]
	    }
	}
    } else {
	foreach e $geo_move(entities) { set found($e) 1	}
	set entities [array names found]
    }
    
    if {$geo_move(what) == "move"} {
	if {$geo_move(type) == "all"} {
	    geo_move_apply_params "all"
	} else {
	    geo_move_apply_params $entities
	}
    } else {
	## need to make copy work for "all as well!!
	set otr $geo_move(translate)
	set orot $geo_move(rotate)
	for {set i 0} {$i < $geo_move(numcopies)} {incr i} {
	    set nents ""
	    foreach e $entities {
		set ne [eval ic_geo_duplicate $e]
		lappend nents [list [lindex $e 0] $ne]
	    }
	    geo_move_apply_params $nents
	    
	    if $geo_move(do_translate) {
		set tt ""
		set tr $geo_move(translate)
		foreach j {0 1 2} {
		    lappend tt [expr {[lindex $tr $j] + [lindex $otr $j]}]
		}
		set geo_move(translate) $tt
	    }
	    if $geo_move(do_rotate) {
		set geo_move(rotate) [expr {$geo_move(rotate) + $orot}]
	    }
	}
	set geo_move(translate) $otr
	set geo_move(rotate) $orot
    }
    ic_undo_group_end
}

proc geo_move_apply_param {t ns all_cent} {
    global geo_move
    
    switch $geo_move(about) {
	origin   { set cent "0 0 0" }
	centroid { set cent $all_cent }
	point    { set cent $geo_move(about_point) }
    }
    if $geo_move(do_translate) {
	ic_move_geometry $t names $ns translate $geo_move(translate)\
		newfam $geo_move(family)
    }
    if $geo_move(do_rotate) {
	set axis $geo_move(rotaxis)
	if {$axis == "other"} { set axis $geo_move(rotaxis_other) }
	ic_move_geometry $t names $ns rotate $geo_move(rotate) \
		rotate_axis $axis cent $cent newfam $geo_move(family)
    }
    if $geo_move(do_scale) {
	set ms $geo_move(scale)
	if {[llength $ms] == 1} { set ms "$ms $ms $ms" }
	ic_move_geometry $t names $ns scale $ms cent $cent \
		newfam $geo_move(family)
    }
    if $geo_move(do_mirror) {
	ic_move_geometry $t names $ns mirror $geo_move(mirrornorm) \
		cent $cent newfam $geo_move(family)
    }
}

proc geo_move_apply_params {ents} {   
    foreach ee $ents {
	lappend entl([lindex $ee 0]) [lindex $ee 1]
    }
    set all_cent ""
    set bb [ic_geo_bounding_box [array get entl]]
    foreach x1 [lindex $bb 0] x2 [lindex $bb 1] {
	lappend all_cent [expr {($x1 + $x2) / 2.0}]
    }    
    if {"all" == $ents} {
	geo_move_apply_param all "" $all_cent
    } else {
	foreach e $ents {
	    set t [lindex $e 0]
	    set ns [list [lindex $e 1]]	    
	    geo_move_apply_param $t $ns $all_cent
	}
    }
}

proc geo_move_ent_add {what} {
    global geo_move
    
    set stuff [geo_select $what]
    foreach s $stuff {
	if {$what == "entity"} {
	    lappend geo_move(entities) $s
	    ic_show_geo_selected [lindex $s 0] [lindex $s 1] 1
	} else {
	    lappend geo_move(entities) [list $what $s]
	    ic_show_geo_selected $what $s 1
	}
    }
}

proc geo_move_ent_remove {what} {
    global geo_move
    
    set stuff [geo_select $what]
    set del ""
    foreach s $stuff {
	if {$what == "entity"} {
	    lappend del $s
	    ic_show_geo_selected [lindex $s 0] [lindex $s 1] 0
	} else {
	    lappend del [list $what $s]
	    ic_show_geo_selected $what $s 0
	}
    }
    set geo_move(entities) [ldelete_multiple $geo_move(entities) $del]
}

proc geo_move_clear {} {
    global geo_move
    
    set geo_move(entities) ""
}

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

proc geo_thincuts {} {
    global thincut_data
    
    set thincut_data [ic_geo_get_thincuts]
    
    if [futil_edit_list .thincuts "Thin cuts" thincut_data top \
	    geo_thincut_select] {
	ic_geo_set_thincuts $thincut_data
    }
}

proc geo_thincut_select {var} {
    upvar \#0 $var lvar
    
    set f1 [select_families 0 0 0 "Select the first family"]
    set f2 [select_families 0 0 0 "Select the second family"]
    if {($f1 == "") || ($f2 == "")} return
    set lvar "$f1 $f2"
}

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

proc geo_periodic {} {
    global periodic_data
    
    array set periodic_data [ic_geo_get_periodic_data]
    set d [form_init .periodic "Periodicity"]
    if {$d != ""} {
	form_radiobutton $d.none "Not periodic" \
	    periodic_data(type) none {0 0 -cols -}
	form_radiobutton $d.rot "Rotational periodic" \
	    periodic_data(type) rot {10 0 -cols -}
	form_radiobutton $d.trans "Translational periodic" \
	    periodic_data(type) trans {20 0 -cols -}
	
	form_colwidth $d 0 4 M
	
	set act {{periodic_data(type) rot}}
	form_label $d.basel "Base" {11 1} $act
	form_label $d.axisl "Axis" {12 1} $act
	form_label $d.anglel "Angle" {13 1} $act
	form_entry $d.base periodic_data(base) coords {11 2}
	form_entry $d.axis periodic_data(axis) coords {12 2}
	form_entry $d.angle periodic_data(angle) float {13 2}
	
	set act {{periodic_data(type) trans}}
	form_label $d.offl "Offset" {21 1} $act
	form_entry $d.off periodic_data(axis) coords {21 2}
	
	form_finish bot
    }
    if [form_wait .periodic] {
	ic_geo_set_periodic_data [array get periodic_data]
    }
}

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

proc geo_delete_unattached {} {
    set mess "Really delete all unattached curves/points?"
    if [tk_dialog .delete_all "Delete all" $mess "" -1 \
	    Yes No] return
    ic_geo_delete_unattached
}

proc geo_remove_feature {} {
    set ents [geo_select curve]
    if {$ents == ""} return
    ic_geo_remove_feature $ents
}

# JKA: Instead of telling user to "run Geometry Repair", ask to build_topo.
# I have made this a function since I use it twice in creating loops above,
# and since it may be more involved.

proc geo_prompt_build_topology {} {
    global geo_cad
    set build_it [expr ![tk_dialog .merge_by_id "Build topology?" \
        "Could not find proper adjacency. Would you like to build the toplogy?" \
        "" -1 "Yes" "No"]]
    if $build_it {
        set geo_cad(filter_points) 0
        set geo_cad(filter_curves) 0
        geo_build_topo
    }
    return $build_it
}

proc geo_build_topo {} {
    global geo_cad

    set buts [list [list Apply   "geo_clean_apply"] dismiss]
    set d [form_init .build_topo "Build topology params" "" $buts]
    # geo_cad default values are set in params_med.tcl
    if { [ info exists geo_cad(all_fams) ] == 0 } {
        set geo_cad(all_fams) 1
    }
    if { [ info exists geo_cad(create_interior) ] == 0 } {
        set geo_cad(create_interior) 1
    }
    if {$d != ""} {
        set ln 0
        form_label $d.toll "Tolerance" "$ln 0"
        form_entry $d.tol geo_cad(toler) float "$ln 1"

        incr ln
        form_label $d.anglel "Filter angle" "$ln 0"
        form_entry $d.angle geo_cad(angle) float "$ln 1"

        incr ln
        form_checkbutton $d.filter_points "Filter points" \
            geo_cad(filter_points) "$ln 0"

        incr ln
        form_checkbutton $d.filter_curves "Filter curves" \
            geo_cad(filter_curves) "$ln 0"

        incr ln
        form_checkbutton $d.reg_surfs "Auto Segmentation" \
            geo_cad(reg_surfs) "$ln 0"

        incr ln
        form_checkbutton $d.concat_crvs "Concatinate curves" \
            geo_cad(concat_crvs) "$ln 0"

        incr ln
        form_checkbutton $d.create_interior "Create Interior Curves" \
            geo_cad(create_interior) "$ln 0"

        incr ln
        form_radiobutton $d.allf "All families" geo_cad(all_fams) 1 \
            "$ln 0"

        incr ln
        form_radiobutton $d.self "Active families" \
            geo_cad(all_fams) 0 "$ln 0"

        incr ln
        form_label $d.new_faml "Family for new entities" \
            "$ln 0"
        set famnames "-inherited [ get_famnames ]"
        set geo_cad(new_family) "-inherited"
        futil_listentry $d.new_fams geo_cad(new_family) \
            "list $famnames" " $ln 1 "

        incr ln
        form_checkbutton $d.save "Save old entities" \
            geo_cad(save_old) "$ln 0"

        incr ln
        form_checkbutton $d.delete_degen "Delete degenerate surfaces" \
                geo_cad(delete_degenerate) "$ln 0"

	incr ln
        form_checkbutton $d.quiet "Run quietly" \
            geo_cad(quiet) "$ln 0"

        form_finish bot
    }
    return [form_wait .build_topo]
}

proc geo_clean_apply {} {
    global geo_cad fam_visible

    set args "$geo_cad(toler) -angle $geo_cad(angle)"
    if { $geo_cad(create_interior) } {
	append args " -create_interior"
    }
    if { $geo_cad(filter_points) } {
        append args " -filter_points"
    } 
    if { $geo_cad(filter_curves) } {
        append args " -filter_curves"
    }
    if { $geo_cad(all_fams) == 0 } {
        foreach i [ array names fam_visible ] {
                if { $fam_visible($i) } {
                        append args " $i"
                }
        }
    }
    if { $geo_cad(new_family) != "" && $geo_cad(new_family) != "-inherited" } {
        append args " -new_family $geo_cad(new_family)"
    }
    if { $geo_cad(save_old) } {
        append args " -save_old"
    }
    if { !$geo_cad(reg_surfs) } {
        append args " -no_reg_surf"
    }
    if { !$geo_cad(concat_crvs) } {
        append args " -no_concat"
    }
    if { $geo_cad(quiet) } {
        append args " -quiet"
    }
    if { $geo_cad(delete_degenerate) } {
        append args " -delete_degenerate"
    }

    eval ic_build_topo $args

}

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

proc geo_fix_gaps {{toggle 0}} {
    global geo_cad str_option

    if $toggle {
        if $geo_cad(advanced) {
            set geo_cad(advanced) 0
        }  else {
            set geo_cad(advanced) 1
        }
        form_kill .fixgaps
    }
    set d [form_init .fixgaps "Gap fixing parameters" "" close]
    if {$d != ""} {
# tolerance
        set ln 0
        form_frame $d.tol flat 0 "$ln 0"
        form_label $d.tol.l "Tolerance" "$ln 0"
        form_entry $d.tol.e geo_cad(toler) float "$ln 1"

# family name for new entities
        if $geo_cad(advanced) {
            incr ln
            form_frame $d.new_fam flat 0 "$ln 0"
            form_label $d.new_fam.1 "Family for new entities" "$ln 0"
            set famnames "-inherited [ get_famnames ]"
            futil_listentry $d.new_fam.2 geo_cad(new_family) "list $famnames" "$ln 1"
        }
#
# create topology
#
        incr ln
        form_button $d.retopo "Create topology" geo_repair_update_topo "$ln 0"

        if $geo_cad(advanced) {
            incr ln
            form_checkbutton $d.rebuild "Rebuild after changes" \
                geo_cad(rebuild_topo) "$ln 0"

            incr ln
            form_radiobutton $d.allf "All families" geo_cad(all_fams) 1 "$ln 0"

            incr ln
            form_radiobutton $d.self "Active families" geo_cad(all_fams) 0 "$ln 0"
        }

        incr ln
        form_checkbutton $d.reg_surfs "Regularize surfaces" geo_cad(reg_surfs) "$ln 0"

        incr ln
        form_checkbutton $d.only_single "Only on single curves" geo_cad(single_curves) "$ln 0"

        if $geo_cad(advanced) {
            incr ln
            form_checkbutton $d.save "Save old entities" geo_cad(save_old) "$ln 0"

            incr ln
            form_checkbutton $d.delete_degen "Delete degenerate surfaces" \
            geo_cad(delete_degenerate) "$ln 0"

        }
#
# faceted repair (to be improved !!)
#
        incr ln
        form_button $d.stitch "Stitch faceted edges" {
            geo_stlrepair_edges $geo_cad(select_with_curves) \
                $geo_cad(merge_tol) $geo_cad(merge_ends)
        } "$ln 0"


        if $geo_cad(advanced) {
            incr ln
            form_checkbutton $d.merge_ends "Merge ends" geo_cad(merge_ends) "$ln 0"

            incr ln
            form_checkbutton $d.selc "Select using curves" \
                geo_cad(select_with_curves) "$ln 0"
            #incr ln
            #form_frame $d.mergetol flat 0 "$ln 0"
            #form_label $d.mergetol.1 "Merge tolerance" "$ln 0"
            #form_entry $d.mergetol.2 geo_cad(merge_tol) float "$ln 1"
        }

        incr ln
        form_button $d.closeh "Close faceted holes" {
            geo_stlrepair_holes $geo_cad(select_with_curves) \
            $geo_cad(select_internal) $geo_cad(int_surf) 1 \
            $geo_cad(save_old)
        } "$ln 0"

        if $geo_cad(advanced) {
            incr ln
            form_checkbutton $d.selc2 "Select using curves" \
                geo_cad(select_with_curves) "$ln 0"

            incr ln
            form_checkbutton $d.seli "Allow internal edge selection" \
                geo_cad(select_internal) "$ln 0"

            incr ln
            form_checkbutton $d.surf "Interpolation surface" geo_cad(int_surf) "$ln 0"

        }
#
#   NURBS/faceted repair
#
        incr ln
        # do = 1 = close gaps
        form_button $d.closeg "Close gaps" "geo_fix_gaps_apply 1" "$ln 0"

        incr ln
        form_frame $d.maxtol flat 0 "$ln 0"
        form_label $d.maxtol.1 "Max. gap distance" "$ln 0"
        form_entry $d.maxtol.2 geo_cad(toler_max) float "$ln 1"

        incr ln
        form_frame $d.p flat 0 "$ln 0"
        form_checkbutton $d.p.partial "Partial" geo_cad(partial) "$ln 0"
        form_checkbutton $d.p.perpendicular "Tangential" geo_cad(perpendicular) "$ln 1"

        if $geo_cad(advanced) {
            incr ln
            form_checkbutton $d.yellow "Single curves only" geo_cad(yellow) "$ln 0"
        }

        incr ln
        form_frame $d.close flat 0 "$ln 0"
        # do = 2 = match
        form_button $d.close.match "Match" "geo_fix_gaps_apply 2" "$ln 0"
        # extend
        form_button $d.close.extend "Extend" "geo_surface_extend" "$ln 1"

        incr ln
        # do = 3 = close one hole
        #    = 4 = close multiple holes
        form_button $d.close2 "Close holes" "geo_fix_gaps_apply 3" "$ln 0"

        incr ln
        form_checkbutton $d.multiple "Multiple" geo_cad(multiple) "$ln 0"

        incr ln
        form_button $d.reovef "Remove feature" "geo_remove_feature" "$ln 0"

#
#   advanced options
#
        incr ln
        if $geo_cad(advanced) {
            form_button $d.advanced "Don\'t show advanced options" {geo_fix_gaps 1} \
                "$ln 0"
        } else {
            form_button $d.advanced "Show advanced options" {geo_fix_gaps 1} "$ln 0"
        }
        
        form_colwidth $d 0 2 M
        form_finish bot
    }
    set str_option(curve,count) 1
    update_geom_visible curve p
}

proc geo_fix_gaps_apply {do} {
    global geo_cad

    #
    # do = 1 = close gaps
    #    = 2 = match
    #    = 3 = close one hole
    #    = 4 = close multiple holes
    #
    if {$do == 3} {
       set do [expr 3 + $geo_cad(multiple)]
    }
    while 1 {
        # In non-mult mode we do auto-continue.
        set curves [geo_select curve]
        if {$curves == ""} break

        if [ic_geo_gap_repair toler $geo_cad(toler) toler_max $geo_cad(toler_max) \
            new_family $geo_cad(new_family) curves $curves do $do \
            partial $geo_cad(partial) yellow $geo_cad(yellow)] {
            if $geo_cad(rebuild_topo) {
                geo_repair_update_topo
            }
        }
        if {($do != 1) || ([llength $curves] > 2)} break
    }
    ic_geo_reset_data_structures
}

proc geo_surface_extend {} {
    global geo_cad

    set curve [geo_select curve 0 "\"yellow\" edge to extend"]
    if {$curve == ""} return
    set surfaces [geo_select surface 0 "surface(s) to extend to"]
    if {$surfaces == ""} return
    set bld_topo 1
    set connect  1
    ic_undo_group_begin
    ic_geo_surface_extend $curve $surfaces $geo_cad(toler) $bld_topo \
        $geo_cad(perpendicular) $connect
    ic_undo_group_end
}

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

proc geo_coarsen_surface {{tol ""}} {
    set surfs [geo_select surface]
    if {$surfs == ""} return
    
    set curves [geo_select curve 0 "curves to preserve"]
    
    set points [geo_select point 0 "points to preserve"]
    
    # get the minimum edge length
    set minl [ic_geo_min_edge_length surface $surfs]
    if {0 > $minl} { set minl [expr $minl * -1] }
    if {$tol==""} {set tol [expr $minl / 10.0] }
    
    set csurfs ""
    foreach s $surfs { lappend csurfs "surface $s" }    
    set bb [ic_geo_bbox_of_entities $csurfs]
    set sm -1
    foreach i {0 1 2} {
	set d [expr [lindex [lindex $bb 1] $i] - [lindex [lindex $bb 0] $i]]
	if {($sm < 0) || ($d < $sm)} { set sm $d }
    }

    # ask for a tolerance
	if {$tol == ""} {
    set ttol [ic_geo_get_triangulation_tolerance]
    set tol [question_box .coartol "Coarsen surface" "Coarsening tolerance?\n(Min edge = $minl, model\nmin dim = $sm, tri tol = $ttol)" $tol]
    }
    if {"" == $tol} return
    
    ic_geo_coarsen surfaces $surfs curves $curves points $points \
	    tol $tol n_iter 4 minl $minl
	foreach name $points {
		object_show_geo_selected [get_object_by_name point $name] 0
	}
	foreach name $curves {
		object_show_geo_selected [get_object_by_name curve $name] 0
	}
	foreach name $surfs {
		object_show_geo_selected [get_object_by_name surface $name] 0
	}
}

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

proc geo_stlrepair_holes {use_curves intern int_surf complete_edges save_old {part ""}} {
    global geo_cad

    if $intern {
        set bound_edge edge
    } else {
        set bound_edge bound_edge
    }
    if $int_surf {
        set add_nodes 1
    } else {
        set add_nodes 0
    }
    
    while 1 {
        if $use_curves {
            set xxx [geo_select_segments_via_curves]
            set segs [lindex $xxx 0]
            set dcurves [lindex $xxx 1]
            #set mode "surface"
        } else {
            set segs [geo_select_segments all_surfaces "" $bound_edge]
            set dcurves ""
            #set mode "object"
        }
        if {$segs == ""} return
        ic_undo_group_begin
        set ok [ic_geo_stlrepair_holes surface $segs $add_nodes $int_surf $complete_edges $dcurves "" $part]
        if {$ok && !$save_old} {
            ic_delete_geometry curve names $dcurves
        }
        ic_undo_group_end

        if $geo_cad(rebuild_topo) {
            geo_repair_update_topo
        }
    }
}

proc geo_stlrepair_edges {use_curves merge_tol {merge_ends -1}} {
    global geo_cad

    while 1 {
        if $use_curves {
            set segs [lindex [geo_select_segments_via_curves] 0]
        } else {
            set segs [geo_select_segments all_surfaces "" bound_edge]
        }
        if {$segs == ""} return

        ic_geo_stlrepair_edges surface $segs $merge_tol $merge_ends

        if $geo_cad(rebuild_topo) {
            geo_repair_update_topo
        }
    }
}

proc geo_repair_update_topo {} {
    global geo_cad fam_visible str_option
    
    ic_undo_group_begin
    ic_geo_fixup 1
    mess "Updating topology ...\n"
    set args "$geo_cad(toler)"
    if { [ info exists geo_cad(create_interior) ] == 0 } {
	set geo_cad(create_interior) 1
    }
    if { $geo_cad(create_interior) } {
	append args " -create_interior"
    }
    if { $geo_cad(all_fams) == 0 } {
        foreach i [ array names fam_visible ] {
            if { $fam_visible($i) } {
                append args " $i"
            }
        }
    }
    if { $geo_cad(new_family) != "" && \
             $geo_cad(new_family) != "-inherited" } {
        append args " -new_family $geo_cad(new_family)"
    }
    if { $geo_cad(save_old) } {
        append args " -save_old"
    }
    if { !$geo_cad(reg_surfs) } {
        append args " -no_reg_surf"
    }
    if { $geo_cad(single_curves) } {
        append args " -only_singles"
    }
    if { $geo_cad(delete_degenerate) } {
        append args " -delete_degenerate"
    }
    eval ic_build_topo $args
    if { !$geo_cad(save_old)  && $geo_cad(all_fams) } {
        ic_geo_delete_unattached
    }
    set str_option(curve,count) 1
    set str_option(curve,wide) 1
    update_geom_visible curve p
    mess "done.\n"
    ic_undo_group_end
}

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

proc point_question_location {pt} {
    set pt [ic_coords_into_local $pt]
    set mess "New position?"
    set cc [ic_csystem_get_current]
    if {($cc != "") && ($cc != "global")} {
	append mess "(In the \"$cc\" system.)"
    }
    set npt [question $mess $pt]
    if {$npt == ""} { return "" }
    return [ic_coords_into_global $npt]
}

proc geo_modify_surface_untrim {} {
    foreach obj [geo_select surface] {
	set type [ic_geo_get_object_type surface $obj]
	switch $type {
	    param  {
		ic_geo_untrim_surface $obj
	    }
	    default {
		error "you cannot untrim a $type surface"
	    }
	}
    }
    update_geom_visible surface p 1
}

proc geo_modify_curve_merge { } {
    set curves [geo_select curve 2]
    if { [ llength $curves ] != 2 } { error "You must select 2 curves." }
    ic_geo_merge_curves $curves
}

proc geo_modify_curve_reappr { } {
    set curves [geo_select curve]
    if { [llength $curves] < 1 } return
    set tol [question_box .crv_reappr_tol Tolerance \
        "Enter a reapproximation tolerance.\n" 0.01]
    if {$tol == ""} return
    ic_geo_modify_curve_reappr $curves $tol
}

proc geo_modify_surface_reappr {selcurves selsurfaces ask each} {
    #
    #   selcurves = select curves
    #   selsurfaces = select surfaces
    #   ask  = prompt to accept approximation surface(s) if set
    #   each = reapproximate each surface seperately if set
    #
    set curves ""
    set surfaces ""
    if {$selcurves == 1} { set curves [geo_select curve] }
    if {$selsurfaces == 1} { set surfaces [geo_select surface] }
    if { ([llength $curves] < 1) && ($selcurves == 1) } return
    if { ([llength $surfaces] < 1) && ($selcurves == 0) } return
    set tol [question_box .srf_reappr_tol Tolerance \
        "Enter a reapproximation tolerance.\n" 0.01]
    if {$tol == ""} return
    ic_geo_modify_surface_reappr $surfaces $tol $ask $each $curves
}

proc geo_modify_object_facetize {what} {
    set surfs [geo_select $what]
    if { $surfs == "" } return
    
    set del [tk_dialog .del_old "Delete" "Delete the old CAD ${what}s?" \
		 "" -1 "No" "Yes"]
    set tot [llength $surfs]
    set got 0
    interrupt init
    foreach name $surfs {
	set res [ic_facetize_geometry $what $name]
	if { $res != "" && $del } {
	    ic_delete_geometry $what names $name
	}
	incr got
	if [interrupt check $got $tot] break
    }
    interrupt finish
}

proc geo_frontal {} {
    global frontal_values
    
    set d [form_init .frontal "Frontal parameters"]
    if {$d != ""} {
	form_label $d.toll "Relative tolerance" {0 0}
	form_entry $d.tol frontal_values(tol) float {0 1 -cols 2}
	form_label $d.dirl "Direction" {5 0}
	form_label $d.dirxl "X" {5 1}
	form_label $d.diryl "Y" {6 1}
	form_label $d.dirzl "Z" {7 1}
	form_entry $d.dirx frontal_values(x) float {5 2}
	form_entry $d.diry frontal_values(y) float {6 2}
	form_entry $d.dirz frontal_values(z) float {7 2}
	form_finish bot
    }
    if ![form_wait .frontal] return
    
    set dir [list $frontal_values(x) $frontal_values(y) $frontal_values(z)]
    ic_run_frontal dir $dir tol $frontal_values(tol)
}

proc geo_surface_area {} {
    set sf [geo_select surface]
    if {$sf == ""} { return }
    set area 0.0
    foreach s $sf {
      set area [expr [ic_geo_srf_area $s] + $area]
    }
    mess "Surface area: $area\n"
}

proc geo_project_curve_surface {} {
    global geo_modify
    
    set on_what [select_geometry surface 0 "the surfaces to project to"]
    if {$on_what == ""} {
	return
    }
    foreach s $on_what {
	show_geo_selected $s 1
    }
    
    set d [form_init .geo_modify_proj_curve "Project curve nodes" "" nobuttons]
    if {$d != ""} {
	set geo_modify(project_curve_surface) near
	
	form_radiobutton $d.nearest "Nearest point" \
	    geo_modify(project_curve_surface) near {0 0}
	form_radiobutton $d.x "X direction" \
	    geo_modify(project_curve_surface) x {1 0}
	form_radiobutton $d.y "X direction" \
	    geo_modify(project_curve_surface) y {2 0}
	form_radiobutton $d.z "X direction" \
	    geo_modify(project_curve_surface) z {3 0}
	form_finish bot
    }
    ic_undo_group_begin
    while 1 {
	set curves [select_geometry curve 0 "" 0 1]
	if {$curves == ""} break
	foreach curve $curves {
	    if {[ic_geo_get_object_type curve $curve] != "mesh"} {
		mess "That curve is not a mesh curve - can't edit\n" red
		continue
	    }
	    
	    set nnodes [lindex [ic_geo_num_segments curve $curve] 1]
	    set nm 0
	    for {set i 0} {$i < $nnodes} {incr i} {
		set pt [ic_geo_get_node curve $curve $i]
		switch $geo_modify(project_curve_surface) {
		    near { set dir "0 0 0" }
		    x { set dir "1 0 0" }
		    y { set dir "0 1 0" }
		    z { set dir "0 0 1" }
		}
		set npt [ic_geo_project_point surface $on_what $pt $dir]
		if {$npt != ""} {		    
		    #$projlib move_curve_node $sn $i $npt
		    ic_geo_set_node curve $curve $i $npt
		    incr nm
		}
	    }
	    mess "Moved $nm curve nodes out of $nnodes\n"
	    ic_geo_finish_edit curve $curve
	}
    }
    ic_undo_group_end

    foreach s $on_what { show_geo_selected $s 0 }
    form_done .geo_modify_proj_curve
}

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

# Pick some items on the screen and return their names.
# If med_selection_mode == "allow_all_visible_blanked" function can return "all","visible","blanked"
# For safety "med_selection_mode" must be set before each usage.    
proc geo_select {what {max_num 0} {mess ""} {create_new 0} \
		     {only_facet 0} {not_these ""} {inc_switch 0} {pre_select ""} \
		     {unhighlight_after_select 0} {only_if_dormant 0}} {
    global med_selection_mode
    
    set what1 $what
    if {$what == "curve_or_compcurve"} { set what1 curve }
    
    #VG 03/21/05 Next lines enable proc on Motion, 
    #   09/12/05 [info command] deleted, radius=f(#objects) added
    global vam_events select_option
    set select_option(onMotionEvent) onMotionEventProc
    set select_option(onMotionEventEnd) onMotionEventEndProc	 
    set vam_events(onMotion) DefaultMotionProc 
    #fifi 10/13/05 Disbale count in case of force_done (Defect ID 39529)
    #VG 10/26/05 : set onMotion_radius 10 (pixels) 
	# see select_geom.tcl, med_ezcad.tcl on related functions
    if {$what1 == "force_done"} {
        set res 1
    } else {
        set res [catch "ic_geo_num_visible_objects $what1" num_objects]
    }
    if {$res || ($num_objects < 1000)} {
	set r 10
    } else {
	set r -10
    }
    set vam_events(onMotion_radius) $r 
    
 
    if {$what1 == "force_done"} {
	return [select_geometry_force_done done]
    }
    set not_these_objects ""
    foreach n $not_these {
	lappend not_these_objects [get_object_by_name $what1 $n]
    }
    set objects [select_geometry $what $max_num $mess $create_new $only_facet \
		     $not_these_objects $inc_switch $pre_select "" $only_if_dormant]
		     
 # Return keyword on all-visible-blanked
    if {$objects == "all" || $objects == "visible" || $objects == "blanked"} {
		return "$objects"
	}
	
    if {$objects == "switch_selection_type"} { return switch_selection_type }
    
    set names ""
    # foreach obj $objects { lappend names [$obj get -name] }
    foreach obj $objects {
	if {($what1 == "entity") || ([llength $what1] > 1)} {
	    lappend names [list [object_geotype_of_image $obj] \
			       [object_name_of_image $obj]]
	} else {
	    lappend names [object_name_of_image $obj]
	}
	if $unhighlight_after_select {
	    object_show_geo_selected $obj 0
	}
    }
    return $names
}

# This is so that AI*Env can do filtering - not the best mechanism

proc geo_select_either_set_prefix {pref} {
    global geo_select_either_prefix
    if {$pref == ""} {
	catch {unset geo_select_either_prefix}
    } else {
	set geo_select_either_prefix $pref
    }
}

proc geo_select_either {what {max_num 0} {mess ""} {create_new 0} \
			    {only_facet 0} {not_these ""} {pre_select ""}} {
    global select_action options tdv_mouse_bindings geom_visible projlib
    global fam_visible select_geometry_option select_option
    global tdv_default geo_select_either_prefix
    global str_type_visible ai_environment 

    set ok_sel ""
    set include_unsmap_word 0
    set what_n $what
    if {$what == "any"} {
	if [info exists unused___geo_select_either_prefix] {
	    set what ""
	    foreach sd {0 1 2 3} {
		# In all other places in the code we select geometry if it's
		# visible, and mesh if it isn't.  When we're selecting for
		# subsets we have to do the same thing and share the same
		# set of buttons.
		if 0 {
		    set ok [uplevel set ${geo_select_either_prefix}geo_${sd}d]
		    #set ok [uplevel set ${geo_select_either_prefix}mesh_${sd}d]
		    if $ok {
			if {$sd == "0"} {
			    lappend what node
			} else {
			    lappend what ${sd}d
			}
		    }
		}
		set varname ${geo_select_either_prefix}geo_${sd}d
		global $varname
		if ![info exists $varname] continue
		set ok [set $varname]
		if $ok {
		    lappend what [lindex {point curve surface material} $sd]
		}
		# We can't let these variables get changed during selection.
		# This messes up ai*environment ..  Just remember what they
		# were and set them back in case the user changed them.
		# not sure if this is needed
		# set to_reset(${geo_select_either_prefix}geo_${sd}d) $ok
	    }
	    set n [llength $what]
	    if {$n == 0} {
		set what entity
	    } elseif {$n > 1} {
		set what_n ""
		for {set i 0} {$i < $n - 1} {incr i} {
		    append what_n "[lindex $what $i], "
		}
		append what_n "or [lindex $what $i]"
	    } else {
		set what_n $what
	    }
	} else {
	    set what entity
	}
	set include_unsmap_word 1
    }
    
    set force_mesh 0
    if {[info exists ai_environment] && $ai_environment} {
        set current_vis_tab $::AIEnv::GUIManagement::CurrentVisibleTab
        if {$current_vis_tab == "MeshEditBar" && ([ic_uns_is_loaded] || [ic_str_is_loaded])} {
            set force_mesh 1
         }
    }
    if $force_mesh {
        set selmesh 1
    } else {
        set selmesh [expr {![ic_geo_num_visible_objects $what 1] && ([ic_uns_is_loaded] || [ic_str_is_loaded])}]
    }
    while 1 {
	if $selmesh {
	    mess "Selecting mesh.\n"
	    set what2 ""
	    foreach i {0 1 2 3} {
		set sopt($i) [expr {![info exists select_option($i)] || $select_option($i)}]
	    }
	    foreach wha $what {
		switch $wha {
		    entity { lappend what2 element }
		    body - material { if $sopt(3) { lappend what2 3d } }
		    surface { if $sopt(2) { lappend what2 2d } }
		    curve { if $sopt(1) { lappend what2 1d } }
		    point { if $sopt(0) { lappend what2 node } }
		}
	    }
	    
	    if [ic_uns_is_loaded] {
		set from_names [ic_uns_subset_list_visible]
		set map [select_unstruct $what2 $max_num $from_names "" $mess select \
			     0 0 1 $pre_select]
		if {$map == ""} {
		    set retvalue ""
		} elseif {$include_unsmap_word && ($map != "switch_selection_type")} {
		    set retvalue [list unsmap $map]
		} else {
		    set retvalue $map
		}
	    } elseif {[ic_str_is_loaded]} {						
		if {$what == "entity"} {
		    set what ""
		    foreach name [array names str_type_visible] {
			if $str_type_visible($name) {
			    lappend what $name
			}
		    }
		    
		    mess "selecting $what\n"
		    if {[llength $what] != 1} {
			mess "Warning: Please Turn ON only the specific structured entity type to select\n" red
			return
		    }
		}
		set retvalue ""
		set nums [select_struct_surf $what 0 item default "$what to change"]
		if {$nums != ""} {
		    set retvalue [list $what \{$nums\}]
		}
	    }
	} else {
	    mess "Selecting geometry.\n"
	    set retvalue [geo_select $what $max_num $mess $create_new $only_facet \
			      $not_these 1 $pre_select]
	}
	if {$retvalue == "switch_selection_type"} {
	    set selmesh [expr !$selmesh]
	} else {
	    break
	}
    }
    
    #foreach n [array names to_reset] { uplevel set $n $to_reset($n) }
    
    return $retvalue
}

# Pick geometry segments

proc geo_select_segments {type name sel_type {max_num 0} {first_diff 0} {also_xyz 0} {show_selected 0} {bindings_already_done 0} {no_unify 0}} {
    # if bsp configure !visible - set temporary visible . Do not update visibility!
    # bsp may be visible as subset.
    set bsp_is_visible 1 
    switch $type {
	    all_surfaces - all_curves { set from $type }
	    default {
	        set from [list $type $name]
	        set bsp_is_visible [ic_geo_configure_one_object $type $name visible]
	        if {$bsp_is_visible == 0} {
		        ic_geo_configure_one_object $type $name visible 1
	        }
	    }
    } 
    set res [select_geometry_segments $from $sel_type $max_num $first_diff $also_xyz $show_selected $bindings_already_done $no_unify]
    if {$bsp_is_visible == 0} {
        ic_geo_configure_one_object $type $name visible 0		
    }
    return $res
}

# Pick geometry segments using curves

proc geo_select_segments_via_curves {} {
    set curves [geo_select curve]
    if {$curves == ""} return
    
    # Now get all the boundary segments from these curves.
    set got_surfs ""
    foreach cc $curves {
        if {[ic_geo_get_object_type curve $cc] == "param"} {
            mess "Parametric curve skipped.\n" red
            continue;
        }
        set isurfs [ic_geo_incident curve $cc]
        foreach surf $isurfs {
            set edges [ic_geo_surface_edges_incident_to_curve $surf $cc]
            lappend segs_surf($surf) $edges
            lappend got_surfs $surf
        }
    }
    set segs ""
    foreach surf $got_surfs {
        if [info exists segs_surf($surf)] {
            lappend segs [list $surf $segs_surf($surf)]
            unset segs_surf($surf)
        }
    }
    if {$segs == ""} {
        mess "No surfaces are adjacent to those curves\n" red
    }
    return [list $segs $curves]
}

proc geom_get_objects {type how {only_if_dormant 0}} {
    if !$only_if_dormant {
        return [batch_interp eval geom_get_objects \"$type\" \"$how\"]
    } else {
        return [batch_interp eval geom_get_objects \"$type\" \"$how\" 0 1]
    }
}

proc geo_select_loc {what var} {
    global projlib
    upvar \#0 $var lvar
    
    switch $what {
	point {
	    set pt [geo_select $what 1]
	    if {$pt != ""} {
# Just return the point name for scripting
		set lvar $pt; return
		#set pos [ic_get_point_location $pt]
		#set lvar [ic_coords_into_local $pos]
	    }
	}
	surface_node {
	    set what surface
	    set surf [geo_select $what 1 "" 0 1]
	    if {$surf == ""} return
	    set node [geo_select_segments surface $surf node 1 0 0 1]
	    if {$node == ""} return

	    set pt [ic_geo_get_node $what $surf [lindex $node 0]]
	    ic_geo_highlight_segments $what $surf remove node all

	    if {$pt == ""} return
	    set lvar [ic_coords_into_local $pt]
	}
    }
}

proc geo_select_part_from_screen {{max_num 0}} {
    set stuff [geo_select_either entity]
    
    foreach item $stuff {
	switch [lindex $item 0] {
	    surface - curve - point - body - material {
		set part [ic_geo_get_part [lindex $item 0] [lindex $item 1]]
		if {$part != ""} { set parts($part) 1 }
		ic_show_geo_selected [lindex $item 0] [lindex $item 1] 0
	    }
	    default {
		foreach ff [ic_uns_subset_families_used $item 1] {
		    set parts($ff) 1
		}
		ic_uns_subset_delete $item
	    }
	}
    }
    set pp [array names parts]
    if $max_num { set pp [lrange $pp 0 [expr $max_num - 1]] }
    return $pp
}

proc geo_create_curve_proj_to_surface { } {
    set buts {{Create {geo_create_curve_proj_doit}} dismiss}
    set d [form_init .geo_create_curve_proj "Project curve" "" \
	       $buts]
    if {$d != ""} {
	form_label $d.lab1 "Curve(s)" {5 0}
	form_entry $d.ent1 geo_create(curve,proj,curve) string {5 1}
	form_button $d.sel1 "Select" \
		"select_curve_var geo_create(curve,proj,curve) 0"  {5 2}
	
	form_label $d.lab2 "Surface(s)" {6 0}
	form_entry $d.ent2 geo_create(curve,proj,surface) string {6 1}
	form_button $d.sel2 "Select" \
		"select_surface_var geo_create(curve,proj,surface) 0" {6 2}
	
	form_label $d.faml "Family" {10 0}
	form_entry $d.fame geo_create(curve,proj,fam) string {10 1}
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(curve,proj,fam)" {10 2}
	form_label $d.namel "Name" {11 0}
	form_entry $d.namee geo_create(curve,proj,name) string {11 1}
	
	form_finish bot
    }
    form_wait .geo_create_curve_proj

}

proc geo_create_curve_proj_doit {} {
    global geo_create
    
    set fam $geo_create(curve,proj,fam) 
    if { $fam == "" } {
	set fam "proj_curve"
    }

    foreach crv $geo_create(curve,proj,curve) {
	set name $geo_create(curve,proj,name) 
	if { $name != "" }  {
	    set name [ic_geo_new_name curve "$name."]
	} else {
	    set name [ic_geo_new_name curve "$fam."]
	}

	mess "curve $crv\n"
	mess "surface $geo_create(curve,proj,surface)\n"
	mess "name $name\n"
	ic_geo_project_curve_to_surface $crv \
	    $geo_create(curve,proj,surface) $name $fam
    }
}

proc geo_create_surface_curves { } {
    set buts {{Create {geo_create_surface_curves_doit}} dismiss}
    set d [form_init .geo_create_surface_curves \
		"Create surface from curves" ""  $buts]
    if {$d != ""} {
	form_label $d.lab1 "Curve 1" {5 0}
	form_entry $d.ent1 geo_create(surface,curves,curve1) string {5 1}
	form_button $d.sel1 "Select" \
		"select_curve_var geo_create(surface,curves,curve1)"  {5 2}
	
	form_label $d.lab2 "Curve 2" {6 0}
	form_entry $d.ent2 geo_create(surface,curves,curve2) string {6 1}
	form_button $d.sel2 "Select" \
		"select_curve_var geo_create(surface,curves,curve2)" {6 2}
	
	form_label $d.faml "Family" {10 0}
	form_entry $d.fame geo_create(surface,curves,fam) string {10 1}
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(surface,curves,fam)" {10 2}
	form_label $d.namel "Name" {11 0}
	form_entry $d.namee geo_create(surface,curves,name) string {11 1}
	
	form_finish bot
    }

}

proc geo_create_surface_curves_doit {} {
	global geo_create
	mess "curve1 $geo_create(surface,curves,curve1)\n"
	mess "curve2 $geo_create(surface,curves,curve2)\n"
	mess "name $geo_create(surface,curves,name)\n"
	if { $geo_create(surface,curves,curve1) == "" } {
		error "you must specify Curve1"
	}
	if { $geo_create(surface,curves,curve2) == "" } {
		error "you must specify Curve2"
	}
	if { $geo_create(surface,curves,name) == "" } {
		error "You must specify a name"
	}
		
	ic_undo_group_begin
	ic_geo_create_surface_curves $geo_create(surface,curves,curve1) \
		$geo_create(surface,curves,curve2) \
		$geo_create(surface,curves,name)
	ic_undo_group_end
}

proc geo_create_surface_curtain { } {
    set buts {{Create {geo_create_surface_curtain_doit}} dismiss}
    set d [form_init .geo_create_surface_curtain \
		"Create curtain surface" ""  $buts]
    if {$d != ""} {
	form_label $d.lab1 "Curves" {5 0}
	form_entry $d.ent1 geo_create(surface,curtain,curve) string {5 1}
	form_button $d.sel1 "Select" \
		"select_curve_var geo_create(surface,curtain,curve) 50"  {5 2}
	form_label $d.lab2 "Surface" {6 0}
	form_entry $d.ent2 geo_create(surface,curtain,surface) string {6 1}
	form_button $d.sel2 "Select" \
		"select_surface_var geo_create(surface,curtain,surface) 50" {6 2}
	
	form_label $d.faml "Family" {10 0}
	form_entry $d.fame geo_create(surface,curtain,fam) string {10 1}
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(surface,curtain,fam)" {10 2}
	form_label $d.namel "Name" {11 0}
	form_entry $d.namee geo_create(surface,curtain,name) string {11 1}
	
	form_finish bot
    }

}
proc geo_create_surface_curtain_doit {} {
        global geo_create
  
	if { $geo_create(surface,curtain,curve) == "" } {
		error "you must specify a curve"
	}
	if { $geo_create(surface,curtain,surface) == "" } {
		error "you must specify a surface"
	}

	set fam $geo_create(surface,curtain,fam) 
	if { $fam == "" } {
	    set fam "curtain_surf"
	}
	set name $geo_create(surface,curtain,name) 
	if { $name == "" }  {
	    set name [ic_geo_new_name surface "$fam."]
	}
	mess "curve $geo_create(surface,curtain,curve)\n"
        mess "surface $geo_create(surface,curtain,surface)\n"
        mess "name $name\n"

        ic_geo_create_surface_curtain $geo_create(surface,curtain,curve) \
                $geo_create(surface,curtain,surface) $name $fam 1
}

proc select_curve_var { var {nmax 1}} {
    set crv [geo_select curve $nmax ]
    if {$crv != ""} { uplevel \#0 set $var [list $crv] }
}

proc select_surface_var { var {nmax 1}} {
    set srf [geo_select surface $nmax ]
    if {$srf != ""} { uplevel \#0 set $var [list $srf] }
}

proc geo_create_curve_concat {} {
    global geo_create
    set objs [select_geometry curve]
    if {$objs == ""} return
    if {[llength $objs] <= 1} {
	mess "Selection must contain two or more curves!\n" red
	return
    }
    set sel ""
    foreach i $objs {
      	lappend sel [object_name_of_image $i]
    }
    if [catch {ic_geo_cre_edge_concat $sel} res] {
	mess "$res\n" red
    } else {
	update_fam_window
    }
}

proc geo_create_surface_from_curves_doit {} {
    global geo_create
    set fam  $geo_create(surface,from_curves,fam) 
    if { $fam == "" } {
	set fam "TMP_SURFACE"
    }

    set name $geo_create(surface,from_curves,name) 
    if { $name == "" }  {
	set name [ic_geo_new_name surface "$fam."]
    }

    set tol  $geo_create(surface,from_curves,tol)
    if { $tol == "" } {
	mess "Setting tolerance to 0.001\n"
	set tol 0.001 
    }

    set objs [select_geometry curve]
    if {$objs == ""} return

    set sel ""
    foreach i $objs {
      	lappend sel [object_name_of_image $i]
    }
    if [catch {ic_geo_create_surface_from_curves $fam $name $tol $sel 1} res] {
	mess "$res\n" red
        return
    }
}

proc geo_cre_srf_from_contour_doit {} {
    global geo_create
    set fam  $geo_create(surface,from_contour,fam) 
    if { $fam == "" } {
	set fam "TMP_SURFACE"
    }

    set name $geo_create(surface,from_contour,name) 
    if { $name == "" }  {
	set name [ic_geo_new_name surface "$fam."]
    }

    set tol  $geo_create(surface,from_contour,tol)
    if { $tol == "" } {
	mess "Setting tolerance to 0.001\n"
	set tol 0.001 
    }

    set objs [select_geometry curve]
    if {$objs == ""} return

    set sel ""
    foreach i $objs {
      	lappend sel [object_name_of_image $i]
    }
    if [catch {ic_geo_cre_srf_from_contour $fam $name $tol $sel} res] {
	mess "$res\n" red
        return
    }
}

proc geo_create_curve_3pnt_arc_doit {} {
    global geo_create last_geometry_created

    if {$geo_create(arc,points,fam) == ""} {
        mess "Needs family name to create curve.\n" red
        return
    }
    if [ic_geo_new_family $geo_create(arc,points,fam)] { update_fam_window }
    
    foreach i {1 2 3} {
	if { [llength $geo_create(arc,points,pt$i)] > 1 } {
	    set p$i [ic_coords_into_global $geo_create(arc,points,pt$i)]
	} else {
	    set p$i $geo_create(arc,points,pt$i)
	}
    }
    if [catch {ic_geo_cre_arc_from_pnts \
		      $geo_create(arc,points,fam) \
		      $geo_create(arc,points,name) \
		      $p1 $p2 $p3} cnum] {
	mess "$cnum \n" red
    } else {
	mess "Created bspline arc, "
        mess "$cnum \n" blue
        set last_geometry_created(curve) $cnum
    }
}

proc geo_create_curve_3pt_arc {} {
    global geo_create env
    
    set buts {{Create {geo_create_curve_3pnt_arc_doit}} dismiss}
    set d [form_init .geo_create_arc_points "Create arc through 3 points" "" \
	       $buts]
    if {$d != ""} {
	for {set i 1} {$i <= 3} {incr i} {
	    form_label $d.lab$i "Point $i" "$i 0"
	    form_entry $d.ent$i geo_create(arc,points,pt$i) string "$i 1"
	    if 0 {
		form_button $d.sel$i "Select" \
		    "med_get_local_location geo_create(arc,points,pt$i)" \
		    "$i 2"
	    }
	    set m $d.sel$i.m
	    form_menubutton_regular $d.sel$i "Select" $m "$i 2"
	    menu $m
	    $m add command -label Screen -command \
		"med_get_local_location geo_create(arc,points,pt$i)"
	    $m add command -label "Pre  point" -command \
		"geo_select_loc point geo_create(arc,points,pt$i)"
	    $m add command -label "Surface node" -command \
		"geo_select_loc arc_node geo_create(arc,points,pt$i)"
	    
	}
	form_label $d.faml "Family" "$i 0"
	form_entry $d.fame geo_create(arc,points,fam) string "$i 1"
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(arc,points,fam)" "$i 2"
	incr i
	form_label $d.namel "Name" "$i 0"
	form_entry $d.namee geo_create(arc,points,name) string "$i 1"
	
	form_finish bot
    }
    
    for {set i 1} {$i <= 3} {incr i} {
	trace variable geo_create(arc,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(arc,points,pt$i); list"
	update_screen_label_point "Pt $i" geo_create(arc,points,pt$i)
    }
    
    form_wait .geo_create_arc_points
    
    for {set i 1} {$i <= 3} {incr i} {
	trace vdelete geo_create(arc,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(arc,points,pt$i); list"
	update_screen_label_point "" geo_create(arc,points,pt$i)
    }
}

proc geo_create_curve_line {} {
    global geo_create env
    
    set buts {{Create {geo_create_curve_line_doit}} dismiss}
    set d [form_init .geo_create_line_points "Create line through 2 points" "" \
	       $buts]
    if {$d != ""} {
	for {set i 1} {$i <= 2} {incr i} {
	    form_label $d.lab$i "Point $i" "$i 0"
	    form_entry $d.ent$i geo_create(line,points,pt$i) string "$i 1"
	    if 0 {
		form_button $d.sel$i "Select" \
		    "med_get_local_location geo_create(line,points,pt$i)" \
		    "$i 2"
	    }
	    set m $d.sel$i.m
	    form_menubutton_regular $d.sel$i "Select" $m "$i 2"
	    menu $m
	    $m add command -label Screen -command \
		"med_get_local_location geo_create(line,points,pt$i)"
	    $m add command -label "Pre  point" -command \
		"geo_select_loc point geo_create(line,points,pt$i)"
	    $m add command -label "Surface node" -command \
		"geo_select_loc line_node geo_create(line,points,pt$i)"
	    
	}
	form_label $d.faml "Family" "$i 0"
	form_entry $d.fame geo_create(line,points,fam) string "$i 1"
	form_button $d.self "Select" \
	    "select_family_set_var geo_create(line,points,fam)" "$i 2"
	incr i
	form_label $d.namel "Name" "$i 0"
	form_entry $d.namee geo_create(line,points,name) string "$i 1"
	
	form_finish bot
    }
    
    for {set i 1} {$i <= 2} {incr i} {
	set geo_create(line,points,pt$i) "0 0 0"
	trace variable geo_create(line,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(line,points,pt$i); list"
	update_screen_label_point "Pt $i" geo_create(line,points,pt$i)
    }
    
    form_wait .geo_create_line_points
    
    for {set i 1} {$i <= 2} {incr i} {
	trace vdelete geo_create(line,points,pt$i) w \
	    "update_screen_label_point \"Pt $i\" geo_create(line,points,pt$i); list"
	update_screen_label_point "" geo_create(line,points,pt$i)
    }
}

proc geo_create_curve_line_doit {} {
    global geo_create
    
    if {$geo_create(line,points,fam) == ""} {
        mess "Needs family name to create curve.\n" red
        return
    }    
    if [ic_geo_new_family $geo_create(line,points,fam)] { update_fam_window }

    foreach i {1 2} {
	if { [llength $geo_create(line,points,pt$i)] > 1} {
	    set p$i [ic_coords_into_global $geo_create(line,points,pt$i)]
	} else {
	    set p$i $geo_create(line,points,pt$i)
	}
    }
    if [catch {ic_geo_cre_line \
		      $geo_create(line,points,fam) \
		      $geo_create(line,points,name) \
		      $p1 $p2} cnum] {
	mess "$cnum \n" red
    } else {
	mess "Created bspline line, "
        mess "$cnum \n" blue

        update_fam_window
    }
}

proc geo_create_curve_listdata {} {
    global geo_create env
    
    set buts {{Create {geo_create_curve_listdata_doit}} dismiss}
    set d [form_init .geo_create_curve_listdata "List curve data" "" \
	       $buts]
    if {$d != ""} {
	form_label $d.filel "output file" "0 0"
	form_entry $d.filee geo_create(curve,listdata,file) string "0 1"
	form_radiobutton $d.tetin "Tetin format" geo_create(curve,listdata,format) \
	     tetin {5 0 -cols 2}
	form_radiobutton $d.iges "IGES format" geo_create(curve,listdata,format) \
	     iges  {15 0 -cols 2}
	form_finish bot
    }
    
    form_wait .geo_create_curve_listdata
}

proc geo_create_curve_listdata_doit {} {
    global geo_create
    set file $geo_create(curve,listdata,file)
    set format $geo_create(curve,listdata,format)

    set objs [select_geometry curve]
    if {$objs == ""} return

    set sel ""
    foreach i $objs {
        lappend sel [$i get -name]
    }
    ic_geo_list_crv_data $file $format $sel
}

proc geo_create_surface_mid {} {
    global midsurface

    set d [form_init .midsurface "Midsurface parameters" "" close]
    if {$d != ""} {

        set ln 0
        form_label $d.dist_l "Max. distance" "$ln 0"
        form_entry $d.dist_e midsurface(max_dist) float "$ln 1"

        incr ln
        form_frame $d.new_fam flat 0 "$ln 0"
        form_label $d.new_fam_l "Family for midsurfaces" "$ln 0"
        set famnames [get_famnames]
        futil_listentry $d.new_fam_e midsurface(family) "list $famnames" "$ln 1"

        incr ln
        form_checkbutton $d.save "Save old entities" midsurface(save_old) "$ln 0"

        incr ln
        form_checkbutton $d.partial "Partial" midsurface(partial) "$ln 0"

        incr ln
        form_checkbutton $d.similar "Similar pairs only" midsurface(similar) "$ln 0"

        incr ln
        form_label $d.tol_l "Tolerance" "$ln 0"
        form_entry $d.tol_e midsurface(tolerance) float "$ln 1"

        #incr ln
        #form_label $d.precision_l "Precision" "$ln 0"
        #form_entry $d.precision_e midsurface(precision) float "$ln 1"

        if {$midsurface(ask) != 0 && $midsurface(ask) != 1} {
            set midsurface(ask) 1
        }
        incr ln
        form_label $d.ask "Operation mode" "$ln 0"
        form_radiobutton $d.ask0 "quiet" midsurface(ask) 0 "$ln 1"
        incr ln
        form_radiobutton $d.ask1 "confirm" midsurface(ask) 1 "$ln 1"

        incr ln
        form_button $d.close "Create" "geo_midsurface_apply" "$ln 0"

        form_finish bot
    }
}

proc geo_midsurface_apply {} {
    global midsurface

    set surfs [geo_select surface]
    if { $surfs == "" } return

    ic_undo_group_begin
    ic_geo_midsurface max_dist $midsurface(max_dist) family $midsurface(family) \
        surfaces $surfs save_old $midsurface(save_old) ask $midsurface(ask) \
        partial $midsurface(partial) precision $midsurface(precision) \
        tolerance $midsurface(tolerance) \
        similar $midsurface(similar) debug $midsurface(debug)
    ic_undo_group_end
}

proc geo_split_folded_surface {} {
    global fold

    set fold(angle) 110
    set d [form_init .fold "Split parameters" "" close]
    if {$d != ""} {

        set ln 0
        form_label $d.angle_l "Max. total curvature" "$ln 0"
        form_entry $d.angle_e fold(angle) float "$ln 1"
        form_scale $d.angle_scale fold(angle) "" h 30 150 10 "$ln 1"

        incr ln
        form_button $d.close "Split" "geo_split_folded_surface_apply" "$ln 0"

        form_finish bot
    }
}

proc geo_split_folded_surface_apply {} {
    global fold

    set surfs [geo_select surface]
    if { $surfs == "" } return

    ic_undo_group_begin
    ic_geo_trm_srfs_by_curvature $surfs $fold(angle)
    ic_undo_group_end
}

proc geo_create_curve_test_project_surface {} {
    global geo_create
    
    set sname [geo_select surface]
    if {$sname == ""} return

    set cname [geo_select curve]
    if {$cname == ""} return

    set dir [question "Direction?" "1 0 0"]
    if {$dir == ""} return
    
    set fam [ic_geo_get_family curve $cname]
    ic_undo_group_begin
    ic_geo_cre_crv_test_project_surface $fam "" $sname $cname $dir
    ic_undo_group_end
}

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

proc geo_params_edit_allfamilies { } {
  global mparams geo_command_mode options mainwindow_menubar
  global geo_params_blank_done geometry_mode

    if [winfo exists .mparams_allfamily] { destroy .mparams_allfamily }
    geo_params_update_sizes allfamilies
    set w .mparams_allfamily
    
    set buts [list [list Apply   "geo_params_edit_allfamilies_apply"] \
		   [list Dismiss "geo_params_edit_done family $w"]]
    set ww [form_init $w "Mesh sizes for families" "" $buts ]
    if {$ww != ""} {
	set d [form_scroller $ww.fr 400 {0 0}]
	set bg [$w cget -background]
	set ln 0
	
	form_label $d.fnl "Family" "0 0"
	form_label $d.fsl "Size" "0 1"
	form_label $d.fhl "Height" "0 2"
	form_label $d.frl "Ratio" "0 3"
	form_label $d.fm1 "Min Size" "0 4"
	form_label $d.fdl "Max Deviation" "0 5"
	form_label $d.fwl "Width" "0 6"
	form_label $d.fil "Int Wall" "0 7"
	form_label $d.fsplitl "Split Wall" "0 8"
	form_label $d.ffixl "Fix for Adaptation" "0 9"

	incr ln

	set scr $d
	set f0 $ln
	set sel ""
	set sortedfams [lsort -dictionary [ic_geo_list_families]]
	foreach ff $sortedfams {
	    if {([ic_geo_get_objects surface $ff] == "") && \
		    ([ic_geo_get_objects curve $ff] == "") && \
		    ([ic_geo_get_objects point $ff] == "")} {
		continue
	    }
	    lappend sel $ff
	    
	    form_label $scr.fam_$ln $ff "$ln 0" 
	    set hlbg $bg
	    if { $mparams($ff\_emax) == "" || $mparams($ff\_ehgt) == "" || \
		    $mparams($ff\_erat) == "" || $mparams($ff\_emin) == "" || \
		    $mparams($ff\_edev) == "" ||  $mparams($ff\_ewid) == "" } {
		set hlbg yellow
	    }

	    $scr.fam_$ln configure -background $hlbg
	    #{emax ehgt erat ewid emin edev internal_wall split_wall mom3d_no_adapt}	
	    form_entry $scr.fsl_$ln mparams($ff\_emax) string "$ln 1"
	    form_entry $scr.fnl_$ln mparams($ff\_ehgt) string "$ln 2"
	    form_entry $scr.frl_$ln mparams($ff\_erat) string "$ln 3"
	    form_entry $scr.fm1_$ln mparams($ff\_emin) string "$ln 4"
	    form_entry $scr.fdl_$ln mparams($ff\_edev) string "$ln 5"
	    form_entry $scr.fwl_$ln mparams($ff\_ewid) string "$ln 6"
	    #set family_int_wall($ff) 1
	    form_checkbutton $scr.fil_$ln "" mparams($ff\_internal_wall) "$ln 7 -fill both"
	    $scr.fil_$ln configure -background $bg
	    form_checkbutton $scr.fsplitl_$ln "" mparams($ff\_split_wall) "$ln 8 -fill both"
	    $scr.fsplitl_$ln configure -background $bg
	    form_checkbutton $scr.ffixl_$ln "" mparams($ff\_mom3d_no_adapt) "$ln 9 -fill both"
	    $scr.ffixl_$ln configure -background $bg
	    incr ln
	}
	set mparams(sel) $sel
	set geo_params_blank_done 0
	form_checkbutton $ww.showfactor "Show size params using ref size" \
		options(show_factor) {31 0}
	$ww.showfactor configure -command "geo_params_update_sizes allfamilies"

        form_label $ww.warn  \
		"Please Note that Highlighted families have at least \
		one blank field because not all entities in that family \
		have identical entitiy parameters." {40 0}
	
	$ww.warn configure -background yellow 
	form_finish +300+300
	
    }
}

proc geo_params_update_highlighting {w {sortedfams ""}} {
    global mparams options

    geo_params_update_sizes allparts
    set bg [$w cget -background]; set ln 0
    set vfams [ic_list_volume_families]
    if {$sortedfams == ""} {
        set sortedfams [lsort -dictionary [ic_geo_list_parts]]
        set solid_part_fams ""
        set non_solid_part_fams ""
        array set solid {}
        foreach ff $sortedfams {
            if {$ff == "ORFN"} continue
            set solid_part 0; set solid($ff) 0
            set count_geom [ic_geo_count_in_family {surface curve point} $ff]
            set count_body [ic_geo_count_in_family body $ff]
            if {$count_body && $count_geom} continue
	    if !$count_geom {
	        if {[ic_geo_get_objects body $ff] != "" || [lsearch $vfams $ff] > -1} {
	            set solid_part 1
	            set solid($ff) 1
	        } else {
		    continue
                }
            }
            if $solid_part {
	        lappend solid_part_fams $ff
	    } else {
	        lappend non_solid_part_fams $ff
	    }
        }
        set resortedfams ""
        foreach ff $non_solid_part_fams {
            lappend resortedfams $ff
        }
        foreach ff $solid_part_fams {	
	    lappend resortedfams $ff
        }
        set sortedfams $resortedfams
    } else {
        foreach ff $sortedfams {
            if {$ff == "ORFN"} continue
	    set solid($ff) 0
            set count_geom [ic_geo_count_in_family {surface curve point} $ff]
            set count_body [ic_geo_count_in_family body $ff]
            # continue if body and geom is in the same part
            if {$count_body && $count_geom} continue
	    if !$count_geom {
	        if {[ic_geo_get_objects body $ff] != "" || [lsearch $vfams $ff] > -1} {
	            set solid($ff) 1
	        } else {
		    continue
                }
            }
        }
    }
    foreach ff $sortedfams {
	if {$ff == "ORFN"} continue
	set hlbg $bg
        if !$solid($ff) {
	    if {$mparams(${ff}_emax) == "" || $mparams(${ff}_ehgt) == "" || \
		$mparams(${ff}_erat) == "" || $mparams(${ff}_emin) == "" || \
		$mparams(${ff}_edev) == "" || $mparams(${ff}_ewid) == "" || \
		$mparams(${ff}_hrat) == "" || $mparams(${ff}_nlay) == ""} {
		set hlbg yellow
	    }
	}
	$w.fam_$ln configure -background $hlbg
	incr ln
    }
}

proc geo_params_allfamilies_get_vals {} {
    global mparams

    foreach ff [ic_geo_list_families]  {
        if ![ic_geo_count_in_family {surface curve point} $ff] continue
	set mparams(selfam) $ff
	set sel [ic_geo_get_objects all $ff]
	geo_params_get_vals family $sel
   	set pnames {emax ehgt erat hrat ewid emin edev internal_wall split_wall mom3d_no_adapt}	
	foreach p $pnames {
            set mparams($ff\_$p) $mparams($p)
	}
    }
}

proc geo_params_edit_allfamilies_apply {} {
    global mparams
    foreach ff [ic_geo_list_families] {
        if ![ic_geo_count_in_family {surface curve point} $ff] continue
	set mparams(selfam) $ff
   	set pnames {emax ehgt erat hrat ewid emin edev internal_wall split_wall mom3d_no_adapt}	
	foreach p $pnames {
            set mparams($p) $mparams($ff\_$p) 
	}
	geo_params_edit_apply family
    }
}

proc geo_contact_surfaces {{debug 0}} {
    set surfaces [geo_select surface]
    if {[llength $surfaces] < 1} return
    set dist [question_box .contact_distance Distance \
        "Enter the maximum contact distance.\n" 0]
    if {$debug} {
        set family "contact_debug"
    } else {
        set family ""
    }
    set pairs [ic_geo_contact_surfaces $surfaces $dist $family $debug]
    if {$debug} {
        mess "pairs = \"$pairs\"\n"
    }
}

proc geo_surface_thickness {{order 2}} {
    set surfaces [geo_select surface]
    if {[llength $surfaces] < 1 || $order < 2} return
    set old_thickness [ic_geo_surface_thickness [lindex $surfaces 0] $order]
    set thickness [question_box .contact_distance Thickness \
        "Enter the $order * $order thicknesses.\n" $old_thickness]
    if {[llength $thickness] != [expr $order * $order]} {
        mess "Please enter $order * $order thickness values.\n" red
        return
    }
    ic_geo_surface_thickness $surfaces $order $thickness
}

proc geo_calculate_thickness {} {
    global projlib order maxth
    set mid_surfaces [geo_select surface 0 "midsurface(s)"]
    set n_mid_surfaces [llength $mid_surfaces]
    set sol_surfaces [geo_select surface 0 "solid surfaces"]
    set n_sol_surfaces [llength $sol_surfaces]
    #
    set order 2
    set maxth 0.0
    set buts {accept dismiss}
    set d [form_init .geo_calculate_thickness "Thickness Parameters" "" \
	       $buts]
    if {$d != ""} {
    	form_label $d.ord "Order" "0 0"
	form_entry $d.order order int "0 1"
	form_label $d.max "Max. Thickness" "1 0"
	form_entry $d.maxth maxth float "1 1"
	form_finish +300+300
    }
    form_wait .geo_calculate_thickness
    #
    ic_geo_calculate_thickness $mid_surfaces $sol_surfaces $order $maxth
}

