Code:
###############################################################################
### VECTOR ROUTINES ###
###############################################################################
if [namespace exists thgrVector] {namespace delete thgrVector}
namespace eval thgrVector {
namespace export vexpr vcalc vnorm matmul
foreach op {+ - * / % ==} {proc $op {a b} "expr {\$a $op \$b}"}
}
# thgrVector::lmap --
#
# lmap is a "collecting foreach" which returns a list of its results.
# See http://wiki.tcl.tk/13920
#
# Arguments:
# _var name of the variable
# list map "body" over each item of the given "list"
# body tcl command to be evaluated for each "list" element
#
# Results:
#
proc thgrVector::lmap {_var list body} {
upvar 1 $_var var
set res {}
foreach var $list {lappend res [uplevel 1 $body]}
set res
}
# thgrVector::vcalc --
#
# Do arithmetics of the form:
# * scalar @ scalar -> scalar (like expr does)
# * vector @ scalar -> vector
# * scalar @ vector -> vector
# * vector @ vector -> vector (all of same dimensions, element-wise)
# Additionally the cross and scalar product is supported
# ATTENTION: vcalc {{1 2 3} {4 5 6} {7 8 9}} * {{1 0 0} {0 1 0} {0 0 1}}}
# gives {{1 0 0} {0 5 0} {0 0 9}}
#
# See http://wiki.tcl.tk/14022
#
#
# Arguments:
# a first vector/scalar
# op operator (e.g. + - * / X)
# b second vector/scalar
#
# Results:
# Value of the evaluated expression $a $op $b.
proc thgrVector::vcalc {a op b} {
set lena [llength $a]
set lenb [llength $b]
if {[string toupper $op] eq "X"} {
# Ex-product has to be treated special
set L [concat $a $b]
if {[llength $L] != 6} {error "ex-product only defined for dimension 3"}
foreach {a1 a2 a3 b1 b2 b3} $L {}
return [list [expr {$a2*$b3-$a3*$b2}] [expr {$a3*$b1-$a1*$b3}] \
[expr {$a1*$b2-$a2*$b1}] ]
}
if {$lena == 1 && $lenb == 1} { ;# scalar operation
$op $a $b
} elseif {$lena == 1} { ;# scalar and vector operation
lmap i $b {vcalc $a $op $i}
} elseif {$lenb == 1} {
lmap i $a {vcalc $i $op $b}
} elseif {$lena == $lenb} { ;# vector operations
if {$op eq "."} { return [expr [join [vcalc $a * $b] +]+0] }
set res {}
foreach i $a j $b {lappend res [vcalc $i $op $j]}
set res
} else {error "length mismatch $lena != $lenb"}
}
# thgrVector::vnorm --
#
# Vector norm - "length" or "size" of the vector.
#
# Arguments:
# v vector (list of components of the vector)
#
# Results:
# Norm of given vector v. Value is always a floating point number.
proc thgrVector::vnorm {v} {
return [expr sqrt([join [vcalc $v * $v] +]+0)]
}
namespace import thgrVector::vcalc thgrVector::vnorm
###############################################################################
# diff_p_N --
#
# Return distance between node $NodeID and point $point.
proc diff_p_N {NodeID point} {
set nCoords [join [hm_nodevalue $NodeID]]
return [vnorm [vcalc $nCoords - $point]]
}
# findClosestNode --
#
# Return node ID which lies closest to point $myPoint. Search among
# $nodeList nodes only.
proc findClosestNode {nodeList myPoint} {
set mindist 1e27
set id -1
foreach nodeID $nodeList {
set delta [diff_p_N $nodeID $myPoint]
if {$delta < $mindist} {
set mindist $delta
set id $nodeID
}
}
return $id
}
# LETS TEST IT:
*createmark nodes 1 displayed
set nodeList [lsort -integer [hm_getmark nodes 1]]
set myPoint {100.0 0.0 0.0}
puts "[findClosestNode $nodeList $myPoint] is the closest node to point $myPoint."
'CAE > HyperWorks' 카테고리의 다른 글
Hyperview에서 Abaqus의 Error and Warning Set 확인하기 (0) | 2019.10.30 |
---|---|
[HyperGraph] Curve 데이터를 가공(수식/함수)하여 새로운 Curve 생성하기 (0) | 2018.10.18 |
Solid map 이용하여 hexa 메쉬하기 (0) | 2018.06.18 |
Query for Node or Element (0) | 2011.11.10 |