
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

if ![info exists cad_possible_types] {
    array set cad_possible_types \
	{hexa 1 cyl 1 polygon 1 circ 1 quad 1 incline 1}
}

# Prefer hexas to polygons and thick quads, and quads to thin polygons.
# Also quads are better than inclines and inclines are better than polygons.

if ![info exists cad_weight_factor] {
    array set cad_weight_factor {
	hexa 1 cyl 1 polygon 1.03 circ 1 quad 1.01
	incline 1.02
    }
}

set shape_cad_draw_all 1

proc cad_form {} {
    global cad_fam_window cad_possible_types object_sections
    global object_type_list object_type_title object_type_title_short
    global cad_makes_section cad_no_best_fit_button
    
    set d [form_init .cad_data "CAD data" "" {close help}]
    if {$d == ""} {
	cad_update_families
	return
    }
    
    form_menubutton_regular $d.load "Load" $d.load.m {0 0 -fill x}
    menu $d.load.m -tearoff 0
    #form_menubutton_regular $d.save "Save" $d.save.m {1 0 -fill x}
    #menu $d.save.m -tearoff 0
    $d.load.m add command -label "Load tetin file" -command cad_load_tetin
    $d.load.m add command -label "Load IGES/Step file" -command cad_load_iges
    $d.load.m add command -label "Load DWG/DXF file" -command cad_load_dwg
    $d.load.m add command -label "Load ACIS file" -command cad_load_acis
    #$d.save.m add command -label "Save tetin file" -command "cad_save tetin"
    #$d.save.m add command -label "Save IGES file" -command "cad_save iges"
    #$d.save.m add command -label "Save Step file" -command "cad_save step"
    form_button $d.opts "Options" "cad_edit_options 0" {1 0 -fill x}
    form_button $d.blank "Blank" "cad_blank_surface" {2 0 -fill x}
    form_button $d.unblank "Unblank" "cad_unblank_surface" {3 0 -fill x}
    form_button $d.delete "Delete" "cad_delete_surface" {4 0 -fill x}
    form_button $d.clear "Clear" "cad_clear 1" {5 0 -fill x}
    
    form_button $d.chfam "Change family" "cad_change_family" {0 1 -fill x}
    form_button $d.cleanfam "Clean up families" "cad_delete_unused_family" {1 1 -fill x}
    form_checkbutton $d.showused "Show used" cad_show_used {2 1} "" \
	cad_toggle_show
    form_checkbutton $d.showunused "Show unused" cad_show_unused {3 1} "" \
	cad_toggle_show
    form_checkbutton $d.solid "Solid shading" cad_show_solid {4 1} "" \
	cad_toggle_show
    form_checkbutton $d.fast "Fast movement" geom_fast_dynamics {5 1}
    
    set dt [form_label_frame $d.topo "Small gaps" {7 0 -cols 2}]
    form_button $dt.go "Fix below size" cad_build_topo {0 0}
    form_entry $dt.tol cad_topo_tol float {0 1} "" 6
    
    set how_f [form_label_frame $d.how "Creation mode" {10 0 -cols 2}]
    form_radiobutton $how_f.single "Selected" cad_creation_mode single {0 0}
    form_radiobutton $how_f.family "Family" cad_creation_mode family {1 0}
    form_radiobutton $how_f.region "Region" cad_creation_mode region {2 0}
    
    set cad_fam_window [form_label_frame $d.fams "Families" {0 2 -rows 8}]
    check_box $cad_fam_window "" "15 9" fam_visible 1 \
	cad_toggle_show
    
    if [info exists cad_no_best_fit_button] {
	set lab "Shapes to try"
    } else {
	set lab "Best fit shapes to try"
    }
    set sh_f [form_label_frame $d.trysh $lab {11 0 -cols 2}]
    set obj_f [form_label_frame $d.obj "Create object" {10 2 -rows 2}]
    
    # ----------------------
    
    set poss [lsort [array names cad_possible_types]]
    set nr [expr ([llength $poss] + 1) / 2]
    set r 0; set c 0
    foreach sh $poss {
	form_checkbutton $sh_f.$sh $sh cad_possible_types($sh) "$r $c"
	incr r
	if {$r == $nr} { set r 0; incr c }
    }
    
    # ----------------------
    
    set doit ""
    foreach t $object_type_list {
	if {(![info exists object_sections($t)] || \
		 ([llength $object_sections($t)] != 1)) && \
		![info exists cad_makes_section($t)]} continue
	if [info exists object_type_title_short($t)] {
	    lappend doit [list $object_type_title_short($t) $t]
	} else {
	    lappend doit [list $object_type_title($t) $t]
	}
    }
    
    set nr [expr ([llength $doit] + 1) / 2]
    set r 0; set c 0
    if ![info exists cad_no_best_fit_button] {
	set bestf [list [list "Best fit" best_fit]]
    } else {
	set bestf ""
    }
    foreach xx [concat $bestf [lsort $doit]] {
	set n [lindex $xx 0]; set t  [lindex $xx 1]
	form_button $obj_f.$t $n "cad_create_multiple cad_creation_mode $t" \
	    "$r $c -fill x"
	incr r
	if {$r == $nr} { set r 0; incr c }
    }
    
    form_finish bot
    cad_update_families
}

proc cad_build_topo {} {
    global projlib cad_topo_tol surf_is_used
    
    busy 1
    $projlib build_topo $cad_topo_tol
    busy 0
    clear_geom_objects
    define_geom_objects
    cad_reset_data
    mess "Build topology completed.\n"
}

proc cad_clear {ask} {
    global projlib surf_is_used surf_is_small fam_visible
    
    if $ask {
	if {$projlib == ""} {
	    mess "There is no CAD data loaded.\n"
	    return
	}
	if [tk_dialog .really_delete "Confirm" "Really delete all CAD data?" \
		"" -1 Yes No] return
	mess "Deleting all CAD data.\n"
    }
    foreach s [array names surf_is_used] {
	if !$surf_is_used($s) {
	    unset surf_is_used($s)
	    unset surf_is_small($s)
	    set n [$s get -bspline]
	    set type [$s get -type]
	    delete_geom_object $s
	    $projlib delete_$type $n
	}
    }
    catch {unset fam_visible}
    cad_update_families
}

proc cad_reset_data {} {
    global projlib surf_is_used surf_is_small
    
    foreach s [array names surf_is_used] {
	unset surf_is_used($s)
	unset surf_is_small($s)
    }
    
    foreach type {surface curve point material} {
		set bsps [$projlib list_bsp_objects $type]
	    foreach g $bsp {
		set surf_is_used($g) 0
		set surf_is_small($g) 0
	}
    }
    cad_toggle_show
}

proc cad_load_tetin {} {
    global domain
    
    cad_already_there_warning
    
    if {$domain == ""} {
	user_error "You must open a new project first, then import your CAD data into that project."
	return
    }
    
    set tetin [file_selection -message "Select a tetin file to load" \
		   -ok_func cad_file_is_tetin \
		   -extra_widgets "cad_load_extra_widgets 1" \
		   -file_types {{{Tetin files} {.tin}}}]
    if {$tetin == ""} return
    cad_do_load_tetin $tetin 1 ""
}

