#
# Library functions for the scripting library (scrib)
#
# File: scrib/lib/assembly.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2003 ICEM CFD Engineering
#
#--------------------------------------------------------------------
#
# --> if the name of the first proc already exists in interp, return
#
if {"" != [info commands scrib_lib_assembly_famname_get]} { return }
#
# --> procs in this file depend on the following scrib/lib/ files--source them
#     I guess we could do this by proc, too, not sure waht's best
#
if 0 {
    # none required
    set required_files ""
    scrib_lib_setup_source_files $required_files
}
#
# ------------------------------------------------------------------------

## returns a standardized family name for mapping fileid's to family names

proc scrib_lib_assembly_famname_get {fileid} {
    
    set fileid [scrib_lib_assembly_naspid_standardize $fileid]
    set token FAM_
    set ret "${token}${fileid}"
    #mess "DEBUG: $ret\n" 
    return $ret
}

# From Simon:          Wed, 2 Oct 2002 16:31:06 -0400
#
# 1)       Ford PIDs often have a letter part way into the name.  ie.
# 15624c06, 15000k50 or 15000k51.  This causes several problems currently.
# a.       Welds can be screwed up by this because the letter lengthens
# the string by one character from the norm.  the last digits are
# truncated and 15000k50 looks identical to 15000k51.
# b.       Offsets will have similar problems to the weld.  Plus this is
# where the Nastran PIDS are set.  Nastran can not handle the letters, so
# it just stops the string if it encounters them.  In other words all
# parts of the format 15000[any letter][any other digits] comes out as
# 15000. 
#
# This problem needs to be over come.  In the assemblies I have looked at,
# I have not seen any that had two parts with the same digits that differ
# only by the letter, but Matt George thinks it is likely to happen
# eventually.  Perhaps we could put in a numeric equivalent when filling
# out the Nastran Cards, ie, A=01, B=02, Z=26?
# 
# My guess is that the welding and offsetting can handle the letters, we
# just need it to check for one more character if it sees a letter?  What
# happens if we just set the pid string to the longer length?  Will there
# be a problem on the shorter part numbers?
 
# Most parts also have an _A or _B after the part.  For instance in our
# assembly we had 1502572_A and 1502572_B.  Almost every part had an
# extension like this, though most were _A.
# ------------------------------------------------------------------------

## returns a standardized family name for mapping fileid's to family names.
## the name, of course, may be longer...

proc scrib_lib_assembly_naspid_standardize {fileid} {
    
    set charmap {
	a 01  b 02  c 03  d 04  e 05  f 06  g 07
	h 08  i 08  j 09  k 11  l 12  m 13  n 14
	o 15  p 16  q 17  r 18  s 19  t 20  u 21
	v 22  w 23  x 24  y 25  z 26  - 27  _ 28
    }
    
    set new_fileid $fileid
    for {set i 0} {$i < [string length $new_fileid]} {incr i} {
	set char [string range $new_fileid $i $i]
	if ![string is integer $char] {
	    set stdchar [string tolower $char]
	    set newchar [string map $charmap $stdchar]
	    set new_fileid [string replace $new_fileid $i $i $newchar]
	}
    }
    
    return $new_fileid
}

## extract and return a nastran-shell-pid (<em>nchars</em> long) from
## the given filename <em>filename</em>, based on the <em>offset</em>
## (+/- integer) from the boundary of the first occurence of the first
## key found in the list of <em>keys</em> to the boundary of the pid.
## You can optionally indicate the <em>defaultpid</em>, in case none found.

proc scrib_lib_assembly_filename_naspid_get {filename keys nchar offset {defaultpid 1}} {
    #
    #
    foreach k $keys {
	#
	# try to find each kind in the filename
	#
	set loc [string first $k $filename]
	if {0 > $loc} continue
	#
	# okay, found the key, now get the range we want
	#
	# if offset is positive, then start from key end bound
	if {$offset > 0} {
	    # then set the pid token range to {loc + keylen + offset, loc + keylen + offset + nchar}
	    #
	    set start [expr $loc + [string length $k] + [expr abs($offset)] - 1]
	} else {
	    # then set the pid token range to {loc - nchar - offset, loc - offset}
	    #
	    set start [expr $loc - $nchar - [expr abs($offset)] + 1]
	}
	set end [expr $start + $nchar - 1]
	set filepid [string range $filename $start $end]
	if {"" != $filepid} {
	    return [scrib_lib_assembly_naspid_standardize $filepid]
	}
    }
    #
    # this is the default pid key
    #
    return $defaultpid
}

## get the shell family/families of type ISHE/ISHR with the given nastran pid

proc scrib_lib_assembly_get_shell_families_for_naspid {naspid} {
    
    # we'll return this list:    
    set families_with_naspid ""
    
    # look for bocos of these types:
    set shell_types [list ISHE ISHR]
    
    foreach st $shell_types {
	
	set matches [ic_boco_list_with_bctype [list $st $naspid]]
	if {"" != $matches} {
	    foreach m $matches {
		set fam_name [lindex $m 0]
		if {"" != $fam_name} {
		    lappend families_with_naspid $fam_name
		}
	    }
	}
    }
    
    return $families_with_naspid
}

## set the naspid SHELL on the given family

proc scrib_lib_assembly_set_naspid_on_shell_family {family naspid} {
    
    if {("" == family)} {
	mess "Warning: could not set SHELL pid $naspid on $family...does not exist\n" red
	return 0
    }
    
    set shell_type "ISHE"
    set bcs [list [list 1 $shell_type $naspid]]
    if [catch {ic_boco_set $fam $bcs} res] {
	mess "Warning: could not set SHELL pid $naspid on $family: $res\n" red
	return 0
    }
    
    mess "Set SHELL pid $naspid on $family\n"
    return $res
}

## run the scrib/scripts/assembly.tcl script

proc scrib_lib_assembly_assemble_script {} {
    global proc_scrib_data env
    
    scrib_lib_uns_remove_tempfiles
    
    set script "assembly.tcl" ;# [file join $env(ICEM_SCRIB) scripts assembly.tcl]
    set proc_scrib_data(batch_script) $script
    set job_token $script
    
    set args ""
    set stat [scrib_lib_exec_medbatch $job_token "$script" $args "" $proc_scrib_data(interactive)]
    
    stdout "\nFinished assembling.\n"
    
    return $stat
}

## run the scrib/scripts/mesh_assembly.tcl script with proc_scrib_data(wdir)

proc unused_scrib_lib_assembly_assemble_weld_script {exec_args} {
    global proc_scrib_data
    
    set script "mesh_assembly.tcl"
    set job_token [scrib_lib_exec_get_unique_job_token [file rootname $script]]
    set med_args ""
    set stat [scrib_lib_exec_medbatch $job_token "$script" $med_args $exec_args]
    
    mess "\nFinished assembling and welding.\n"
}

## load all files with extension <em>ext</em> from directory <em>dir</em> and, perhaps,
## save to file <em>savefile</em> in which case unload that object too.

