set ::custom_flag(from_move,$::mom_path_name) 1 # set ::custom_flag(from_move,$::mom_path_name) 1 set te875st 11111 #set ::custom_flag(from_move,$::mom_path_name) 1 if {$main == 1 && 1 == 1} { puts "main" } proc test {} { puts "main" proc llll {} {} set rrrrrrr } LIB_GE_command_buffer_edit_insert MOM_tool_change_LIB TOOL_CHANGE_AUTO {CUSTOM_after_tool_change_call} mytag after @TOOL_CHANGE_AUTO MOM_abort namespace eval myns { proc add {a b} { set sum [expr {$a + $b}] return $sum } set config "debug" } #_________________________________________________________________________________________________ # # Function to output a spacer line or empty line #_________________________________________________________________________________________________ proc SERVICE_spacer_output {type {length 20} {line_num 0} {output 1}} { LIB_GE_message [string repeat $type $length] "output_$output" $line_num } SERVICE_spacer_output "*" 2 0 0 #_________________________________________________________________________________________________ # # Function to delete the file #_________________________________________________________________________________________________ proc SERVICE_remove_file {file} { if {![SERVICE_check_file_exists $file]} {return} MOM_remove_file $file } #_________________________________________________________________________________________________ # # Function to check if the file exists #_________________________________________________________________________________________________ proc SERVICE_check_file_exists {file} { if {[file exists $file]} {return 1} return 0 } #_________________________________________________________________________________________________ # # Ask UDE Info for the Tool #_________________________________________________________________________________________________ proc SERVICE_ask_ude_tool {pos ude_name tool_name} { MOM_ask_ude_info $tool_name "tool" $pos if {[lsearch $::mom_result $ude_name] != -1} { return 1 } return 0 } proc MOM_dummy_event_start {} { global mom_new_item global mom_new_item_end #Put your UDE Handler Tcl here } #_________________________________________________________________________________________________ # # Ask UDE Info for the Operation #_________________________________________________________________________________________________ proc SERVICE_ask_ude_operation {pos ude_name path_name} { MOM_ask_ude_info $path_name "operation" $pos if {[lsearch $::mom_result $ude_name] != -1} { return 1 } return 0 } #_________________________________________________________________________________________________ # # output suppress or dont suppress # [SERVICE_output_handling "ingore_output"] ignores the output # arg options: ingore_output # restore #_________________________________________________________________________________________________ proc SERVICE_output_handling {handler} { set ::lib_ge(hidden_output) $handler } #_________________________________________________________________________________________________ # # write the mom_tool_data to store tool information # this function is called in start of program #_________________________________________________________________________________________________ proc SERVICE_get_tool_data {} { global mom_tool_data global mom_operation_info set mom_tool_data(toollist) "" set operations $::mom_operation_name_list foreach operation $operations { if {[lsearch -exact $mom_tool_data(toollist) $mom_operation_info($operation,tool_name)] == -1} { lappend mom_tool_data(toollist) $mom_operation_info($operation,tool_name) } } } LIB_GE_command_buffer_edit_replace MOM_end_of_program_LIB END_OF_PROGRAM @END_OF_PROG { MOM_do_template "end_of_program_rewind" } EndOfProgramRewind SERVICE_remove_file "test" oo::class create MCS { variable values constructor {args} { for {set i 0} {$i <= 11} {incr i} { my initValue $i 0. } } destructor { #puts "[self] is now deleted" } method fformat {value {precision 7}} {return [expr {round( 10.0 ** $precision * $value) / (10.0 ** $precision)}]} method radtodeg {rad} {return [expr {$rad*180.0/(4.0*atan(1.0))}]} method degtorad {deg} {return [expr {$deg*(4.0*atan(1.0))/180.0}]} method duplicate {args} {return [[MCS new] initMCS [self]]} method type {args} {return "::MCS"} method toArray {args} { for {set i 0} {$i < [array size values]} {incr i} { append arr [string cat $i " "] ; append arr [string cat $values($i) " "] } return [string trimright $arr] } method toLst {args} { for {set i 0} {$i < [array size values]} {incr i} { lappend lst $values($i) } return $lst } method toStr {args} { for {set i 0} {$i < [array size values]} {incr i} { if {$i>0} {set str [string cat $str ", "]} append str $values($i) } return $str } method toStrF {{precision 7}} { for {set i 0} {$i < [array size values]} {incr i} { if {$i>0} {set str [string cat $str ", "]} append str [my fformat $values($i) 10] } return $str } method initValue {i value} {set values($i) [expr double($value)] ; return [self]} method initArray {a} {upvar $a arr ; for {set i 0} {$i < [array size arr]} {incr i} {my initValue $i $arr($i)} ; return [self]} method initArrayLst {arr_lst} {array set arr $arr_lst ; for {set i 0} {$i < [array size arr]} {incr i} {my initValue $i $arr($i)} ; return [self]} method initLst {lst} {for {set i 0} {$i < [llength $lst]} {incr i} {my initValue $i [lindex $lst $i]} ; return [self]} method initMCS {mcs} { my identity set p [$mcs org] ; my initOrgP $p ; $p destroy set v [$mcs xVct] ; my initXvctV $v ; $v destroy set v [$mcs yVct] ; my initYvctV $v ; $v destroy set v [$mcs zVct] ; my initZvctV $v ; $v destroy return [self] } method initMTX {mtx} { set p [$mtx org] ; my initOrg $p ; $p destroy set v [$mtx xVct] ; my initXvct $v ; $v destroy set v [$mtx yVct] ; my initYvct $v ; $v destroy set v [$mtx zVct] ; my initZvct $v ; $v destroy return [self] } method initOrg {dx dy dz} {my initValue 0 $dx ; my initValue 1 $dy ; my initValue 2 $dz ; return [self]} method initOrgP {p} {return [my initOrg [$p x] [$p y] [$p z]]} method initXvct {dx dy dz} {my initValue 3 $dx ; my initValue 4 $dy ; my initValue 5 $dz ; return [self]} method initXvctV {v} {return [my initXvct [$v x] [$v y] [$v z]]} method initYvct {dx dy dz} {my initValue 6 $dx ; my initValue 7 $dy ; my initValue 8 $dz ; return [self]} method initYvctV {v} {return [my initYvct [$v x] [$v y] [$v z]]} method initZvct {dx dy dz} {my initValue 9 $dx ; my initValue 10 $dy ; my initValue 11 $dz ; return [self]} method initZvctV {v} {return [my initZvct [$v x] [$v y] [$v z]]} method initOrgArray {a} {upvar $a arr ; return [my initOrg $arr(0) $arr(1) $arr(2)]} method initVctsArray {a} { upvar $a arr my initXvct $arr(0) $arr(1) $arr(2) my initYvct $arr(3) $arr(4) $arr(5) my initZvct $arr(6) $arr(7) $arr(8) return [self] } method value {i} {return $values($i)} method org {args} {return [Point3D new $values(0) $values(1) $values(2)]} method xVct {args} {return [Vector3D new $values(3) $values(4) $values(5)]} method yVct {args} {return [Vector3D new $values(6) $values(7) $values(8)]} method zVct {args} {return [Vector3D new $values(9) $values(10) $values(11)]} method same {mcs {precision 7}} { set org [[self] org] ; set org_1 [$mcs org] set vx [[self] xVct] ; set vx_1 [$mcs xVct] set vy [[self] yVct] ; set vy_1 [$mcs yVct] set vz [[self] zVct] ; set vz_1 [$mcs zVct] if {[$org same $org_1 $precision] && [$vx same $vx_1 $precision] && [$vy same $vy_1 $precision] && [$vz same $vz_1 $precision]} { set value 1 } else { set value 0 } $org destroy ; $org_1 destroy $vx destroy ; $vx_1 destroy $vy destroy ; $vy_1 destroy $vz destroy ; $vz_1 destroy return $value } } set point [Point3D new] $point add 1 2 3 $custom_flag(from_move,$::mom_path_name) oo::class create Point3D { variable x 0. ; variable y 0. ; variable z 0. constructor {{dx 0.} {dy 0.} {dz 0.}} {my initX $dx ; my initY $dy ; my initZ $dz} destructor { #puts "[self] is now deleted" } method fformat {value {precision 7}} {return [expr {round( 10.0 ** $precision * $value) / (10.0 ** $precision)}]} method radtodeg {rad} {return [expr {$rad*180.0/(4.0*atan(1.0))}]} method degtorad {deg} {return [expr {$deg*(4.0*atan(1.0))/180.0}]} method duplicate {args} {return [[Point3D new] initP [self]]} method type {args} {return "::Point3D"} method toArray {{i 0}} {return [list [incr i 0] $x [incr i] $y [incr i] $z]} method toLst {args} {return [list $x $y $z]} method toStr {args} {return "$x, $y, $z"} method toStrF {{precision 7}} {return "[my fformat $x $precision], [my fformat $y $precision], [my fformat $z $precision]"} method x {args} {return $x} method y {args} {return $y} method z {args} {return $z} method initX {dx} {set x [expr double($dx)]} method initY {dy} {set y [expr double($dy)]} method initZ {dz} {set z [expr double($dz)]} method init {dx dy dz} {my initX $dx ; my initY $dy ; my initZ $dz ; return [self]} method initArray {a} {upvar $a arr ; return [my init $arr(0) $arr(1) $arr(2)]} method initArrayLst {arr_lst} {array set arr $arr_lst ; return [my init $arr(0) $arr(1) $arr(2)]} method initLst {lst} {return [my init [lindex $lst 0] [lindex $lst 1] [lindex $lst 2]]} method initP {p} {return [my init [$p x] [$p y] [$p z]]} method reset {args} {my init 0. 0. 0. ; return [self]} method add {dx dy dz} {my init [expr {$x + $dx}] [expr {$y + $dy}] [expr {$z + $dz}] ; return [self]} method addArray {a} {upvar $a arr ; return [my add $arr(0) $arr(1) $arr(2)]} method addArrayLst {arr_lst} {array set arr $arr_lst ; return [my add $arr(0) $arr(1) $arr(2)]} method addLst {lst} {return [my add [lindex $lst 0] [lindex $lst 1] [lindex $lst 2]]} method addP {p} {return [my add [$p x] [$p y] [$p z]]} method sub {dx dy dz} {my init [expr {$x - $dx}] [expr {$y - $dy}] [expr {$z - $dz}] ; return [self]} method subArray {a} {upvar $a arr ; return [my sub $arr(0) $arr(1) $arr(2)]} method subArrayLst {arr_lst} {array set arr $arr_lst ; return [my sub $arr(0) $arr(1) $arr(2)]} method subLst {lst} {return [my sub [lindex $lst 0] [lindex $lst 1] [lindex $lst 2]]} method subP {p} {return [my sub [$p x] [$p y] [$p z]]} method dist {dx dy dz} {return [expr {sqrt([expr {$x - $dx}]**2 + [expr {$y - $dy}]**2 + [expr {$z - $dz}]**2)}]} method distArray {a} {upvar $a arr ; return [my dist $arr(0) $arr(1) $arr(2)]} method distArrayLst {arr_lst} {array set arr $arr_lst ; return [my dist $arr(0) $arr(1) $arr(2)]} method distLst {lst} {return [my dist [lindex $lst 0] [lindex $lst 1] [lindex $lst 2]]} method distP {p} {return [my dist [$p x] [$p y] [$p z]]} method dist_to_line {pl1 pl2} { set pl [[$pl2 duplicate] subP $pl1] set pp [[$pl1 duplicate] subP [self]] set vl [[Vector3D new] initV $pl] set vp [[Vector3D new] initV $pp] set l [$vl magnitude] if {[my fformat $l 5]==0} { set value 0. } else { set vc [$vl cross $vp] set value [expr [$vc magnitude]/$l] $vc destroy } $pl destroy ; $vl destroy $pp destroy ; $vp destroy return $value } method dist_to_lineV {v} { set p1 [[Point3D new] init 0. 0. 0.] set p2 [[Point3D new] initP $v] set value [my dist_to_line $p1 $p2] $p1 destroy $p2 destroy return $value } #midpoint method to calculate the midpoint between this point and another point. This can be done by averaging the x, y, and z coordinates of the two points. method midpoint {dx dy dz} {return [Point3D new [expr {double([[self] x] + $dx)/2}] [expr {double([[self] y] + $dy)/2}] [expr {double([[self] z] + $dz)/2}]]} method midpointArr {a} {upvar $a arr ; return [my midpoint $arr(0) $arr(1) $arr(2)]} method midpointArrLst {arr} {array set arr $arr_lst ; return [my midpoint $arr(0) $arr(1) $arr(2)]} method midpointLst {lst} {return [my midpoint [lindex $lst 0] [lindex $lst 1] [lindex $lst 2]]} method midpointP {p} {return [my midpoint [$p x] [$p y] [$p z]]} method same {p {precision 7}} { if {[my fformat [expr {[[self] x] - [$p x]}] $precision] == 0. && [my fformat [expr {[[self] y] - [$p y]}] $precision] == 0. && [my fformat [expr {[[self] z] - [$p z]}] $precision] == 0.} {return 1} else {return 0} } #This method takes three arguments: a vector object "axis" as the axis of rotation, an angle of rotation, and a point object "center" as the center of rotation. #First, it translates the point by subtracting the center of rotation, #then it applies the Rodrigues' rotation formula to calculate the new coordinates of the point, and finally, #it translates back the point by adding the center of rotation. #The center parameter is defined as an optional parameter with a default value of a new Point3D object, initialized with the values (0,0,0). method rotAround {u v w angle {x0 0.} {y0 0.} {z0 0.}} { set x1 [expr {double($x) - $x0}] ; set y1 [expr {double($y) - $y0}] ; set z1 [expr {double($z) - $z0}] set u [expr {double($u)}] ; set v [expr {double($v)}] ; set w [expr {double($w)}] set a [my degtorad $angle] set coss [expr {cos($a)}] set sinn [expr {sin($a)}] set x2 [expr {$u*($u*$x1 + $v*$y1 + $w*$z1)*(1 - $coss) + $x1*$coss + (-$w*$y1 + $v*$z1)*$sinn + $x0}] set y2 [expr {$v*($u*$x1 + $v*$y1 + $w*$z1)*(1 - $coss) + $y1*$coss + ($w*$x1 - $u*$z1)*$sinn + $y0}] set z2 [expr {$w*($u*$x1 + $v*$y1 + $w*$z1)*(1 - $coss) + $z1*$coss + (-$v*$x1 + $u*$y1)*$sinn + $z0}] my init $x2 $y2 $z2 return [self] } method rotAroundLst {aLst angle {cLst {0. 0. 0.}}} { return [my rotAround [lindex $aLst 0] [lindex $aLst 1] [lindex $aLst 2] $angle [lindex $cLst 0] [lindex $cLst 1] [lindex $cLst 2]] } method rotAroundVP {axis angle {center {}}} { if {[catch {set s [$center type]}] || (![string equal [$center type] "::Point3D"] && ![string equal [$center type] "::Vector3D"])} { set center [Point3D new] set b_center true } my rotAround [$axis x] [$axis y] [$axis z] $angle [$center x] [$center y] [$center z] if {[info exists b_center]} {$center destroy} return [self] } method transform {mtx_from mtx_to} { if {[catch {set s [$mtx_from type]}] || ![string equal [$mtx_from type] "::Matrix4x4"]} { set mtx_from [[Matrix4x4 new] identity] set b_mtx_from true } if {[catch {set s [$mtx_to type]}] || ![string equal [$mtx_to type] "::Matrix4x4"]} { set mtx_to [[Matrix4x4 new] identity] set b_mtx_to true } set m [[Matrix4x4 new] identity] $m initValue 0 [my x] $m initValue 4 [my y] $m initValue 8 [my z] $m initValue 12 1. set trs [[[[$mtx_from duplicate] inverse] multiply $mtx_to false] inverse] $m multiply $trs true my init [$m value 0] [$m value 4] [$m value 8] $m destroy $trs destroy if {[info exists b_mtx_from]} {$mtx_from destroy} if {[info exists b_mtx_to]} {$mtx_to destroy} return [self] } }