proc cad_save {what} {
    global tetin_do_offset_scale
    
    switch $what {
	tetin {
	    set tetin [file_selection -message "Select a tetin file to save" \
			   -new_ok 1 -warn_overwrite 1 \
			   -default [directory]/geometry.tin \
			   -file_types {{{Tetin files} {.tin}}}]
	    if {$tetin == ""} return
	    write_tetin_file $tetin 0
	}
	iges {
	    set iges [file_selection -message "Select an IGES file to save" \
			   -new_ok 1 -warn_overwrite 1 \
			   -default [directory]/geometry.igs \
			   -file_types {{{IGES files} {.iges .igs}}}]
	    if {$iges == ""} return
	    set tin [directory]/tmpgeometry.tin
	    
	    #set tetin_do_offset_scale "1000 0 0 0  0 1000 0 0  0 0 1000 0  0 0 0 1000"
	    write_tetin_file $tin 0
	    #unset tetin_do_offset_scale
	    cad_convert_tetin_step $tin $iges 1
	}
	step {
	    set step [file_selection -message "Select a Step file to save" \
			   -new_ok 1 -warn_overwrite 1 \
			   -default [directory]/geometry.stp \
			   -file_types {{{Step files} {.step .stp}}}]
	    if {$step == ""} return
	    set tin [directory]/tmpgeometry.tin
	    #set tetin_do_offset_scale "1000 0 0 0  0 1000 0 0  0 0 1000 0  0 0 0 1000"
	    write_tetin_file $tin 0
	    #unset tetin_do_offset_scale
	    cad_convert_tetin_step $tin $step 0
	}
    }
}

proc cad_edit_icemcfd {} {
    global env current_shape toplevel is_win
    
    if {![info exists env(ICEM_ACN)] || ![file exists $env(ICEM_ACN)]} {
	user_error "To edit the CAD data you need to have ICEM CFD installed. \
		If it is installed please set the environment variable \
		ICEM_ACN to the location where it is and then exit and restart\
		this program."
	return
    }
    
    set cad [$current_shape tetin_input 0 0 0 SURFACE CURVE POINT \
		 POINT CURVE SURFACE MATERIAL]
    set tmpfile [directory]/cad_edit_tmp.tin
    set fp [open $tmpfile w]
    foreach line $cad {
	puts -nonewline $fp $line
    }
    close $fp
    
    set ww [application_wait]
    if $toplevel(single) {
	wm withdraw .
    } else {
	wm withdraw .v
    }
    catch {unset env(ICEM_USE_MENUBAR)}
    catch {unset env(ICEM_ONE_WINDOW)}
    set oldtcl $env(TCL_LIBRARY); unset env(TCL_LIBRARY)
    set oldtk $env(TK_LIBRARY); unset env(TK_LIBRARY)
    mess "Running: $env(ICEM_ACN)/bin/med -tetin $tmpfile\n"
    if $is_win {
	if [catch {exec start /wait $env(ICEM_ACN)/bin/med -tetin $tmpfile} err] {
	    mess $err red
	}
    } else {
	if [catch {exec $env(ICEM_ACN)/bin/med -tetin $tmpfile} err] {
	    mess $err red
	}
    }
	
    set env(TCL_LIBRARY) $oldtcl
    set env(TK_LIBRARY) $oldtk    
    destroy $ww
    if $toplevel(single) {
	wm deiconify .
    } else {
	wm deiconify .v
    }
    cad_clear_current 0
    cad_shape_from_tetin $current_shape $tmpfile 1
}

proc cad_file_is_tetin {tet} {
    return [expr [file isfile $tet] && ![string match *.bin $tet] && \
		([string match *tetin* $tet] || [string match *.tin $tet])]
}

proc cad_load_extra_widgets {mat d} {
    form_checkbutton $d.lsurf "Load surfaces" cad_use_type(surface) {0 0 -cols 2}
    form_checkbutton $d.lcurve "Load curves" cad_use_type(curve) {1 0 -cols 2}
    form_checkbutton $d.lpoint "Load points" cad_use_type(point) {2 0 -cols 2}
    if $mat {
	form_checkbutton $d.lmat "Load material" cad_use_type(material) {3 0 -cols 2}
    }
    
    form_label $d.ttoll "Spline discretization" {4 0}
    form_entry $d.ttol load_tetin_triangle_tolerance float {4 1}
    
}

proc cad_load_extra_widgets_iges {mat d} {
    form_checkbutton $d.lsurf "Load surfaces" cad_use_type(surface) {0 0}
    form_checkbutton $d.lcurve "Load curves" cad_use_type(curve) {1 0}
    form_checkbutton $d.lpoint "Load points" cad_use_type(point) {2 0}
    if $mat {
	form_checkbutton $d.lmat "Load material" cad_use_type(material) {3 0}
    }
    form_checkbutton $d.copy "Copy IGES file to project directory" \
	cad_copy_iges_file {4 0}
    
}

proc cad_already_there_warning {} {
    global surf_is_used
    
    set there 0
    foreach i [array names surf_is_used] {
	if !$surf_is_used($i) { set there 1 }
    }
    if $there {
	mess "Warning: you already have some unused CAD data loaded.  Importing another file will add to this rather than replacing it.\n" red
    }
}

proc cad_load_iges {{iges ""}} {
    global domain cad_copy_iges_file steptotin_path projlib
    
    cad_already_there_warning
    
    if {$domain == ""} {
	user_error "You must open a new project first, then import your CAD data into that project."
	return
    }
    
    set cad_copy_iges_file 0
    
    if {$iges == ""} {
	set iges [file_selection -message "Select an IGES or Step file to load" \
		      -extra_widgets "cad_load_extra_widgets_iges 0" \
		      -file_types {{{IGES/Step files} {.igs .iges .step .stp}}}]
	if {$iges == ""} return
    }
    
    if $cad_copy_iges_file {
	mess "Copying IGES file into project directory ...\n"
	cmd_cp $iges [directory]
	set iges [directory]/[file tail $iges]
    }
    
    
    if {$steptotin_path == "not_found"} {
	set tetin [directory]/[file tail [file rootname $iges]].tin
	set iparta [directory]/[file tail [file rootname $iges]].ipa
	if ![cad_convert_iges_tetin $iges $tetin $iparta] return
	
	# Open up the iparta file and see what the units are.
	set fp [open $iparta r]
	gets $fp
	set un [lindex [gets $fp] 3]
	close $fp
	switch $un {
	    1 { set units mm }
	    2 { set units in }
	    default { set units "" }
	}
    } else {
	set tetin [directory]/[file tail [file rootname $iges]].tin
	if ![cad_convert_step_tetin $iges $tetin] return
	set units ""
    }
    cad_do_load_tetin $tetin 1 $units
}
proc cad_load_dwg {{dwg ""}} {
    global domain
    
    if {$domain == ""} {
	user_error "You must open a new job first, then import your CAD data into that job."
	return
    }
    
    if {$dwg == ""} {
	set dwg [file_selection -message "Select a DWG/DXF file to load" \
		     -extra_widgets "cad_load_extra_widgets 1" -default [directory]]
	if {$dwg == ""} return
    }
    set tetin $dwg.tin
    if ![cad_convert_dwg_tetin $dwg $tetin] return
    
    cad_do_load_tetin $tetin 1 ""
}

proc cad_load_acis {{acis ""}} {
    global domain
    
    if {$domain == ""} {
	user_error "You must open a new job first, then import your CAD data into that job."
	return
    }
    
    if {$acis == ""} {
	set acis [file_selection -message "Select an ACIS file to load" \
		      -extra_widgets "cad_load_extra_widgets 1" -default [directory]]
	if {$acis == ""} return
    }
    set tetin $acis.tin
    if ![cad_convert_acis_tetin $acis $tetin] return
    
    cad_do_load_tetin $tetin 1 ""
}