proc scrib_lib_assembly_familybocos_load {dir {savefile ""} {ext fbc}} {
    #
    # --> get files with `$ext' extension to load in directory `$dir'
    #
    set files [glob -nocomplain $dir/*.$ext]
    foreach f $files {
	ic_boco_load $f
    }
    mess "scrib_lib_assembly_familybocos_load: merged [llength $files] .$ext files\n"
    #
    # --> save as `savefile' if specified
    #
    if {("" != $savefile) && [ic_boco_is_loaded]} {
	ic_boco_save_atr $savefile
	ic_boco_unload
	mess "scrib_lib_assembly_familybocos_load: saved fbc file $savefile\n"
    }
}

proc jd_weld {{interactive 0}} {
	scrib_lib_assembly_midsurface_weld_file 50 "" proWeldData.dat 10.0 COMP- WELD_ MID_ 0.1 $interactive 0
#scrib_lib_assembly_midsurface_weld_file 27 "" "" 8 COMP- WELD_ MID_ 0.1 1 0
}

## The following is a script initially for Pro/E parts using a weld file from Pro/E.
#====================================================
proc scrib_lib_assembly_midsurface_weld_file { {max_dist 10} {tetin ""} \
	{weld_file ""} {mesh_size 8} {mid_part_string COMP-}  \
	{weld_part_string WELD_} {new_mid_part_string MID_} {topo 0.1} \
	{debug 0} {interactive 0} {exit_at_end 0}} {
#set debug -3
    global env details
    if { ( $env(AI_ENV_PRODUCT) != "fea2.0" ) && ( $env(AI_ENV_PRODUCT) != "fsi" )} {
	mess "Need to set AI_ENV_PRODUCT environment variable to an applicable product fea2.0 or fsi\n"
	return
    }
ic_undo_stop
tdv_active 0

# 1. Read tetin file 
	if {$tetin == ""} {
	    set tetin [lindex [exec ls -t *.tin] 0]
	    set domain [file tail [file rootname $tetin]].uns
	    set fbc [file tail [file rootname $tetin]].fbc
	    set atr [file tail [file rootname $tetin]].atr
	    set par [file tail [file rootname $tetin]].par
	    mess "Tetin file is $tetin ; Domain file is $domain \n"
	}
	ic_load_tetin $tetin

	if {$debug > 1} {set debug [expr $debug * -1]}
	if {$debug == 0} {set debug -1000}
	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Read Pro/E Weld file?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}

# 2. Read Weld data --read weld data, and change names of weld surfaces
	if {$weld_file != ""} {
	    set name_type_parts_list [scrib_lib_assembly_read_proe_features_file $weld_file $topo]
	    if {$name_type_parts_list == ""} {set auto_weld 1} else {set auto_weld 0}
	} else {
	    set name_type_parts_list ""
	    set auto_weld 1
	}

# 3. Configure weld features (find four corners, and sides) and add to list of surface_features
	set name_type_parts_sides_list [scrib_lib_assembly_midsurface_configure_sides $name_type_parts_list $mid_part_string $max_dist]
#	mess "\n--------\n name_type_parts_sides_list is $name_type_parts_sides_list\n\n" blue

	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Midsurface?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 4. Configure midsurface data -- build topo and find potential side surfaces for each part
	set mid_parts [scrib_lib_assembly_midsurface_configure_parts $mid_part_string ]
	set solid_parts ""
	set new_mid_parts ""
	foreach p $mid_parts {
	    ic_build_topo $topo $p
	    set mids MID_$p
	    set srfs [ic_geo_get_objects surface $p]
	    ic_geo_midsurface max_dist $max_dist save_old 1 ask 0 partial 0 similar 1 precision 0 family $mids surfaces $srfs
	    ic_build_topo $topo -no_reg_surf -no_concat $mids
	    scrib_lib_assembly_midsurface_keep_only_largest_conn_region $mids
	    ic_build_topo $topo $mids $p
	    set single_curves [scrib_lib_geo_get_single_curves [ic_geo_get_objects curve $mids]]
	    set NOGO 0
	    foreach c $single_curves {
		if {[ic_geo_crv_length $c] > $mesh_size} {set NOGO 1}
	    }
	    if $NOGO {
		lappend solid_parts $p
		continue
	    }
	    lappend new_mid_parts $mids
	    set mid_curves [scrib_lib_geo_get_connected_entities curve [ic_geo_get_objects surface $mids]]
	    set mid_points [scrib_lib_geo_get_connected_entities point $mid_curves]	
	    ic_geo_set_family curve $mids names $mid_curves 0
	    ic_geo_set_family point $mids names $mid_points 0
	}

#	set mid_parts $new_mid_parts
	if {$solid_parts != ""} {
	    mess "\n \n ----- \n Solid or open parts are $solid_parts\n" blue
	    if $interactive {
		aie_create_initial_assemblies
		foreach p [ic_geo_list_parts] {
		    if {[lsearch $solid_parts $p] != -1} {
			::AIEnv::GUIManagement::Tree::ToggleGroupVisibility part $p 2
		    } else {
			::AIEnv::GUIManagement::Tree::ToggleGroupVisibility part $p 0
		    }
		}
		aie_update_visible
	    }
	}
	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Find proper sides?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 5. Find which of the two parts should be side and which should be welded to.
#name_type_parts_sides_list is a list of {family_of_feature feature_type parts side_curves_in_family_of_feature}
	set weld_problem_feature ""
	set valid_features ""
	foreach weld $name_type_parts_sides_list {
	    set sides [lindex $weld 3]
	    set parts  [lindex $weld 2]
	    set feature [lindex $weld 0]
	    set vparts ""
	    set OK_FEATURE 1
	    foreach p $parts {
		#remove wrong parts, or empty parts
		if {[lsearch [ic_geo_list_parts] $p] != -1} {lappend vparts $p}
		#if any part is solid feature can't weld currently
		if {[lsearch $solid_parts $p] != -1} {
		    mess "can not weld parts $parts in feature $feature as $p is a solid part\n" red
		    lappend weld_problem_feature $feature
		    set details($feature) "" 
		    set OK_FEATURE 0
		    break
		}
	    }
	    if !$OK_FEATURE continue
	    set parts $vparts
	    if {[llength $parts] != 2} {
		set details($feature) "" 
		mess "error not getting 2 parts in weld feature, parts are $parts\n" red
		lappend weld_problem_feature $feature
#		mess "Trying to find parts based off projection\n"
		continue
	    }
	    set part1 MID_[lindex $parts 0]
	    set part2 MID_[lindex $parts 1]
	    set NOGO 0
	    foreach pp [list $part1 $part2] {
		if {[lsearch [ic_geo_list_parts] $pp] == -1} {
		    set NOGO 1
		    mess "part $pp not found in model\n"
		}
	    }
	    if $NOGO continue
	    set weld_curve_part_list [scrib_lib_assembly_side_surface_cut_curves \
			$part1 $part2 $sides $max_dist $topo $feature]
	    if {($weld_curve_part_list == "") || ([llength $weld_curve_part_list] < 2) } {
		lappend weld_problem_feature $feature
		continue
	    }
	    set welding_points_on_mid($feature) [lindex $weld_curve_part_list 0]
	    set weld_to_part_on_mid($feature) [lindex $weld_curve_part_list 1]
	    set weld_from_part_on_mid($feature) [lindex $weld_curve_part_list 2]
	    lappend valid_features $feature
	    if {[lindex $weld_curve_part_list 0] == "cylinder"} {
		set welding_curves_on_mid($feature) [lindex $weld_curve_part_list 3]
		set cyl_feature($feature) 1
	    } else {
		set cyl_feature($feature) 0
	    }
	}
	if {$debug > 0} {
	    tdv_active 1
	    if [llength $weld_problem_feature] {mess "problems welding features $weld_problem_feature\n"}
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Find curves between cutting points?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 6. Find the curves between the cutting points
	foreach feature $valid_features {
	    if !$cyl_feature($feature) {
		set welding_curves_on_mid($feature) [scrib_lib_assembly_side_surfs_find \
		    $weld_from_part_on_mid($feature) $welding_points_on_mid($feature) $feature $max_dist]
	    }
	    foreach cc $welding_curves_on_mid($feature) {ic_geo_subset_add_items EXT_PAIR/$feature [list curve $cc]}
	    foreach ss [ic_geo_get_objects surface $weld_to_part_on_mid($feature)] {ic_geo_subset_add_items EXT_PAIR/$feature [list surface $ss]}

	    if [llength [info commands aie_getBatchGeomDisplay]] {aie_getBatchGeomDisplay}

	}

	if {$debug > 0} {
	    tdv_active 1
	    if [llength $weld_problem_feature] {mess "problems welding features $weld_problem_feature\n"}
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Create curtain surfaces?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 7. Create the curtain surfaces from welding_curves_on_mid($feature)
	foreach feature $valid_features {
	    set curves $welding_curves_on_mid($feature)
	    #Review curves to ensure no curves got removed in other features
	    set new_crvs ""
	    foreach c $curves {
		foreach cc $c {
		    if [llength [ic_geo_check_objects_exist curve $cc]] {lappend new_crvs $cc}
		}
	    }
	    set curves $new_crvs

	    if {$curves == ""} {
		mess "can't weld feature $feature since no curves are given\n" red
		continue
	    }
	    set part $weld_to_part_on_mid($feature)
	    if {[lsearch [ic_geo_list_parts] $part] == -1} {
		mess "can't weld feature $feature since part $part is not found\n" red
		continue
	    }
	    set current_part [ic_geo_get_family curve [lindex $curves 0]]
#	    set current_part WELDS
#	    set x [ic_geo_create_surface_curtain $curves \
#		[ic_geo_get_objects surface $part] $current_part $current_part 1 1]
	    set x [ic_geo_surface_extend $curves [ic_geo_get_objects surface $part] $topo 0 0 0]
if 0 {
#This would be best fixed within curtain surface, but a work-a-round for now...
	    if {([ic_geo_check_objects_exist surface $x] == "") && ($curves != "")} {
		mess "curtain surfacing failed, trying to build surface manually\n" 
		set pps ""
		foreach c $curves {set pps [concat $pps [ic_geo_boundary curve $c]]}
#mess "curves are $curves ; pps is $pps\n"
		set point [lindex [scrib_lib_utils_list_remove_duplicated $pps] 0]
		if {$point != ""} {
		    set loc2 [ic_geo_project_point surface [ic_geo_get_objects surface $part] $point]
#mess "loc2 is $loc2\n"
		    set point2 [ic_geo_cre_pnt $current_part $current_part $loc2]
#mess "point2 is $point2\n"
		    set curve1 [ic_geo_cre_bsp_crv_n_pnts $current_part $current_part [list $point $point2] 0.001]
#mess "curve1 is $curve1\n"
#mess "about to run ic_geo_cre_srf_crv_drv_srf $current_part $current_part $curves $curve1 1\n"

		    if [catch [ic_geo_cre_srf_crv_drv_srf $current_part $current_part $curves $curve1 1] res] {
#			mess "at first of catch $res\n"
		    } else {
#			mess "at second of catch $res\n"
		    }
#mess "done\n"
		}
	    }
# ----end work-a-round
}
	}
	ic_geo_delete_unattached
	eval ic_build_topo $topo $new_mid_parts

	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Assign Mesh Size?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}


# 8. Move construction geometry to CONSTRUCTION ASSEMBLY
	foreach p [ic_geo_list_parts] {
	    if {[lsearch $new_mid_parts $p] != -1} continue
	    if {[lsearch $solid_parts $p] != -1} continue
	    ic_geo_rename_family $p CONSTRUCTION/$p
	}

# 12. Set Mesh size
	set curves [ic_geo_get_objects curve ""]
	foreach c $curves {
	    if {[ic_geo_check_objects_exist curve $c] == ""} continue
	    ic_set_meshing_params curve $c emax $mesh_size
	}

	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Mesh?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 13. Mesh
	scrib_lib_assembly_midsurface_mesh $new_mid_parts
	ic_uns_merge_nodes all $topo {0 0 0} {0 0 0} 0 1 1
	scrib_lib_quality_duplicate_elements_delete

	if {$debug > 0} {
	    tdv_active 1
	    aie_create_initial_assemblies
	    if {[ tk_dialog .proceed "Assign Thickness and Material?" \
		      "Do you want to proceed?" "" -1 Yes No ]}  {
		    return
	    }
	    tdv_active 0
	} else {incr debug}
# 14. Define Material 

	set fp [open $par w]
	puts $fp "begin Isotropic_Material MAT1"
	puts $fp "    Mass_Density 0.000006"
	puts $fp "    Material_ID 1"
	puts $fp "end Isotropic_Material MAT1"
	close $fp
	aie_load_params_file $par 1

# 15. Define Shell Thickness on surfaces
	foreach p $new_mid_parts {
	    set thickness [scrib_lib_assembly_average_thickness $p]
	    ic_boco_replace_in_part [list [list 1 ISHE 0 1 1 1 0.000000 1 $thickness 1.000000 0.833330] ] \
		$p [list ISHE ISHR PCOMP LSDYNA_MATERIAL_SHELL ]
#ic_boco_replace_in_part {{1 ISHE 0 -999999 -999999 -999999 0.000000 -999999 4.5 1.000000 0.833330}} MID_COMP-H205487_-381 { ISHE ISHR PCOMP LSDYNA_MATERIAL_SHELL }
	}

# 16. Update display
	ic_boco_clear_icons 
	ic_boco_bctypes_used_by_families 
	aie_create_initial_assemblies
	aie_after_open_mesh 1 1

# 17. Write out analysis

# 18. Solve

# 19. Post Process

# 20.  Save the stuff
    if ![file isdir completed] {exec mkdir completed}
    ic_save_tetin ./completed/$tetin
    ic_save_unstruct ./completed/$domain
    ic_boco_save ./completed/$fbc
    ic_boco_save_atr ./completed/$atr
    ic_param_save ./completed/$par

# 21. Messages 
	if {$solid_parts != ""} {mess "\n \n ----- \n There are [llength $solid_parts] solid or open parts; $solid_parts\n" blue}
#	if {$questional_parts != ""} {mess "There may have been problems midsurfacing parts $questional_parts\n" blue}
	if {$weld_problem_feature != ""} {mess "There may have been problems welding [llength $weld_problem_feature] features $weld_problem_feature\n" blue}
#	if {$problem_weld_feature_w_cut_curves != ""} {
#	    mess "features $problem_weld_feature_w_cut_curves had problems finding proper cutting curves\n" blue
#	}
ic_undo_start
tdv_active 1
# 22. Auggie wants a way to exit at the end of the meshing process
if $exit_at_end {exit}
}


#====================================================
##     This proc meshes the assembly of midsurfaced parts

proc scrib_lib_assembly_midsurface_mesh {parts {ignore_size 0.1}} {
    set surfs_to_mesh ""
    foreach part $parts {
	set surfs_to_mesh [concat $surfs_to_mesh [ic_geo_get_objects surface $part] ]
    }
#    set failed [ic_quad_from_geometry surfaces $surfs_to_mesh 2 1 20 0.025 \
#	[expr $ignore_size * 0.25] $ignore_size 0 2 0.2 1 0 0 0 \
#	0.5 0.0001 3 1 -1 Failed_surfaces 150]

    set failed [	ic_quad2 what surfaces entities $surfs_to_mesh element 2 proj 1 iters -20 conver 0.025 \
	geo_tol 0 ele_tol $ignore_size dev 0 improvement 1 block 0.2 \
	bunch 0 debug 0 adjust_nodes 0 adjust_nodes_max 0 try_harder 3 error_subset Failed_surfaces \
	pattern 150 big 1 board 0 remove_old -1 inner 0 simple_offset 0 enn 0 b_smooth 1 time_max 0 ele_max 0]


    ic_meshdirect_object_exec seamweld
}

#====================================================
##     This proc returns a list of parts starting with string $string

proc scrib_lib_assembly_midsurface_configure_parts {string} {
    if ![ic_geo_is_loaded] return
    set ret_parts ""
    set length [string length $string]
    foreach part [ic_geo_list_parts] {
	if ![llength [ic_geo_get_objects surface $part]] continue
	if {[string range $part 0 [expr $length - 1] ] == $string} {lappend ret_parts $part}
    }
    return $ret_parts
}
#====================================================
##     This proc creates midsurfaces on $parts, and returns problem parts.

proc scrib_lib_assembly_midsurface_create_midsurface {max_dist parts} {
    set problem_parts ""
    foreach part $parts {
	set mp_name MID_$part
	set srfs [ic_geo_get_objects surface $part]
	ic_geo_midsurface max_dist $max_dist family $mp_name save_old 0 ask 0 \
		partial 0 similar 0 precision 0 surfaces $srfs 
	set left_over_surfaces [ic_geo_get_objects surface $part]
	if [llength $left_over_surfaces] {lappend problem_parts $part}
    }
    ic_geo_delete_unattached
    return $problem_parts
}

proc scrib_lib_assembly_midsurface_keep_only_largest_conn_region {part} {
    set largest_reg ""
    set largest_val 0.0
    set largest_loc 0
    set regions [scrib_lib_geo_make_conn_regions surface [ic_geo_get_objects surface $part]]
    set loc 0
    foreach reg $regions {
	set area 0.0
	foreach s $reg {set area [expr $area + [ic_geo_srf_area $s]]}
	if {$area > $largest_val} {
	    set largest_reg $reg
	    set largest_loc $loc
	    set largest_val $area
	}
	incr loc
    }
    set reg_to_remove [lreplace $regions $largest_loc $largest_loc]
    foreach reg $reg_to_remove {
	set curves [scrib_lib_geo_get_connected_entities curve $reg]
	set points [scrib_lib_geo_get_connected_entities point $curves]	
	ic_delete_geometry surface names $reg
	ic_delete_geometry curve names $curves
	ic_delete_geometry point names $points
    }
}

#====================================================
##     This proc creates curtain surfaces to act as welds between parts.

proc scrib_lib_assembly_midsurface_create_welds {weld_parts parts {max_projection ""} {tol 0.1}} {
    foreach part $weld_parts {
	set m_curves($part) [scrib_lib_geo_get_multiple_curves $part]
    }
    set nn 0
    foreach part $weld_parts {
	incr nn
	if ![llength $m_curves($part)] {
	    mess "no multiple curve found\n" red
	    continue
	}
	set key_string [string range $part 5 end]
	set base_part ""
	foreach p $parts {
	    if {[string first $key_string $p] != -1} {lappend base_part $p}
	}
	if {[llength $base_part] < 1} {
	    mess "not finding valid part to weld $part to\n"
	    continue
	}
	set cc [lindex $m_curves($part) 0]
	if ![llength [ic_geo_check_objects_exist curve $cc]] continue
	set current_part [ic_geo_get_family curve $cc]
	#We can now weld m_curves($part) to base_part
	set n 0
	foreach bp $base_part {
	    set fam SEAM_WELD_$key_string
	    ic_geo_create_surface_curtain $m_curves($part) \
		[ic_geo_get_objects surface $bp] $fam $fam 0 1
	}
	ic_delete_geometry surface names [ic_geo_get_objects surface $part]
    }
    ic_geo_delete_unattached
    set bt_parts [concat $weld_parts $parts]
    eval ic_build_topo $tol $bt_parts
}


#====================================================
## This proc creates weld definitions from multiple curves in weld_parts 
##	to the part defined by * in WELD_*

proc scrib_lib_assembly_midsurface_create_welds_old {weld_parts parts {max_projection ""}} {
    foreach part $weld_parts {
	set m_curves($part) [scrib_lib_geo_get_multiple_curves $part]
    }
    set nn 0
    foreach part $weld_parts {
	incr nn
	if ![llength $m_curves($part)] {
	    mess "no multiple curve found\n" red
	    continue
	}
	set key_string [string range $part 5 end]
	set base_part ""
	foreach p $parts {
	    if {[string first $key_string $p] != -1} {lappend base_part $p}
	}
	if {[llength $base_part] < 1} {
	    mess "not finding valid part to weld $part to\n"
	    continue
	}
	set cc [lindex $m_curves($part) 0]
	if ![llength [ic_geo_check_objects_exist curve $cc]] continue
	set current_part [ic_geo_get_family curve $cc]
	#We can now weld m_curves($part) to base_part
	set n 0
	foreach bp $base_part {
	    incr n
	    set seam_crv_fam $current_part\:SEAM_WELD$nn
mess "seam_weld_fam is $seam_crv_fam, base_part is $base_part\n"
	    ic_geo_set_family curve $seam_crv_fam names $m_curves($part)
#	    set clist ""
#	    foreach c [ic_geo_get_objects curve $seam_crv_fam] {lappend clist curve ; lappend clist $c }
#	    ic_boco_set_for_objects $clist {{1 CONNECTOR SEAM_CURVES$n}} {} SEAM_CURVES$n
#	    ic_meshdirect_directive_set_val_by_tag seamweld $seam_crv_fam active 1 
#	    ic_meshdirect_directive_set_val_by_tag seamweld $seam_crv_fam splitting remesh_tri_quad
	    if {$max_projection != ""} {
mess "max_projection is $max_projection\n"
	    	ic_meshdirect_seamweld_set $seam_crv_fam $bp SEAM_WELD_$key_string \
		[list md_seamweld_method curtain_quad md_seamweld_active 1 \
		md_seamweld_splitting remesh_tri_quad md_seamweld_maxprojection $max_projection ]
	    } else {
	        ic_meshdirect_seamweld_set $seam_crv_fam $bp SEAM_WELD_$key_string \
		{md_seamweld_method curtain_quad md_seamweld_active 1 md_seamweld_element_splitting remesh_tri_quad}
#		{md_seamweld_method standard }
	     }
	    set key_string $key_string\_1	    
	}
	ic_delete_geometry surface names [ic_geo_get_objects surface $part]
    }
    ic_geo_delete_unattached
}


## This is a copy of ai_env/scripts/aie_materials.tcl aie_average_thickness 
proc scrib_lib_assembly_average_thickness {part} {
    set area 0.0
    set thickness 0.0
    foreach obj [ic_geo_get_objects surface $part] {
	set th ""
	foreach {n v} [ic_get_meshing_params surface $obj] {
	    if {$n == "ehgt"} { set th $v }
	}
	if {$th != ""} {
	    set ar [ic_geo_srf_area $obj]
	    set area [expr $area + $ar]
	    set thickness [expr $thickness + $ar * $th]
	}
    }
    if {$area > 0} {
	return [expr $thickness / $area]
    } else {
	return 0
    }
}

proc scrib_lib_assembly_read_proe_features_file {fname {tol 0.1}} { 
	set results ""
	set f [open $fname "r"]
	set id ""
	set missing_surfs ""
	set all_srfs ""

	while {  [gets $f txt ] >= 0 } {
#mess "Line: $txt\n"
		if {[string index $txt 0] == "#"} continue
		if {[llength $txt] < 2} continue
#Initialize Feature ID and WELD type
		set n [lsearch $txt "feature_id"]
		if {$n > -1} {
		    incr n
#mess "txt is $txt ; n is $n\n"
		    set id [lindex $txt $n]
		    set type [lindex $txt 0]
		    if {($type == "WELD_GROOVE") || ($type == "WELD_FILLET")} {
			set n_surfaces [lindex $txt end]
			set parts ""
			set junk $txt
			set pi [lsearch $junk part]
			while {$pi > 0} {
			    set junk [lreplace $junk 0 $pi]
			    lappend parts [lindex $junk 0]
			    set pi [lsearch $junk part]
			}
			
		    } else {
			set id "" 
#			mess "id is set to nothing. Continuing\n" red
			continue
		    }
		}
		if {$id == ""} { continue }
#Set all surfaces to this feature ID and Weld Type
		set first [lindex $txt 0]
		if {$first == "surface"} {
			set srf [lindex $txt 1]
#			set srf P_AH205233_2[string range $srf [string first / $srf] end]
			if {[ic_geo_check_objects_exist surface $srf] == ""} {
				mess "ERROR: Surface not found $srf\n" red
				lappend missing_surfs $srf
				continue
			}
			set f_type($srf) $type
			set f_parts($srf) [lsort -unique $parts]
			lappend all_srfs $srf
		}
	}
	close $f

	ic_geo_set_family surface PRO_FEATURE names $all_srfs 0
	set curves [scrib_lib_geo_get_connected_entities curve $all_srfs]
	ic_geo_set_family curve PRO_FEATURE names $curves 0
	set points [scrib_lib_geo_get_connected_entities point $curves]
	ic_geo_set_family point PRO_FEATURE names $points 0

	ic_build_topo $tol -no_reg_surf -no_concat PRO_FEATURE
	set nn 1
	#This is necessary, as build topo could rename some surfaces if they get cut.
	set all_srfs [ic_geo_get_objects surface PRO_FEATURE]

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

	foreach region $surfs {
#if {[lsearch $region COMP-AA66214/12130] != -1} {
#mess "lindex $region 0 is [lindex $region 0]\n"
#mess "parts are $f_parts([lindex $region 0])\n"
#}
	    set name FEATURE/FEATURE$nn
	    ic_geo_set_family surface $name names $region 0
	    set curves [scrib_lib_geo_get_connected_entities curve $region]
	    ic_geo_set_family curve $name names $curves 0
	    set points [scrib_lib_geo_get_connected_entities point $curves]
	    ic_geo_set_family point $name names $points 0

	    set type $f_type([lindex $region 0])
	    set parts $f_parts([lindex $region 0])
	    lappend results [list $name $type $parts] 
	    incr nn
	}
	return $results
}

## This procedure will find the valid parts in the weld area, and the side surfaces that define the valid welds.

proc scrib_lib_assembly_midsurface_configure_sides {surface_features mid_part_string {max_dist 10}} {
    set feature_type_side_parts_list ""
    foreach feature $surface_features {
#mess "feature is $feature\n"
	set parts [lindex $feature 2]
	set check_pt [lindex [ic_geo_boundary curve [lindex [ic_geo_boundary surface [lindex [ic_geo_get_objects surface [lindex $feature 0]] 0]] 0] ] 0]
	set valid_parts ""
	foreach p [ic_geo_list_parts] {
	    if {[ic_geo_get_objects surface $p] == ""} continue
	    foreach pp $parts {
		if {[string first $pp $p] == -1} continue
		set loc [ic_geo_get_point_location $check_pt] 
		set dist [scrib_lib_geo_distance_from_surfaces $p $loc]
		if {$dist > $max_dist} continue
		lappend valid_parts $p
	    }
	}
	set parts $valid_parts

	if {[llength $parts] < 2} {
	    set valid_parts [scrib_lib_assembly_midsurface_configure_parts $mid_part_string ]
	} 
	set feature_name [lindex $feature 0]
#This checks for valid side curves in the feature part, 
#This is a list of single edged diagonal curves of two weld ends
#For a closed feature region (a weld that makes a circular bead, etc) the double curves are returned
	set sides [scrib_lib_geo_get_sides_row_surfaces $feature_name $valid_parts]
mess "---> sides are $sides\n"
	set i 1
	set pl(1) 0
	set pl(2) 0
	foreach s $sides {
	    ic_geo_subset_add_items $feature_name [list curve $s]
	    if {[llength $valid_parts] == 2} continue
	    set good_parts $valid_parts
	    set valid_parts ""
	    set part_length ""
	    set pt [ic_geo_cre_pnt_on_crv_at_par POINTS PPP 0.5 $s]
	    if {[ic_geo_check_objects_exist point $pt] == ""} {continue}
	    set loc [ic_geo_get_point_location $pt] 
	    foreach part $good_parts {
		set length [scrib_lib_geo_distance_from_surfaces $part $loc]
		lappend part_length [list $part $length] 
	    }
	    ic_delete_geometry point names $pt  
	    set part_length [lsort -index 1 -real -increasing $part_length]
	    set valid_parts [list [lindex [lindex $part_length 0] 0] [lindex [lindex $part_length 1] 0]]
	    set pl($i) [lsort $valid_parts]
	    incr i
	}
	if {($pl(1) != 0) && ($pl(2) != 0)} {
mess "OK\n" red
	    if {$pl(1) != $pl(2)} {
		mess "The first two sides are not getting the same closest parts!!!\n  This may cause a problem\n" red
	    }
	}
	lappend feature_type_side_parts_list [list [lindex $feature 0] [lindex $feature 1] $valid_parts $sides]
    }
    if [llength [info commands aie_getBatchGeomDisplay]] {aie_getBatchGeomDisplay}
return $feature_type_side_parts_list
}


proc scrib_lib_assembly_find_valid_side_midsurfaces {side_surfaces weld_part max_dist} {
    set valid_sides ""
    foreach s $side_surfaces {
	set loc [ic_geo_get_srf_pos 0.5 0.5 $s]
	set distance [scrib_lib_geo_distance_from_surfaces $weld_part [lindex $loc 0]]
	if {$distance < $max_dist} {lappend valid_sides $s}
    }
    return $valid_sides

}

proc scrib_lib_assembly_side_surfs_find {part cut_points {feature ""} {max_dist 0.0}} {
#    set t1 [clock seconds]
    set multiple_curves [scrib_lib_geo_get_multiple_curves $part]
#    set t2 [clock seconds]
#    mess "time to find multiple curves is [expr $t2 - $t1]\n"
    set side_crvs $multiple_curves
    set curves_to_weld [scrib_lib_assembly_find_shortest_path_between_curves $side_crvs $cut_points $feature $max_dist]
#    set t3 [clock seconds]
#    mess "time to find curves to weld is [expr $t3 - $t2]\n"
    mess "curves_to_weld are $curves_to_weld\n"
    return $curves_to_weld 
}


proc scrib_lib_assembly_side_surface_cut_curves {part1 part2 weld_side length {tol 0.001} {feature ""}} {
mess "\n\n---------\n"
mess "length is $length\n"
mess "trying to find cutting points for $feature between parts $part1 $part2\n"
    foreach pp [list $part1 $part2] {
	if {[lsearch [ic_geo_list_parts] $pp] == -1} {
	    mess "Part $pp does not exist in scrib_lib_assembly_side_surface_cut_curves, returning\n" red
	    return ""
	}
	set ppp [string range $pp 4 end]
	set multiple_curves [scrib_lib_geo_get_multiple_curves $pp]
	set side_crvs($pp) $multiple_curves
	foreach m $multiple_curves {
	    foreach s [ic_geo_incident curve $m] {
		if {[ic_geo_get_part surface $s] == $ppp} {lappend side_surfs($pp) $s}
	    }
	}
	set valid($pp) 1
	set valid_cut_points($pp) ""
    }
    set invalid_parts_due_to_long_projection ""
    #we set both sides as valid, then remove if projection is too far for any location.
    set side_parts [list $part1 $part2]
    set points ""
    set max_dist_s1 0
    set max_dist_s2 0
    set max_dist_c1 0
    set max_dist_c2 0
    set surf_part1 ""
    set surf_part2 ""
    set curve_part1 ""
    set curve_part2 ""

    set valid_parts ""
    set cylinder_region 0
    foreach c $weld_side {
    if $cylinder_region break
mess "c is $c\n"
      set side_length 0.0 
      foreach ll $c {set side_length [expr $side_length + [ic_geo_crv_length $ll]]}
mess "side length is $side_length\n"
      foreach pp [list $part1 $part2] {
	#Foreach point on the one weld side, find the vectors running along weld
	set pot_cut_points($pp) ""
	set cut_points($pp) ""
	if {$pp == $part1} {set ppp $part2} else {set ppp $part1}
	foreach p [ic_geo_boundary curve $c 0 1] {
	    if !$valid($pp) continue
	    set loc($p) [ic_geo_get_point_location $p]
	    set att_crv($p) ""
	    foreach cc [ic_geo_incident point $p] {
		if {$cc == $c} continue
		if {[ic_geo_get_part curve $cc] != $feature} continue
	    	lappend att_crv($p) $cc
	    }
	    if {[llength $att_crv($p)] != 1} {
		if !$cylinder_region {
		    mess "more than one curve found attached to side corner $c at $p\n" red
		    mess "assuming this is a cylindrical connection\n"
		}
		set att_crv($p) [lindex $att_crv($p) 0]
		set cylinder_region 1
		break
	    }
	    set param [ic_geo_find_nearest_crv_pnt $att_crv($p) $p]
	    set att_loc($p) [lindex [ic_geo_get_crv_pos [expr abs($param  - 0.1 )] $att_crv($p)] 0]
	    set att_vec($p) [ic_vcalc dir $loc($p) $att_loc($p)]
	    set vectors($c) $att_vec($p)
	    set ccc [scrib_lib_geo_nearest_curve_list $loc($p) $side_crvs($pp)]
	    set dist_c1 [scrib_lib_geo_distance_from_curves "" $loc($p) $ccc]
	    #First check validity of this distance, if too far break 
	    if {$dist_c1 > $length} {
		mess "The corner point is too far away from part $pp so this part is not valid\n"
		set valid($pp) 0
		#This is added to ensure weld part is not too far from feature
		set sss [scrib_lib_geo_nearest_surface_list $loc($p) [ic_geo_get_objects surface $pp]]
		set poloc [ic_geo_project_point surface $sss $loc($p)]
		set surf_dist [ic_vcalc distance $loc($p) $poloc]
		if {$surf_dist > [expr $length * 3] } {
		    lappend invalid_parts_due_to_long_projection $pp
		}	
		#---
		break
	    } else {
		if {$dist_c1 > $max_dist_c1} {set max_dist_c1 $dist_c1}
	    }
	    set ploc($p) [ic_geo_project_point curve $ccc $p]
	    set FOUND1 0
	    foreach pppp [ic_geo_boundary curve $ccc] {
		set dddist [ic_vcalc distance $ploc($p) $pppp]
		if {$dddist < [expr $side_length / 1.4]} {
			lappend cut_points($pp) $pppp	
			set FOUND1 1
			break
		}
	    }
	    #It's possible at this time to have two real points that are within the distance specified
	    #The point that is valid should be the one closest to second part
	    if {[llength $cut_points($pp)] > 1} {
		set cut_points($pp) [scrib_lib_assembly_get_shorter_proj $cut_points($pp) $ppp]
	    }
	    if !$FOUND1 {
		    lappend pot_cut_points($pp) $ploc($p)
#		    lappend pcp $ploc($p)
		    set curve_to_split $ccc
#		    set b_att_loc [ic_geo_get_crv_pos \
#			[expr abs( [ic_geo_find_nearest_crv_pnt $ccc $ploc] - 0.1 )] $ccc]		 
#		    set b_att_vec [ic_vcalc dir $ploc $b_att_loc]
#		    mess "b_att_vec is $b_att_vec ; att_vec is $att_vec\n"
		    
	    }

	}
	if { [llength $cut_points($pp)] } {
		    set valid($pp) 1
		    set valid_cut_points($pp) [concat $valid_cut_points($pp) $cut_points($pp)]
		    set valid_cut_points($pp) [lsort -unique $valid_cut_points($pp)]
mess "$pp is finding a valid point\n"
mess "cut_points is $valid_cut_points($pp)\n"
	} elseif {[llength $pot_cut_points($pp)] == 2  } {
		set dist [ic_vcalc distance [lindex $pot_cut_points($pp) 0]  [lindex $pot_cut_points($pp) 1]]
		if {$dist < $tol} {
mess "The distance between projection of endpoints for $c to part $pp are within tolerance $tol\n"
		    set locc1 [lindex $pot_cut_points($pp) 0]
	    	    set param [ic_geo_find_nearest_crv_pnt $curve_to_split $locc1]
	    	    set locc2 [lindex [ic_geo_get_crv_pos [expr abs($param  - 0.1 )] $curve_to_split] 0]
		    set vect [ic_vcalc dir $locc1 $locc2]
		    set angle [ic_vcalc angle $vect $vectors($c)]
#		    set vect [ic_vcalc dir [lindex $pot_cut_points($pp) 0]  [lindex $pot_cut_points($pp) 1]]
#		    set angle [ic_vcalc angle $vect $vectors($c)] 
#mess "ic_vcalc angle $vect $vectors($c) returned $angle\n"
		    if {$angle == ""} {set angle 90}
		    set angle [expr abs($angle)]
		    if {($angle < 10) || ($angle > 170)} {set OK 1} else {set OK 0}
		    #First check was to verify that the two points coming from the side curve were close
		    #Second check was to verify that the vector of the curve running along weld is similar
			#to that going along the side curve
		    if $OK {
mess "The angle between weld definition and cutting curve for part $pp is $angle which seems valid\n"
			set part [ic_geo_get_part curve $curve_to_split]
			set ppoint [ic_geo_cre_pnt $part $part [lindex $pot_cut_points($pp) 0]]
			mess "$pp is finding a common point\n"
			ic_geo_split_curve $curve_to_split $ppoint
			set multiple_curves [scrib_lib_geo_get_multiple_curves $part]
			set side_crvs($part) $multiple_curves

			set valid_cut_points($pp) [concat $valid_cut_points($pp) $ppoint]
			set valid_cut_points($pp) [lsort -unique $valid_cut_points($pp)]
mess "valid_cut_points($pp) is $valid_cut_points($pp)\n"
			set valid($pp) 1
		    }
		} else {set valid($pp) 0}
	} else {
		set valid($pp) 0
if !$cylinder_region {mess "$pp is not valid\n"}

	}
       }
    }
    #check part for validity of two cut-points if they are too close the part isn't valid 
    set valid_parts ""
    foreach pp [list $part1 $part2] {
#	if !$valid($pp) continue  
	if {[llength $valid_cut_points($pp)] == 2} {
	    set p1 [lindex $valid_cut_points($pp) 0]
	    set p2 [lindex $valid_cut_points($pp) 1]
	    set dist [ic_vcalc distance $p1 $p2]
	    if {$dist < $tol} {
		mess "cutting points are at same location.\n"
		set valid($pp) 0
	    } else {
		lappend valid_parts $pp
	    }
	} elseif $cylinder_region {
#	    set valid_cut_points($pp) ""
#	    foreach c $cyl_curves($pp) {
#		set valid_cut_points($pp) [concat $valid_cut_points($pp) [ic_geo_boundary curve $c]]
#	    }
#	    set valid_cut_points($pp) [lsort -unique $valid_cut_points($pp)]
	} else {
	    mess "Not getting two valid_cut_points for $pp valid points are $valid_cut_points($pp)\n"
	    set valid($pp) 0
	}
    }

    #Handle cylinder regions seperately:
    if $cylinder_region {
	set valid_parts ""
	foreach pp [list $part1 $part2] {
#mess "checking part $pp\n"
	    set valid($pp) 0
	    set cyl_curves($pp) ""
	    set valid_cut_points($pp) ""
	    #If this is a cylindrical region we should return a curve list rather than pointlist
	    foreach crv_reg [scrib_lib_geo_make_conn_regions curve $side_crvs($pp)] {
#mess "crv_reg is $crv_reg\n"
		set GOOD_REG 1
		foreach c $crv_reg { 
		    if !$GOOD_REG break
		    foreach p [ic_geo_boundary curve $c 0 1] {
			set loc($p) [ic_geo_get_point_location $p]
			set ccc [scrib_lib_geo_nearest_curve_list $loc($p) $weld_side]
			set dist [scrib_lib_geo_distance_from_curves "" $loc($p) $ccc]
			if {$dist > $length} {
#mess "side $c at point $p is finding a distance of $dist\n"
			    set GOOD_REG 0
			    break
			}
		    }
		}
		if $GOOD_REG {
mess "found closed cylindrical region within projection limit.  Region is $crv_reg\n"
		    set valid($pp) 1
		    set cyl_curves($pp) $crv_reg
		    set valid_cut_points($pp) [scrib_lib_geo_get_connected_entities point $cyl_curves($pp)]
		    lappend valid_parts $pp
		    break
		}
	    }
	}
	mess "valid parts are $valid_parts\n"
    }

    if {$valid($part1) && $valid($part2) } {
	mess "Still have two valid parts, need to reduce to 1\n" red
	set valid_parts ""
	#Project cut-points of 1 part to the other and vice-versa.  
	#Part to use is one that vector is closest to surface normal
	foreach pp [list $part1 $part2] {
	    set p_ang($pp) 0.0
	    set p_dist($pp) 0.0
	    set valid($pp) 0
	    if {$pp == $part1} {set ppp $part2} else {set ppp $part1}
	    foreach p $valid_cut_points($pp) {
		foreach c [ic_geo_incident point $p] {
		    if {[ic_geo_get_family curve $c] == $pp} {
			set crv $c
			break
		    }
		}
		foreach s [ic_geo_incident curve $crv] {
		    if {[ic_geo_get_family surface $s] == $pp} {
			set srf $s
			break
		    }
		}
		set ang [scrib_lib_assembly_get_surf_norm_proj_diff $p $srf \
			[ic_geo_get_objects surface $ppp]]
		set ang [expr abs($ang)]
#mess "angle of projection is $ang\n"
		if {$ang > 90.0} {set ang [expr 180.0 - $ang]}
#mess "angle of projection is $ang\n"
		if {$ang > $p_ang($pp)} {set p_ang($pp) $ang}
#mess "max angle of projection for point $p to curve $ccc in part $pp is $p_ang($pp)\n"
		set dist [scrib_lib_assembly_get_proj_distance $p [ic_geo_get_objects surface $ppp]]
		if {$dist > $p_dist($pp)} {set p_dist($pp) $dist}
	    }
mess "-->max angle of projection for $pp is $p_ang($pp)\n"
mess "-->max distance of projection for $pp is $p_dist($pp)\n"
	    if {$p_ang($pp) > 80.0} {
		set valid($pp) 1
		lappend valid_parts $pp
	    } 
	}
	#The approach here is to evaluate the two parts and see if you have a T-connection.
	#If you have a T-connection, the T-should be formed (surface normal and projection are ~90
	#If instead you have two parallel plates (surface normal and projection are ~0 or ~180)
	#We want the smallest angle as this case often has overlaps where a >0 value means overlap
	switch [llength $valid_parts] {
	    0 {
		mess "No parts found to be orthogonal, taking smallest angle\n"
		if {$p_ang($part1) < $p_ang($part2) } {
		    set valid_parts $part1
		    set valid($part1) 1
		} else {
		    set valid_parts $part2
		    set valid($part2) 1
		}
	    }
	    1 {
		mess "Good case.  Only 1 part found to be orthogonal.  Taking part $valid_parts\n"
	    }
	    2 {
		mess "Still have two valid parts, taking smaller projection\n" red
		if {$p_dist($part1) < $p_dist($part2)} {
		    set valid_parts $part1
		    set valid($part2) 0
		} else {
		    set valid_parts $part2
		    set valid($part1) 0
		}
	    }
	}
    }

    switch [llength $valid_parts] {
	0 {
	    mess "No side_parts found, skipping feature\n"
	    return ""
	}
	1 {
	    mess "1 valid side part found; $valid_parts\n"
	    set weld_part ""
	    foreach pp [list $part1 $part2] {
		if $valid($pp) {
		    set side_part $pp
		} else {
		    if {[lsearch $invalid_parts_due_to_long_projection $pp] == -1} {
			set weld_part $pp
		    }
		}
	    }
	    if {$weld_part == ""} {
		mess "No valid weld part found\n" red
		return ""
	    }
	    if $cylinder_region {
		if {$cyl_curves($side_part) == ""} {return ""} else {
		    return [list cylinder $weld_part $side_part $cyl_curves($side_part)]
		}
	    } else {
		return [list $valid_cut_points($side_part) $weld_part $side_part]
	    }
	}
	2 {
	    mess "Unhandled case...  Still have two valid parts, just taking first\n" red

	    set side_part $part1
	    set weld_part $part2
	    if $cylinder_region {
		if {$cyl_curves($side_part) == ""} {return ""} else {
		    return [list cylinder $weld_part $side_part $cyl_curves($side_part)]
		}
	    } else {
		return [list $valid_cut_points($side_part) $weld_part $side_part]
	    }
	}
    }
}

proc scrib_lib_assembly_get_surf_norm_proj_diff {point surface proj_surfaces} {
	set srf_pos [ic_geo_find_nearest_srf_pnt $surface $point]
	set srf_norm [lindex [ic_geo_get_srf_nrm [lindex $srf_pos 0] [lindex $srf_pos 1] $surface] 0]
	set oloc [ic_geo_get_point_location $point]
	set sss [scrib_lib_geo_nearest_surface_list $oloc $proj_surfaces]
	set poloc [ic_geo_project_point surface $sss $point]
	set pos_norm [ic_vcalc dir $oloc $poloc]
#mess "running scrib_lib_assembly_get_surf_norm_proj_diff [list $point] [list $surface] [list $proj_surfaces]\n"
#mess "srf_norm is $srf_norm; pos_norm is $pos_norm\n"
	set ang [ic_vcalc angle $srf_norm $pos_norm]
#mess "return from ic_vcalc angle $srf_norm $pos_norm is angle $ang\n"
	return $ang
}

proc scrib_lib_assembly_get_proj_distance {point proj_surfaces} {
#Maybe should be combining this with  
	set oloc [ic_geo_get_point_location $point]
	set sss [scrib_lib_geo_nearest_surface_list $oloc $proj_surfaces]
	set poloc [ic_geo_project_point surface $sss $point]
	set dist [ic_vcalc distance $oloc $poloc]
	return $dist
}

proc scrib_lib_assembly_side_surface_cut_curves_trim {side_curves weld_side side_parts {tol 0.001}} {
    set cut_points ""
    foreach side $weld_side {
	set points [ic_geo_boundary curve $side 0 1]
	set loc1 [ic_geo_get_point_location [lindex $points 0] ]
	set loc2 [ic_geo_get_point_location [lindex $points 1] ]
	set ccurve1 [scrib_lib_geo_nearest_curve_list $loc1 $side_curves]
	set ccurve2 [scrib_lib_geo_nearest_curve_list $loc2 $side_curves]
	set ploc1 [ic_geo_project_point curve $ccurve1 [lindex $points 0]]
	set ploc2 [ic_geo_project_point curve $ccurve2 [lindex $points 1]]

	if {[ic_vcalc distance $ploc1 $ploc2] < $tol} {
	    set cut_point $ploc1
	    set cut_curve $ccurve1
	} else {
	    set cut_point $ploc1
	    set cut_curve $ccurve1
#should put in more robust method, like below
#	    set dif [ic_vcalc diff $ploc1 $ploc2]
#	    set addvec [ic_vcalc smult $dif 0.5]
#	    set loc3 [ic_vcalc sum $ploc1 $addvec]
#	    set cut_point [ic_geo_project_point curve $side_curves $loc3]
	}
	set TRIMIT 1
	foreach p [ic_geo_boundary curve $cut_curve] {
	    if {[ic_vcalc distance $cut_point $p] < $tol} {
		set cut_point $p
		set TRIMIT 0
		break
	    }
	}
	if $TRIMIT {
	    set part [ic_geo_get_part curve $cut_curve]
	    set cut_point [ic_geo_cre_pnt $part $part $cut_point]
	    ic_geo_split_curve $cut_curve $cut_point
	}
	lappend cut_points $cut_point
    }
    set cut_curves [scrib_lib_assembly_find_shortest_path_between_curves $side_curves $cut_points]

    return $cut_curves
}

#finds the shortest path between two points along connected curves.
# if side_feature is given it ensures that the curves are within a distance of this side feature
proc scrib_lib_assembly_find_shortest_path_between_curves {curves points {feature ""} {max_proj 0}} {
    if {[llength $points] != 2} {
	mess "must specify two points to \
		scrib_lib_assembly_find_shortest_path_between_curves $curves $points, returning \n" red
	return ""
    }
    set curves [lsort -unique $curves]
    set point1 [lindex $points 0]
    set point2 [lindex $points 1]
    set init_curves ""
    foreach c [ic_geo_incident point $point1] {
	if {[lsearch $curves $c] != -1} {lappend init_curves $c}
    }
    if {[llength $init_curves] > 2} {
	mess "getting unexpected results from scrib_lib_assembly_find_shortest_path_between_curves \
		$curves $points, returning \n" red
	return ""
    }
    set current_curve(side1) [lindex $init_curves 0]
    set c_list(side1) $current_curve(side1)
    set c_length(side1) [ic_geo_crv_length $current_curve(side1)]
    set stop(side1) 0
#This might not be anything. 
    set current_curve(side2) [lindex $init_curves 1]
    set c_list(side2) $current_curve(side2)
    if {$current_curve(side2) == ""} {
	set stop(side2) 1
	set c_length(side2) 1e39
    } else {
	set stop(side2) 0
	set c_length(side2) [ic_geo_crv_length $current_curve(side2)]
    }
    set used_points $point1
    set used_curves $init_curves

    set inc 1
    while 1 {
	incr inc
	foreach s [list side1 side2] {
	    if $stop($s) continue
	    #First check curve to see if center point is too far away from feature
	    if {$feature != ""} {
		set pts [ic_geo_boundary curve $current_curve($s)]
		set param1 [ic_geo_find_nearest_crv_pnt $current_curve($s) [lindex $pts 0]]
		set param2 [ic_geo_find_nearest_crv_pnt $current_curve($s) [lindex $pts 1]]
		set midpar [expr (($param1 - $param2) / 2) + $param2]
		set check_loc [lindex [ic_geo_get_crv_pos $midpar $current_curve($s)] 0]
		set dist [scrib_lib_geo_distance_from_surfaces $feature $check_loc]
#mess "distance from feature $feature for curve $current_curve($s) is found to be $dist\n"
		if {$dist > $max_proj} {
		    set stop($s) 1
		    set c_length($s) 1e39
		    continue
		}
	    }
	    set NOTHIN_FOUND 1
	    foreach p [ic_geo_boundary curve $current_curve($s)] {
		if {[lsearch $used_points $p] != -1} continue
	         set NOTHIN_FOUND 0
		if {$p == $point2} {
		    set stop($s) 1
		} else {
		    set new_curves ""
		    foreach c [ic_geo_incident point $p] {
			if {[lsearch $curves $c] != -1} {lappend new_curves $c}
		    }
		    if {[llength $new_curves] > 2} {
			mess "getting unexpected results from scrib_lib_assembly_find_shortest_path_between_curves \
				$curves $points, in step2 returning \n" red
			return ""
		    }
		    foreach c $new_curves {
			if {[lsearch $used_curves $c] != -1} continue
			set current_curve($s) $c
			lappend c_list($s) $current_curve($s)
			set c_length($s) [expr $c_length($s) + [ic_geo_crv_length $current_curve($s)]]
			lappend used_curves $current_curve($s)
			break
		    }
		}
		if $NOTHIN_FOUND {
		    mess "expecting to find another curve attached to $current_curve($s), but not finding\n" red
		    set c_length($s) 1e39
		    set stop($s) 1
		}
	    }
#mess "c_list($s) is $c_list($s)\n"
#mess "current_curve($s) is $current_curve($s)\n"
	}
	if {$stop(side1) && $stop(side2) } {
	    if {$c_length(side1) < $c_length(side2) } {
		return $c_list(side1)
	    } else {
		return $c_list(side2)
	    }
	}
	if {$stop(side1) && ($c_length(side1) < $c_length(side2) ) } {
	    return $c_list(side1)
	}
	if {$stop(side2) && ($c_length(side1) > $c_length(side2) ) } {
	    return $c_list(side2)
	}
	if {$inc > 1000} {
	    mess "Breaking because expected highest limit has been hit.  The assumption is that we shouldn't be seeing more than 1000 curves, limit should be increase if this is a problem\n" red
	    return ""
	}
    }
    mess "Shouldn't be getting here in scrib_lib_assembly_find_shortest_path_between_curves\n" red
    return ""
}

proc scrib_lib_assembly_side_surface_cut_curves_find {side_surfaces weld_side side_parts {tol 0.001}} {
    set internal_curves ""
    foreach s $side_surfaces {
	set internal_curves [concat $internal_curves [ic_geo_boundary surface $s 0 1]]
    }
    set internal_curves [lsort -unique [scrib_lib_utils_list_get_duplicate $internal_curves]]
    set cut_curves ""
    foreach side $weld_side {
	set points [ic_geo_boundary curve $side 0 1]
	set loc1 [ic_geo_get_point_location [lindex $points 0] ]
	set loc2 [ic_geo_get_point_location [lindex $points 1] ]
	set ploc1 [ic_geo_project_point surface $side_surfaces [lindex $points 0]]
	set ploc2 [ic_geo_project_point surface $side_surfaces [lindex $points 1]]
	set OK 0
	foreach loc [list $loc1 $loc2 $ploc1 $ploc2] {
	    set closest_curve($loc) [scrib_lib_geo_nearest_curve_list $loc $internal_curves]
	    set dist [scrib_lib_geo_distance_from_curves "" $loc $closest_curve($loc)]
	    if { $dist < $tol} {
mess "assigning cut_curve $closest_curve($loc) ; dist is $dist at loc $loc\n"
		lappend cut_curves $closest_curve($loc)
		set OK 1
		break
	    }
	}
	if $OK continue
	set dist1 [scrib_lib_geo_distance_from_surfaces "" $loc1 $side_surfaces]
	set dist2 [scrib_lib_geo_distance_from_surfaces "" $loc2 $side_surfaces]
	if {$dist1 < $dist2} { 
	    set loc $loc1
	    set other_loc $loc2
	} else {
	    set loc $loc2
	    set other_loc $loc1
	}
	set surface_to_split [scrib_lib_geo_nearest_surface_list $loc $side_surfaces]
	mess "surface_to_split is $surface_to_split ; loc is $loc \n"
#mess "side surfaces are $side_surfaces\n"
	set uv1 [ic_geo_find_nearest_srf_pnt $surface_to_split $loc]
#	set uv2 [ic_geo_find_nearest_srf_pnt $surface_to_split $other_loc]
#	set u_diff [expr abs( [expr [lindex $uv1 0] - [lindex $uv2 0] ] ) ]
#	set v_diff [expr abs( [expr [lindex $uv1 1] - [lindex $uv2 1] ] ) ]
#mess "uv1 is $uv1 \n"
#mess "internal_curves are $internal_curves\n"
	set param1 [lindex $uv1 0]
	set param2 [lindex $uv1 1]
	set delete_crv1 0
	set delete_crv2 0	
	set OUT 0
	if [catch [ic_geo_cre_crv_iso_crv $side_parts $side_parts $surface_to_split $param1 0 0] crv1] {
	    if {[llength $crv1] == 4} {set crv1 [lindex [lindex $crv1 3] 0]} else {
		mess "Problem in ic_geo_cre_crv_iso_crv $side_parts $side_parts $surface_to_split $param1 0 0\n" red
		set OUT 1
	    }
#	    return ""
	}
	if [catch [ic_geo_cre_crv_iso_crv $side_parts $side_parts $surface_to_split $param2 1 0] crv2] {
	    if {[llength $crv2] == 4} {set crv2 [lindex [lindex $crv2 3] 0]} else {
		mess "Problem in ic_geo_cre_crv_iso_crv $side_parts $side_parts $surface_to_split $param1 0 0\n" red
		set OUT 1
	    }
#	    return ""
	}
	if $OUT {
mess "crv1 is $crv1 \n crv2 is $crv2\n" cyan
	    if [llength  [ic_geo_check_objects_exist curve $crv1]] {	
		ic_delete_geometry curve names $crv1
	    }
	    if [llength  [ic_geo_check_objects_exist curve $crv2]] {
		ic_delete_geometry curve names $crv2
	    }
	}
	if !$OUT {
	    set crv1 [lindex $crv1 0]
	    set crv2 [lindex $crv2 0]
	    set hyp_crv_length [expr [lindex [ic_geo_crv_length $side] 0] * 0.707106781187]
	    set diff1 [expr abs ([expr [lindex [ic_geo_crv_length $crv1] 0] - $hyp_crv_length]) ]
	    set diff2 [expr abs ([expr [lindex [ic_geo_crv_length $crv2] 0] - $hyp_crv_length]) ]
	    if {$diff1 < $diff2 } {
		ic_delete_geometry curve names $crv2
#		lappend cut_curves $crv1
		set ccurve $crv1
	    } else {
		ic_delete_geometry curve names $crv1
#		lappend cut_curves $crv2
		set ccurve $crv2
	    }
	    #Need this step, because of some bug where UV is not correct in creating isocurve.
	    set new_loc [ic_geo_project_point curve $ccurve $loc]
	    set loc_diff [ic_vcalc distance $new_loc $loc ]
#	    mess "new_loc is $new_loc ; loc_diff is $loc_diff\n"
	}
	if {$OUT || ($loc_diff > $tol)} {
	    mess "Problem in finding correct UV space of surface $surface_to_split\n" red
	    set curves ""
	    foreach c [ic_geo_boundary surface $surface_to_split 0 1] {
		if {[lsearch $internal_curves $c] != -1} continue
		lappend curves $c
	    }
	    if {[llength $curves] != 2} {
		mess "Problem finding valid curves\n" red
	    } else {
		if !$OUT {ic_delete_geometry curve names $ccurve}
		set pts ""
		foreach c $curves {
		    set l [ic_geo_project_point curve $c $loc]
		    lappend pts [ic_geo_cre_pnt $side_parts $side_parts $l]
		}
		lappend cut_curves [ic_geo_cre_bsp_crv_n_pnts $side_parts $side_parts $pts 0.001]
	    }
	} else {lappend cut_curves $ccurve}
    }
    return $cut_curves
}


proc scrib_lib_assembly_get_weld_surfaces {side_surfaces cut_curves {valid_sides ""}} {
    if {[llength $valid_sides] == 1} {
	set curves [ic_geo_boundary surface $valid_sides]
	set OK 1
	foreach c $cut_curves {
	    if {[lsearch $curves $c] == -1} {set OK 0}
	}
	if $OK {return $valid_sides}
    }
    set surfa_list ""
    set surfb_list ""
    set internal_curves ""
    foreach s $side_surfaces {
	set internal_curves [concat $internal_curves [ic_geo_boundary surface $s 0 1]]
    }
    set internal_curves [lsort -unique [scrib_lib_utils_list_get_duplicate $internal_curves]]
    if ![llength $internal_curves] {return}
    if {$valid_sides == ""} {set valid_sides $side_surfaces}
#mess "cut_curves are $cut_curves\n valid_sides are $valid_sides\n"
    set sidea [lindex $cut_curves 0]
    set sideb [lindex $cut_curves 1]
    set surfs [lsort -unique [ic_geo_incident curve $sidea 1]]
    set surfa [lindex $surfs 0]
    #side surfaces are all side surfaces of the weld part
    #valid surfaces are those side surface which are within a distance from the weld-to surface.
    if {[lsearch $valid_sides $surfa] != -1} {
	set surfa_list $surfa
	set sidea_stop 0
    } elseif {[lsearch $side_surfaces $surfa] != -1} {
	set sidea_stop 1
    } else {
	mess "\n\nNOT FINDING VALID SIDE SURFACE\n" red
	mess "surfs is $surfs\n"
	mess "valid_sides is $valid_sides\n"
	mess "side_surfaces are $side_surfaces\n cut_curves are $cut_curves\n"
	mess "surfa_list is $surfa_list \n"
	return ""
    }
    set surfb [lindex $surfs 1]
    #side surfaces are all side surfaces of the weld part
    #valid surfaces are those side surface which are within a distance from the weld-to surface.
    if {[lsearch $valid_sides $surfb] != -1} {
	set surfb_list $surfb
	set sideb_stop 0
    } elseif {[lsearch $side_surfaces $surfb] != -1} {
	set sideb_stop 1
    } else {
 	mess "\n\nNOT FINDING VALID SIDE SURFACE\n" red
	mess "surfs is $surfs\n"
	mess "valid_sides is $valid_sides\n"
	mess "side_surfaces are $side_surfaces\n cut_curves are $cut_curves\n"
	mess "surfb_list is $surfb_list\n"
	return ""
    }
    set counter 0

    while {$counter < 10} {
mess "\n\n-----------------\n surfa_list is $surfa_list ; surfb_list is $surfb_list\n"
mess "surfa is $surfa ; surfb is $surfb\n"
mess "sidea_stop is $sidea_stop ; sideb_stop is $sideb_stop\n"
	incr counter
	if {$sideb_stop && $sidea_stop} {
	    mess "Not finding valid side surfaces in either direction for cut_curves $cut_curves and side_surfaces $side_surfaces\n"
	    mess "counter is $counter\n"
	    mess "valid_sides are $valid_sides\n"
	    return ""
	}
	foreach c [ic_geo_boundary surface $surfa 0 1] {
	    if $sidea_stop {break}
	    if {$c == $sideb} {return $surfa_list}
	    if {[lsearch $internal_curves $c] == -1} continue
	    if {$c == $sidea} continue
	    foreach surf [ic_geo_incident curve $c 1] {
		if {[lsearch $surfa_list $surf] == -1} {
		    set surfa $surf
		    if {[lsearch $valid_sides $surfa] != -1} {
			lappend surfa_list $surfa
		    } else {
			set sidea_stop 1
		    }
		}
	    }
	}
	foreach c [ic_geo_boundary surface $surfb 0 1] {
	    if $sideb_stop {break}
	    if {$c == $sideb} {return $surfb_list}
	    if {[lsearch $internal_curves $c] == -1} continue
	    if {$c == $sidea} continue
	    foreach surf [ic_geo_incident curve $c 1] {
		if {[lsearch $surfb_list $surf] == -1} {
		    set surfb $surf
		    if {[lsearch $valid_sides $surfb] != -1} {
			lappend surfb_list $surfb
		    } else {
			set sideb_stop 1
		    }
		}
	    }
	}
    }	
mess "internal_curves are $internal_curves\n"
}

proc scrib_lib_assembly_get_shorter_proj {points part} {
    set max_dist 1e38
    set ret ""
    foreach p $points {
	set loc2 [ic_geo_project_point surface [ic_geo_get_objects surface $part] $p]
	set dist [ic_vcalc distance $p $loc2]
	if {$dist < $max_dist} {
	    set ret $p
	    set max_dist $dist
	}
    }
    return $ret
}

proc jdsup {} {
global env
source $env(ICEM_ACN)/lib/scrib/lib/assembly.tcl
}

































































