proc cad_load_mesh {type name} {
    global env job_name
    global domain
    
    if {$domain == ""} {
	user_error "You must open a new project first, then import your CAD data into that project."
	return
    }
    
    set mfile [file_selection -message "Select a $name file to load"]
    if {$mfile == ""} return
    
    set tetin [directory]/${type}_tmp.tin
    set script [directory]/${type}_imp
    
    set fp [open $script w]
    puts $fp "ic_set_project $job_name"
    puts $fp "ic_geo_import_mesh $type $mfile 1"
    puts $fp "ic_save_tetin $tetin"
    puts $fp "exit"
    close $fp
    
    set qcmd "$env(ICEM_ACN)/bin/med -batch -script $script"
    run_background $qcmd "" 1
    
    cad_do_load_tetin $tetin 1 ""
}

proc cad_do_load_tetin {tetin rescale got_units} {
    global surf_is_used cad_shape_okay surf_is_small
    global projlib default_fluid_family cad_do_autoscale cad_use_type
    global geom_visible geom_fast_dynamics cad_use_type
    global cad_data_to_units cad_units unit_data domain tdv_default
    global dont_change_default_fluid_family_when_loading_cad
    
    if {$domain == ""} {
	user_error "You must open a project before you load CAD data."
	return
    }
    
    set geom_fast_dynamics 0
    
    busy 1
    set pl [auto_load_projlib $tetin 0 1 $cad_use_type(surface) \
		$cad_use_type(curve) $cad_use_type(point) \
		$cad_use_type(material)]
    busy 0
    if {$pl == ""} {
	mess "Failed to load CAD data\n" red
	return
    }
    if {$got_units == ""} {
	set got_units [$projlib get_length_units]
	set got_units [string tolower $got_units]
	if {$got_units == "inch"} { set got_units in }
	if {$got_units == "um"} { set got_units microns }
	# Don't worry about MI KM UIN 
	if {$got_units != ""} {
	    mess "Using units of $got_units for CAD data\n"
	}
    }
    
    set scale 1.0
    if {$rescale && [info exists cad_data_to_units]} {
	if {$got_units == ""} {
	    if ![info exists cad_units] {
		set cad_units [unit_get_default_choice length]
	    }
	    set ch [unit_select_one length $cad_units]
	} else {
	    set ch $got_units
	}
	if {$ch != ""} {
	    set scale [expr 1 / ([lindex $unit_data($ch) 1] + 0.0)]
	    set cad_units $ch
	}
    }
    
    foreach type {surface curve point material} {
	set bsps [$projlib list_bsp_objects $type]
	foreach g $bsps {
	    if ![info exists surf_is_used($g)] {
		set surf_is_used($g) 0
		set surf_is_small($g) 0
		
		$projlib scale_entity $type [$g get -number] \
		    "$scale $scale $scale" "0 0 0"
		$g signal_change 1
	    }
	}
	set geom_visible($type) 1
	#set cad_use_type($type) $geom_visible($type)
    }
    
    if ![info exists dont_change_default_fluid_family_when_loading_cad] {
	set ff [$projlib list_material_families]
	if {$ff != ""} {
	    set default_fluid_family [lindex $ff 0]
	    set set "Set the default fluid family to"
	} else {
	    set set "The default fluid family is"
	}
	mess "$set \"$default_fluid_family\" - you can change this using\
	Model/Utilities/Fluid family\n"
    }
    
    cad_blank_below_minfeature
    if {$rescale && $cad_do_autoscale} {
	app_domain_autoscale 1.0 0
	tdv_scale_to_fit $tdv_default
    }
    cad_update_families
}

proc cad_rescale {} {
    global projlib
    
    set scale [question "Scale factor (one or three values)?" 1.0]
    if {$scale == ""} return
    if {[llength $scale] == 1} { set scale "$scale $scale $scale" }
    
    foreach type {surface curve point} {
		set bsps [$projlib list_bsp_objects $type]
	    foreach g $bsps {
		$projlib scale_entity $type [$g get -number] $scale "0 0 0"
		$g signal_change 1
	    }
	}
    }

proc cad_load_tetin_for_current {} {
    global current_shape
    
    if {$current_shape == ""} {
	user_error "No CAD object selected"
	return
    }
    set tetin [file_selection -message "Select a tetin file to load"]
    if {$tetin == ""} return
    cad_shape_from_tetin $current_shape $tetin 1
}

proc cad_clear_current {ask} {
    global current_shape
    
    if {$current_shape == ""} {
	user_error "No CAD object selected"
	return
    }
    if {$ask && [tk_dialog .really_clear "Confirm" "Delete the shape data from the current object?" "" -1 Yes No]} return
    
    cad_clear_bsplines $current_shape
}

# This is the function that gets called when you load in cad objects from
# the model file.

proc cad_shape_from_tetin {shape file noisy} {
    global projlib proj_last_loaded_objects surf_is_used surf_is_small
    global cad_use_type
    
    auto_load_projlib $file 0 $noisy $cad_use_type(surface) \
	$cad_use_type(curve) $cad_use_type(point) $cad_use_type(material)
    
    set objs ""
    foreach t [array names proj_last_loaded_objects] {
	foreach n $proj_last_loaded_objects($t) {
	    set obj [$projlib get_object $t $n]
	    lappend objs $obj
	    set surf_is_used($obj) 1
	    set surf_is_small($obj) 0 ;# doesn't matter
	}
    }
    cad_shape_from_bsplines $shape $objs
}

proc cad_shape_from_bsplines {shape objs} {
    global projlib
    
    foreach obj $objs {
	$obj configure -visible 0
	$shape add_bspline $obj
    }
    $shape configure -projlib $projlib -save_with_model 1
    #$projlib configure -visible 0
    db_dirty mesh
}

proc cad_simplify_current {} {
    global projlib current_shape current_object surf_is_used surf_is_small
    
    set bsps [$current_shape list_bsplines]
    set files [geo_run_hull $bsps]
    if {$files == ""} return
    
    set name [$projlib new_name surface HULL 0]
    $projlib new_family HULL
    set snum [$projlib create_unstruct_surface_from_files $name HULL \
		  [lindex $files 0] [lindex $files 1]]
    
    cmd_rm [lindex $files 0]
    cmd_rm [lindex $files 1]
    
    set bsp [define_geom_object surface $snum]
    $projlib orient_triangles_outward $snum [$bsp get_centroid]
    $bsp set_source_objects [lindex $files 2] ""
    
    cad_clear_bsplines $current_shape
    cad_shape_from_bsplines $current_shape $bsp
    set surf_is_used($bsp) 1
    cad_set_small $bsp
}

proc cad_edit_material_points {} {
    user_error "not yet implemented"
}

proc cad_extract_corners {} {
    global projlib current_shape current_object geo_create surf_is_used
    
    set bsps [$current_shape list_bsplines]
    set surfs ""
    set matpts ""
    foreach bsp $bsps {
	if {$bsp == ""} continue
	set type [$bsp get -type]
	switch $type {
	    surface {
		lappend surfs $bsp
	    }
	    material {
		lappend matpts $bsp
	    }
	}
    }
    mess "Found [llength $surfs] surfaces in object\n"
    
    set curves ""
    set points ""
    
    # First extract curves from the surfaces
    set d [form_init .geo_create_curve_extract "Extract curve"]
    if {$d != ""} {
	set geo_create(curve,extract,bound) 2
	set geo_create(curve,extract,angle) 20.0
	set geo_create(curve,extract,minedge) 1
	
	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] {
	busy 1
	foreach surf $surfs {
	    switch [$surf get_object_type] {
		mesh {
		    set new [$projlib extract_curve [$surf get -bspline] \
				 $geo_create(curve,extract,bound) \
				 $geo_create(curve,extract,angle) \
				 $geo_create(curve,extract,minedge)]
		    foreach n $new {
			set nobj [define_geom_object curve $n]
			if {$nobj != ""} { lappend curves $nobj }
		    }
		}
		parametric {
		    set new [$projlib create_surface_edges [$surf get -name]]
		    foreach nname $new {
			set n [$projlib get_number_by_name curve $nname]
			set nobj [define_geom_object curve $n]
			if {$nobj != ""} { lappend curves $nobj }
		    }
		}
	    }
	}
	busy 0
	mess "Created [llength $curves] curves from surfaces\n"
	
	# Now extract points from the curves
	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
	    foreach curve $curves {
		switch [$curve get_object_type] {
		    mesh {
			set new [$projlib extract_points [$curve get -bspline]\
				     $geo_create(curve,extract,angle)]
			foreach n $new {
			    set nobj [define_geom_object point $n]
			    if {$nobj != ""} { lappend points $nobj }
			}
		    }
		    parametric {
			set new [$projlib create_curve_ends [$curve get -name]]
			set new [lindex [split [string trim $new] \n] end]
			foreach nname $new {
			    set n [$projlib get_number_by_name point $nname]
			    set nobj [define_geom_object point $n]
			    if {$nobj != ""} { lappend points $nobj }
			}
		    }
		}
	    }
	    busy 0
	    mess "Created [llength $points] points from curves\n"
	}
    }
    
    # Now put them all back in.  But some may have already been there so in
    # that case don't delete them.
    foreach c [concat $curves $points] { set keep($c) 1 }
    
    busy 1
    set obsp [$current_shape list_bsplines]
    $current_shape clear_bsplines
    foreach b $obsp {
	if [info exists keep($b)] continue
	set type [$b get -type]
	switch $type {
	    curve - point {
		set n [$b get -bspline]
		delete_geom_object $b
		$projlib delete_$type $n
		catch {unset surf_is_used($b)}
	    }
	}
    }
    set allbsp [concat $surfs $matpts $curves $points]
    cad_shape_from_bsplines $current_shape $allbsp
    busy 0
}

proc cad_import_iges_surf {type name job scale} {
    cad_load_iges $name
}

proc cad_init {} {
    global tdv_default
    global projlib tdv_default

    if {$projlib == ""} {
	set projlib [projlib_interface]
	$tdv_default add_image $projlib
        $projlib set_meshing_params global 0 gttol 0.001 gtrel 0
    }
}

proc cad_make_shape {} {
    global projlib current_object current_shape

    cad_init

    $current_shape clear_bsplines
    set newf "shape_[$current_object getval name]"
    $projlib new_family $newf

    set data [$projlib create_shape helical_slab pt1 "-1 0 0" pt2 "1 0 0" \
		  vec "0 1 0" cent "0 0 0" thick 0 angle 180]

    cad_put_shape $current_shape $newf $data
}

proc cad_clear_bsplines {sh} {
    global projlib surf_is_used surf_is_small

    set obsp [$sh list_bsplines]
    $sh clear_bsplines
    foreach b $obsp {
	set type [$b get -type]
	set n [$b get -bspline]
	delete_geom_object $b
	$projlib delete_$type $n
	catch {unset surf_is_used($b)}
	catch {unset surf_is_small($b)}
    }
#    db_dirty mesh
}

proc cad_put_shape {sh newf data} {
    global projlib

    #global shape_cad_draw_all
    #set shape_cad_draw_all 1

    cad_clear_bsplines $sh

    set snum 0
    foreach d $data {
	set t [lindex $d 0]
	set snam $newf.[incr snum]
	switch $t {
	    param_surface {
		set n [eval $projlib create_param_surface \"$snam\" \"$newf\" \
			   [lrange $d 1 end]]
		set type surface
	    }
	    mesh_surface {
		set n [$projlib create_surface_from_tris \
			   $snam $newf [lindex $d 1] [lindex $d 2]]
		set type surface
	    }
	    param_curve {
		set n [eval $projlib create_param_curve \"$snam\" \"$newf\" \
			   [lrange $d 1 end]]
		set type curve
	    }
	    mesh_curve {
		set n [$projlib create_unstruct_curve_from_points \
			   $snam $newf [lrange $d 1 end]]
		set type curve
	    }
	    point {
		set n [$projlib create_point $snam $newf [lindex $d 1]]
		set type point
	    }
	    material {
		set n [$projlib create_material $snam $newf [lindex $d 1]]
		set type material
	    }
	    fluid_material {
		$projlib new_family __FLUID__
		set n [$projlib create_material $snam __FLUID__ [lindex $d 1]]
		set type material
	    }
	}
	set obj [auto_define_geom_object $type $n]
	
	$sh add_bspline $obj
	#$obj configure -draw_nodes 1
    }
    $sh configure -projlib $projlib
#    db_dirty mesh
}

proc cad_set_shape {} {
    global projlib cad_shape_data current_shape
    
    if {$projlib == ""} {
	cad_load_tetin
	if {$projlib == ""} return
    }
    set d [form_init .set_cad_shape "Shape families"]
    if {$d != ""} {
	form_label $d.pointl "Point family" {0 0}
	form_label $d.curvel "Curve family" {1 0}
	form_label $d.surfacel "Surface family" {2 0}
	form_label $d.materiall "Material family" {3 0}
	futil_listentry $d.pointf cad_shape_data(pointf) \
	    "projlib_list_families" {0 1}
	futil_listentry $d.curvef cad_shape_data(curvef) \
	    "projlib_list_families" {1 1}
	futil_listentry $d.surfacef cad_shape_data(surfacef) \
	    "projlib_list_families" {2 1}
	futil_listentry $d.materialf cad_shape_data(materialf) \
	    "projlib_list_families" {3 1}
	form_finish bot
    }
    if ![form_wait .set_cad_shape] return
    
    $current_shape clear_bsplines
    foreach t {point curve surface material} {
	set f [set cad_shape_data(${t}f)]
	if {$f == ""} {
	    set nums [$projlib list_objects $t]
	} else {
	    set pid [$projlib lookup_family_pid $f]
	    if {$pid == ""} { error "no such family $f" }
	    set nums [$projlib get_objects_in_family $t $pid]
	}
	foreach n $nums {
	    set obj [$projlib get_object $t $n]
	    if {$obj != ""} {
		$current_shape add_bspline $obj
	    } else {
		puts "blah $t $n"
	    }
	}
	mess "[llength $nums] ${t}s ... " 
    }
    mess \n
}

proc cad_to_shape {types how for_obj only_2d obtype} {
    global tdv_default
    global current_object projlib cad_show_used surf_is_used
    global cad_area_ratio cad_max_pts cad_in_region_select
    global object_sections cad_possible_types cad_makes_section
    
    set surfs ""
    if {$for_obj != ""} {
	set osh [$for_obj getval body_shape]
	foreach tt {surfaces curves points} {
	    foreach fs [$osh get -from_$tt] {
		set num [eval $projlib get_number $fs]
		if {$num < 0} continue
		set obj [$projlib get_object [lindex $fs 0] $num]
		if ![$obj get -visible] continue
		lappend surfs $obj
	    }
	}
	if {$surfs == ""} { return 0 }
	set types [$osh get -shtype]
    }
    
    if {$surfs == ""} {
	set surfs [cad_select_surfaces]
        if {$surfs == ""} { return 0 }
    }
    
    switch $how {
	family {
	    foreach s $surfs {
		lappend got([$s get -family]) $s
	    }
	    foreach fam [array names got] {
		set n [cad_surfs_to_shape $types 1 "" $got($fam) $fam $only_2d $obtype]
		if !$n { return 0 }
	    }
	    return 1
	}
	region {
	    foreach s [array names surf_is_used] {
		if [$s get -visible] {
		    set prevv($s) 1
		    $s configure -visible 0
		}
	    }
	    foreach s $surfs {
		$s configure -visible 1
		catch {unset prevv($s)}
	    }
	    set cad_in_region_select 1
	    
	    banner "Draw lines with the left button, middle = done, right = back up/cancel, 'h' = horiz, 'v' = vert, 'n' = next, 'x' = cancel."
	    set lines [tdv_multiple_lines $tdv_default]
	    banner ""
	    
	    unset cad_in_region_select
	    
	    if {$lines == ""} {
		foreach s [array names prevv] {
		    $s configure -visible 1
		}
		return 0
	    }
	    
	    set planes ""
	    foreach {l1 l2} $lines {
		set v1 [$tdv_default screen2world [lindex $l1 0] [lindex $l1 1]]
		set v2 [$tdv_default screen2world [lindex $l2 0] [lindex $l2 1]]
		lappend planes [concat [lindex $v1 0] [lindex $v2 0] \
				    [lindex $v1 1]]
	    }
	    #puts "classify_by_regions $planes $surfs"
	    set buckets [classify_by_regions $planes $surfs 1]
	    #puts $buckets
	    foreach b $buckets s $surfs {
		lappend got($b) $s
	    }
	    set try_split 0
	    set ret 1
	    if [info exists got(1)] {
		# Bucket 1 is the one that holds stuff that spans more than
		# one region.
		set mess "[llength $got(1)] surfaces are in more than one\
			region.  You can:\n   \
				1. Ignore them,\n   \
				2. Split them up,\n   \
				3. Make them into a separate shape, or\n   \
				4. Cancel."
		switch [tk_dialog .mult_regions "Multiple regions" $mess \
			    "" -1 Ignore Split "Make shape" Cancel] {
				0 { unset got(1) }
				1 { set try_split 1 }
				2 { }
				3 { set ret 0 }
			    }
	    }
	    if $try_split {
		set surfs ""
		foreach b [array names got] {
		    if {$b != 1} { set surfs [concat $surfs $got($b)] }
		}
		set surfs1 [cad_split_surfaces $got(1) $planes]
		set surfs [concat $surfs $surfs1]
		unset got
		
		# Do it again with the split ones but don't ask for a shared
		# bucket this time.
		#puts "classify_by_regions $planes $surfs"
		set buckets [classify_by_regions $planes $surfs 0]
		#puts $buckets
		foreach b $buckets s $surfs {
		    lappend got($b) $s
		}
	    }
	    if $ret {
		foreach buck [array names got] {
		    set n [cad_surfs_to_shape $types 1 "" $got($buck) \
			       OBJ$buck $only_2d $obtype]
		    if !$n { set ret 0; break }
		}
	    }
	    foreach s [array names prevv] {
		$s configure -visible 1
	    }
	    return $ret
	}
	single {
	    return [cad_surfs_to_shape $types 1 $for_obj $surfs "" $only_2d $obtype]
	}
	rebuild {
	    return [cad_surfs_to_shape $types 0 $for_obj $surfs "" $only_2d $obtype]
	}
	cad {
	    return [cad_surfs_to_cad_object $surfs]
	}
    }
}

proc cad_split_surfaces {ss planes} {
    global projlib surf_is_used surf_is_small
    
    set nsurfs ""
    set old ""
    foreach s $ss {
	if {[$s get -type] != "surface"} {
	    lappend nsurfs $s
	    continue
	}
	unset surf_is_used($s)
	unset surf_is_small($s)
	lappend old [$s get -number]
	delete_geom_object $s
    }
    if {$old == ""} {
	mess "Warning: no objects to split\n" red
	return 
    }
    
    #puts "Split surfs: $old"
    foreach p $planes {
	set new ""
	foreach s $old {
	    if {[$projlib get_object_type surface $s] == "parametric"} {
		#puts "\tfacetize $s"
		set ns [$projlib facetize_surface $s 0]
		$projlib delete_surface $s
		set s $ns
	    }
	    set pp [plane_from_line_and_vec $p]
	    set n [$projlib segment_surface_plane $s \
		       [lindex $pp 0] [lindex $pp 1]]
	    if {$n != ""} {
		set new [concat $new $n]
		$projlib delete_surface $s
	    } else {
		lappend new $s
	    }
	    #puts "\tsegment $s into: $n"
	}
	set old $new
    }
    #puts "Got surfaces: $new"

    foreach n $new {
	set nb [cad_new_surf surface $n]
	if {$nb != ""} { lappend nsurfs $nb }
    }
    return $nsurfs
}

proc cad_new_surf {type n} {
    global projlib surf_is_used surf_is_small cad_min_feature_size
    global unit_default
    
    set nb [define_geom_object $type $n]
    set surf_is_used($nb) 0
    return [cad_set_small $nb]
}

proc cad_set_small {nb} {
    global projlib surf_is_used surf_is_small cad_min_feature_size
    global unit_default
    
    set mf [unit_convert $cad_min_feature_size $unit_default(length) 0]
    set surf_is_small($nb) [expr {[$nb get_feature_size] < $mf}]
    if !$surf_is_small($nb) {
	$nb configure -visible 1
	return $nb
    } else {
	$nb configure -visible 0
	return ""
    }
}

proc cad_surfs_to_shape {types makenew for_obj surfs name only_2d def_type} {
    global current_object projlib cad_show_used surf_is_used
    global cad_area_ratio cad_max_pts cad_possible_types cad_use_hull
    global cad_allow_nonunif cad_weight_factor object_sections cad_group
    global cad_volume_flag domain bindir object_sections cad_makes_section

    set has_hull [expr [file exists $bindir/hull] || \
		      [file exists $bindir/hull.exe]]
    
    set domcent [[db_shapes $domain 0] get_centroid]
    puts "geo_run_hull $surfs [expr $cad_use_hull && $has_hull] 1"
    set files [geo_run_hull $surfs [expr $cad_use_hull && $has_hull] 1]
    if {$files == ""} { return 0 }
    puts $files
    set pp [load_used_points [lindex $files 0] [lindex $files 1]]
    cmd_rm [lindex $files 0]
    cmd_rm [lindex $files 1]
    set nums [lindex $files 2]
    
    set keep ""
    set bestvol 0
    busy 1
    set types2 ""
    foreach shapetype $types {
	if {![info exists cad_possible_types($shapetype)] || \
		!$cad_possible_types($shapetype)} continue
	lappend types2 $shapetype
    }
    
    if {[llength $types2] == 1} { set force 1 } else { set force 0 }
    foreach shapetype $types2 {
	set sh [shape_$shapetype]
	set ff $force
	set this2d $only_2d
	if {($shapetype == "circ") && $only_2d} { set ff 1 }
	if {($shapetype == "polygon") && ($def_type == "plate")} {
	    set this2d 1
	}
	set va [$sh make_enclose_point_cloud [lindex $pp 0] [lindex $pp 1] \
		    $cad_area_ratio $cad_max_pts $cad_allow_nonunif $ff \
		    $this2d $domcent]
	if 0 {
	    puts "$sh make_enclose_point_cloud [lindex $pp 0] [lindex $pp 1] \
		    $cad_area_ratio $cad_max_pts $cad_allow_nonunif $force \
		    $only_2d $domcent"
	    puts "$shapetype, vol or area = $va, after factor = [expr $va * $cad_weight_factor($shapetype)]"
	}
	if {$va < 0} continue
	set va [expr $va * $cad_weight_factor($shapetype)]
	if {($keep == "") || ($va < $bestvol)} {
	    set bestvol $va
	    if {$keep != ""} { $keep delete }
	    set keep $sh
	}
    }
    free_used_points [lindex $pp 1] [lindex $pp 3]
    busy 0
    
    if {$keep == ""} {
	mess "Error: can't make any shape\n" red
	return 0
    }
    
    set names ""
    foreach nn $nums {
	set n [lindex $nn 0],[lindex $nn 1]
	set obj [$projlib get_object [lindex $nn 0] [lindex $nn 1]]
	if {($obj != "") && !$cad_show_used} {
	    $obj configure -visible 0
	}
	set surf_is_used($obj) 1
	cad_set_small $obj
	set name [list [$obj get -type] [$obj get -name]]
	if {$name != ""} { lappend names $name }
	set fam [$obj get -family]
	if {$fam != ""} { set famsused($fam) 1 }
    }
    set ktype [$keep get -shtype]
    $keep configure -from_surfaces $names
    if {($ktype != "circ") && ($ktype != "quad") && ($ktype != "wire")} {
	$keep setval volume_flag $cad_volume_flag
    }
    if [$keep get_volume] { set vaname volume } else { set vaname area }
    
    mess "Best shape is $ktype with weighted $vaname = $bestvol\n"
    
    if {$for_obj != ""} {
	set obj $for_obj
    } elseif $makenew {
	if {![info exists object_sections] || ($def_type == "best_fit")} {
	    set want_type [$keep get -shtype]
	} else {
 	    set want_type $def_type
	}
	if {[llength [array names famsused]] == 1} {
	    set nname [lindex [array names famsused] 0]
	} else {
	    set nname [lindex [lindex $names 0] 0]
	}
	regsub -all / $nname _ nname
	set obj [edit_new $want_type [db_ensure_new_name $nname] 1 noshapes]
	db_put_in_groups $obj "" $cad_group
    } else {
	set obj $current_object
    }
    
    set t [$obj getval obtype]
    if {[info commands app_make_object_fit_shape_$t] != ""} {
	app_make_object_fit_shape_$t $obj $keep
	if {$obj == $current_object} {
	    edit_reset_params
	}
    }
    edit_set_shape $obj $keep
    cad_assign_face_families $obj $keep $surfs
    return 1
}

proc cad_surfs_to_cad_object {surfs} {
    global projlib cad_show_used surf_is_used cad_volume_flag object_sections
    global cad_group current_object
    
    set keep [shape_cad -projlib $projlib -save_with_model 1]
    set names ""
    foreach s $surfs {
	$keep add_bspline $s
	if !$cad_show_used {
	    $s configure -visible 0
	}
	set surf_is_used($s) 1
	cad_set_small $s
	set name [$s get -name]
	if {$name != ""} { lappend names $name }
    }
    $keep setval volume_flag $cad_volume_flag
    
    if {[llength [array names famsused]] == 1} {
	set nname [lindex [array names famsused] 0]
    } else {
	set nname [lindex $names 0]
    }
    regsub -all / $nname _ nname
    set obj [edit_new cad $nname 1 noshapes]
    db_put_in_groups $obj "" $cad_group

    set t [$obj getval obtype]
    if {[info commands app_make_object_fit_shape_$t] != ""} {
	app_make_object_fit_shape_$t $obj $keep
	if {$obj == $current_object} {
	    edit_reset_params
	}
    }
    edit_set_shape $obj $keep
    set n 1
    foreach bsp $surfs {
	$obj setval fam_side$n [$bsp get -family]
	incr n
    }
    return 1
}

proc cad_assign_face_families {obj sh surfs} {
    foreach ss [$sh list_sides 0] {
	set name [lindex $ss 1]
	if ![$obj checkval fam_$name] continue
	set cent [$sh side_point [lindex $ss 0]]
	set bestd -1
	foreach s $surfs {
	    if {[$s get -type] != "surface"} continue
	    set d [lindex [$s point_distance $cent] 0]
	    if {($bestd < 0) || ($d < $bestd)} {
		set bestd $d
		set bestf [$s get -family]
	    }
	}
	if {$bestd >= 0} {
	    $obj setval fam_$name $bestf
	}
    }
}

proc cad_create_multiple {how {def_type ""}} {
    global object_type_title projlib object_sections cad_makes_section
    global cad_possible_types projlib cad_only_2d cad_creation_mode
    
    if {$def_type == "cad"} { set how cad }
    
    if {$how == "cad_creation_mode"} { set how $cad_creation_mode }
    
    if {$projlib == ""} {
	user_error "Please load some cad data first."
	return
    }
    
    set typen shapes
    if {$how == "cad"} {
	set typen "CAD objects"
	mess "Warning: you can only use the tetra mesher with CAD objects\n" red
	set def_type cad
    }
    
    if {$def_type == "best_fit"} {
	set typen "the best matching shape"
	
    } else {
	set typen [string tolower $object_type_title($def_type)]
    }
    
    set mess "This function will create $typen from CAD surfaces. \
	First you will be prompted to select a tetin file.  If you don't then\
	the existing CAD geometry will be used.  Then you will be prompted to\
	select multiple subsets of CAD surfaces, which will be used to create\
	objects.  After the objects are created you can modify them using the\
	Edit button or continue creating objects."
    
    if {($def_type != "best_fit") && \
	    ([info exists object_sections($def_type)] || \
		 ([info exists cad_makes_section($def_type)]))} {
	if [info exists cad_makes_section($def_type)] {
	    set types [lrange $cad_makes_section($def_type) 1 end]
	} else {
	    set types [lrange [lindex $object_sections($def_type) 0] 2 end]
	}
	set only_2d [info exists cad_only_2d($def_type)]
    } else {
	set types [array names cad_possible_types]
	set only_2d 0
    }
    while 1 {
	if ![cad_to_shape $types $how "" $only_2d $def_type] break
    }
}

proc cad_regenerate {} {
    global object_sections cad_possible_types projlib
    
    if {$projlib == ""} {
	user_error "Please load CAD data first."
	return
    }
    
    
    foreach obj [db_list_objects] {
	cad_to_shape "" rebuild $obj 0 ""
    }
}

proc cad_toggle_show {} {
    global cad_show_used cad_show_unused surf_is_used fam_visible
    global surf_is_small cad_show_solid cad_in_region_select cad_use_type
    
    if $cad_show_solid { set shade flat_wire } else { set shade wire }
    
    foreach s [array names surf_is_used] {
	if [info exists cad_in_region_select] {
	    set on [$s get -visible]
	} else {
	    if $cad_use_type([$s get -type]) {
		if $surf_is_used($s) {
		    set on $cad_show_used
		} else {
		    set on $cad_show_unused
		}
		if $surf_is_small($s) { set on 0 }
		set f [$s get -family]
		if {[info exists fam_visible($f)] && !$fam_visible($f)} {
		    set on 0
		}
	    } else {
		set on 0
	    }
	}
	$s configure -visible $on -shade $shade
    }
}

proc cad_blank_below_minfeature {} {
    global cad_min_feature_size surf_is_small unit_default
    
    set mf [unit_convert $cad_min_feature_size $unit_default(length) 0]
    
    foreach s [array names surf_is_small] {
	if [catch {set fs [$s get_feature_size]}] {
	    # not sure why this happens
	    unset surf_is_small($s)
	    continue
	}
	set surf_is_small($s) [expr {$fs < $mf}]
    }
    cad_toggle_show
}

proc cad_before_delete {obj} {
    global surf_is_used projlib surf_is_small
    
    if {$projlib == ""} return
    
    foreach sh [db_shapes $obj] {
	foreach fs [$sh get -from_surfaces] {
	    set num [eval $projlib get_number $fs]
	    if {$num < 0} continue
	    set obj [$projlib get_object [lindex $fs 0] $num]
	    set surf_is_used($obj) 0
	}
    }
    cad_toggle_show
}

proc cad_edit_options {full} {
    global cad_possible_types app_name bindir volume_types object_type_title
    global cad_no_best_fit_button
    
    set wantvol [expr {($app_name != "icepak") && ($app_name != "airpak")}]
    set has_hull [expr [file exists $bindir/hull] || \
		      [file exists $bindir/hull.exe]]
    
    set w [form_init .cad_modals_$full "CAD data operation options"]
    if {$w != ""} {
	set ff [form_label_frame $w.poly "Polygon options" {0 0 -cols 3}]
	form_label $ff.aratl "Max volume change" {0 0}
	form_label $ff.maxpl "Max polygon points" {1 0}
	form_entry $ff.arat cad_area_ratio float {0 1}
	form_entry $ff.maxp cad_max_pts float {1 1}
	
	# -------------------------
	
	set ff [form_label_frame $w.minf "Minimum feature size" {1 0 -cols 3}]
	
	form_label $ff.minfeatl "Value" {4 0}
	form_entry $ff.minfeat cad_min_feature_size float {4 1}
	form_button $ff.minfeatup "Blank below value" cad_blank_below_minfeature {5 0 -cols 3}
	form_label_variable $ff.minfeatu unit_default(length) {4 2}
	
	# -------------------------
	
	if [info exists cad_no_best_fit_button] {
	    set lab "Select CAD geometry types"
	} else {
	    set lab "Select for best fit"
	}
	set ff [form_label_frame $w.use $lab {2 0 -cols 3}]
	form_checkbutton $ff.surface "Surfaces" cad_use_type(surface) {0 0}
	form_checkbutton $ff.curve "Curves" cad_use_type(curve) {1 0}
	form_checkbutton $ff.point "Points" cad_use_type(point) {0 1}
	form_checkbutton $ff.material "Materials" cad_use_type(material) {1 1}
	foreach i {surface curve point material} {
	    $ff.$i configure -command cad_toggle_show
	}
	
	# -------------------------
	
	form_label $w.groupl "Group for new objects" {5 0}
	form_entry $w.group cad_group string {5 1 -cols 2}
	
	#form_checkbutton $w.usehull "Use convex hull" cad_use_hull {10 0 -cols 3} $has_hull
	form_checkbutton $w.nunif "Allow non-uniform shapes" cad_allow_nonunif {11 0 -cols 3}
	set scalelab "Autoscale [string tolower $object_type_title(domain)]"
	form_checkbutton $w.autosc $scalelab cad_do_autoscale {12 0 -cols 3}
	if $wantvol {
	    form_label $w.volt "Default volume type:" {15 0}
	    if {[info exists volume_types] && 
		($volume_types == "meshed non-meshed")} {
		form_radiobutton $w.vsol "Meshed" cad_volume_flag 1 {15 1 -cols 2}
		form_radiobutton $w.vhol "Non-meshed" cad_volume_flag 0 {16 1 -cols 2}
	    } else {
		form_radiobutton $w.vhol "Hollow" cad_volume_flag 0 {15 1 -cols 2}
		form_radiobutton $w.vsol "Solid" cad_volume_flag 1 {16 1 -cols 2}
		form_radiobutton $w.vflu "Fluid" cad_volume_flag 2 {17 1 -cols 2}
	    }
	}
	
	if $full {
	    form_label $w.tryl "Best fit shapes to try:" {20 0}
	    set i 19
	    foreach sh [lsort [array names cad_possible_types]] {
		form_checkbutton $w.try$sh $sh cad_possible_types($sh) "[incr i] 1 -cols 2"
	    }
	}
	
	form_finish bot
    }
    
    if ![form_wait .cad_modals_$full] return
    
    cad_blank_below_minfeature
}

proc cad_blank_surface {} {
    global surf_is_used 
    
    while 1 {
	set surfs [cad_select_surfaces]
	if {$surfs == ""} return
	foreach s $surfs {
	    $s configure -visible 0
	    set surf_is_used($s) 2  ;# this means blanked but not used
	}
    }
}

proc cad_unblank_surface {} {
    global surf_is_used 
    
    set n 0
    foreach s [array names surf_is_used] {
	if {$surf_is_used($s) == 2} {
	    $s configure -visible 1
	    set surf_is_used($s) 0
	    incr n
	}
    }
    mess "$n surfaces unblanked\n"
}

proc cad_change_family {} {
    global fam_visible projlib
    
    while 1 {
	set surfs [cad_select_surfaces]
	if {$surfs == ""} return
	set fam [select_families 0 0 1 "" fam_visible +300+300 "Change family"]
	if {$fam == ""} return
	if ![info exists fam_visible($fam)] {
	    set fam_visible($fam) 1
	    cad_update_families
	}
	$projlib new_family $fam
	foreach s $surfs {
	    $projlib set_family surface [$s get -number] $fam
	    $s configure -family $fam -color [family_color_for_name $fam]
	    if !$fam_visible($fam) { $s configure -visible 0 }
	}
    }
}

proc cad_select_surfaces {} {
    global tdv_default
    set surfs [select_geometry entity]
    tdv_selection_bindings $tdv_default ;# can get messed up sometimes
    set ret ""
    foreach s $surfs { if [$s get -visible] { lappend ret $s } }
    return $ret
}

proc cad_edit_families {} {
    global projlib fam_visible cad_fam_window
    
    set w [form_init .cad_families "CAD families" "" close]
    if {$w != ""} {
	form_frame $w.f flat 0 {0 0}
	set cad_fam_window $w.f
	check_box $cad_fam_window "" "10 10" fam_visible 1 \
	    cad_toggle_show
	form_finish bot
    }
    cad_update_families
}

proc cad_update_families {} {
    global projlib fam_visible cad_fam_window
    
    if ![info exists cad_fam_window] return
    set allfams [fam_get_sorted]
    
    set opts ""
    foreach f $allfams {
	set col [family_color_for_name $f]
	if ![info exists fam_visible($f)] { set fam_visible($f) 1 }
	lappend opts [list $f -text $f -command cad_toggle_show \
			  -selectbackground $col -foreground $col]
    }
    
    check_box $cad_fam_window $opts "15 8" fam_visible 1 \
	cad_toggle_show
}

proc cad_delete_surface {} {
    global surf_is_used
    
    set surfs [cad_select_surfaces]
    foreach s $surfs { unset surf_is_used($s) }
    delete_geom_object $surfs
}

proc cad_delete_unused_family {} {
    global fam_visible projlib

    foreach fam [array names fam_visible] {
	set pid [$projlib lookup_family_pid $fam]
	if {[$projlib get_objects_in_family "" $pid] == ""} {
	    unset fam_visible($fam)
	}
    }
    cad_update_families
}

proc cad_get_bbox {} {
    global projlib
    if {$projlib != ""} {
	return [$projlib get_bbox]
    } else {
	return ""
    }
}

proc cad_convert_iges_tetin {name tetin iparta} {
    global bindir igespost_exec_path ssish_path app_dir env is_win
    global autohex_root

    set env(ICEM_CASE_SENSITIVE) y
    set env(ICEM_NOLOCK) y
    set env(ICEM_NO_SPACE_CHECK) 1

    if {($igespost_exec_path == "not_found") || \
	    ($ssish_path == "not_found")} {
	mess "Can't convert IGES - converter programs not found\n" red
	return 0
    }
    set log1 [cmd_tempfile igeslog]
    set dirfile [file dirname $igespost_exec_path]/dir_iges_general
    if ![file exists $dirfile] {
	set dirfile $app_dir/../iges/dir_iges_general
    }

    set cmd1 "\"$igespost_exec_path\" \"i=$name\" \"o=$iparta\" \"l=$log1\" \
	logit=yes ds=a name=IMPORT sheet=1"
    #\"d=$dirfile\"
    
    set tmp [directory]/ssish_in
    set fp [open $tmp w]
    puts $fp "prttotin \"$iparta\" \"$tetin.tmp\"" ;# levels_to_families
    close $fp
    set cmd2 [list $ssish_path < $tmp]

    cmd_rm $tetin
    cmd_rm $iparta
    
    busy 1
    
    set qq GE; set env(CFD_I${qq}S_ONLY) 1
    set retval [run_background $cmd1 "" 1]
    unset env(CFD_I${qq}S_ONLY)
    
    if ![file exists $iparta] {
	user_error "The IGES converter was not able to convert the file.  Please check the message window for error messages.\n"
	busy 0
	return 0
    }
    
    if 0 {
    if $is_win {
	# We have to get rid of the ^M's because ssish doesn't like them
	set fp [open $iparta r]
	set fp2 [open $iparta.2 w]
	fconfigure $fp2 -translation lf
	set x 0
	while {![eof $fp]} {
	    set line [string trim [gets $fp]]
	    if {$x < 10} { mess "got [llength $line] : $line\n" ; incr x }
	    puts $fp2 $line
	}
	close $fp
	close $fp2
	cmd_rm $iparta
	cmd_mv $iparta.2 $iparta
    }
    }

    # set cmd2 "$iparta_to_tetin_path -i \"$iparta\" -w \"$tetin\""
    
    if $retval {
	set env(Ic_MXYZPTLK) FIX_THE_LICENSE_CODE
	set otcl $env(TCL_LIBRARY)
####	set env(TCL_LIBRARY) $autohex_root/lib/tcl8.1
	set retval [run_background $cmd2 "" 1 "" [list *utm/iparta_to_tetin*]]
	unset env(Ic_MXYZPTLK)
	set env(TCL_LIBRARY) $otcl
    }
    
    if ![file exists $tetin.tmp] {
	user_error "The IPARTA -> Tetin converter was not able to convert the file.  Please check the message window for error messages.\n"
	busy 0
	return 0
    }
    
    set fp1 [open $tetin.tmp r]
    set fp2 [open $tetin w]
    while {![eof $fp1]} {
 	set line [gets $fp1]
 	if [string match read_family_boco* $line] continue
 	puts $fp2 $line
    }
    close $fp1
    close $fp2
    cmd_rm $tetin.tmp
    
    cmd_rm $tmp
    busy 0
    
    return $retval
}

proc cad_convert_step_tetin {name tetin} {
    global steptotin_path env

    busy 1
    set cmd1 [list $steptotin_path $name $tetin]
    set qq GE; set env(CFD_I${qq}S_ONLY) 1
    set retval [run_background $cmd1 "" 1]
    unset env(CFD_I${qq}S_ONLY)    
    busy 0
    
    if ![file exists $tetin] {
	user_error "The IGES/Step converter was not able to convert the file.  Please check the message window for error messages.\n"
    }
    
    return $retval
}

proc cad_convert_tetin_step {tin step do_iges} {
    global steptotin_path env

    busy 1
    set cmd1 [list $steptotin_path $tin $step]
    set qq GE; set env(CFD_I${qq}S_ONLY) 1
    set retval [run_background $cmd1 "" 1]
    unset env(CFD_I${qq}S_ONLY)    
    busy 0
    
    if ![file exists $step] {
	user_error "The IGES/Step converter was not able to convert the file.  Please check the message window for error messages.\n"
    }
    
    return $retval
}

proc cad_convert_dwg_tetin {name tetin} {
    global dwg2tin_path env autohex_root
    
    if {$dwg2tin_path == "not_found"} {
	mess "Can't convert DWG - converter programs not found\n" red
	return 0
    }
    
    if ![info exists env(ICEM_ACN)] {
	set env(ICEM_ACN) $autohex_root
    }
    set cmd1 "$dwg2tin_path \"$name\" \"$tetin\""
    
    cmd_rm $tetin
    
    busy 1
    set retval [run_background $cmd1 [pwd] 1]
    busy 0
    
    return $retval
}

proc cad_convert_acis_tetin {name tetin} {
    global acistotin_path env
    
    if {$acistotin_path == "not_found"} {
	mess "Can't convert ACIS - converter programs not found\n" red
	return 0
    }
    
    set cmd1 "$acistotin_path -sat \"$name\" -tin \"$tetin\""
    
    cmd_rm $tetin
    
    busy 1
    set retval [run_background $cmd1 [pwd] 1]
    busy 0
    
    return $retval
}

# -----

proc cad_save_unused {} {
    global surf_is_used projlib whoami
    
    set file [directory]/tetin_unused
    
    set un 0
    foreach s [array names surf_is_used] {
	set ovis($s) [$s get -visible]
	$s configure -visible [expr !$surf_is_used($s)]
	if !$surf_is_used($s) { incr un }
    }
    if {($projlib == "") || !$un} {
	cmd_rm $file
	return
    }
    mess "Saving $un unused CAD [expr {($un == 1) ? "entity" : "entities"}]\
	to $file.\n"
    
    $projlib save_model $file $whoami 1
    
    foreach s [array names ovis] { $s configure -visible $ovis($s) }
}

proc cad_reload_unused {} {
    global projlib
    
    set file [directory]/tetin_unused
    if [file exists $file] {
	mess "Reloading unused CAD entities from $file.\n"
	cad_do_load_tetin $file 0 ""
	if {$projlib != ""} { $projlib configure -visible 1 }
    }
}

# This is because the code to make this happen is different in med and autohex

proc object_show_geo_selected {im on} {
    show_geo_selected $im $on
}

proc cad_set_create_menu {single menu} {
    global object_type_list object_type_title object_sections
    global cad_include_best_fit_command
    
    $menu delete 0 end
    if [info exists cad_include_best_fit_command] {
	$menu add command -label "Best fit" -command \
	    "cad_create_multiple $single best_fit"
    }
    foreach t [lsort $object_type_list] {
	if {![info exists object_sections($t)] || \
		($object_sections($t) == "")} continue
	if {($single != "single") && ($t == "cad")} continue
	
	set cmd "cad_create_multiple $single $t"
	$menu add command -label $object_type_title($t) -command $cmd
    }
}

proc get_fam_visible {v}  { 
    global fam_visible
    if [ info exists fam_visible($v) ] { 
	return $fam_visible($v)
    } else {
	return 1
    }
}
proc get_geom_visible {v} { 
    global cad_use_type
    if [ info exists cad_use_type($v) ] {
	return $cad_use_type($v)
    } else {
	return 1
    }
}

