tests/bugs/modalg_7/begin

   1 set subgroup modalg
   2
   3 set calcul "p"
   4 set type "i"
   5
   6 proc OFFSETSHAPE {distance faces calcul type} {
   7         uplevel #0 explode s f
   8         uplevel #0 offsetparameter 1e-7 $calcul $type
   9         uplevel #0 offsetload s $distance $faces
  10         uplevel #0 offsetperform result
  11 }
  12
  13 proc ProjectCurvePointToPlaneAlongDir {curve param pln {dir {}}} {
  14   upvar $pln p
  15   upvar $curve c
  16   cvalue c $param x y z
  17   if {[llength $dir] == 0 } {
  18     # project to plane along the normal
  19     regexp {Axis   :([-0-9.+eE]+), ([-0-9.+eE]+), ([-0-9.+eE]+)} [dump p] full dx dy dz
  20     lappend dir $dx $dy $dz
  21   }
  22   line ln x y z [lindex $dir 0] [lindex $dir 1] [lindex $dir 2]
  23   intersect pt ln p
  24   regexp {Point : ([-0-9.+eE]+), ([-0-9.+eE]+), ([-0-9.+eE]+)} [dump pt] full x y z
  25
  26   set pntOnPlane {}
  27   lappend pntOnPlane $x $y $z
  28   return $pntOnPlane
  29 }
  30
  31 proc CheckProjectionToPlane {nbSamples origCurve origParam0 origParam1 projCurve projParam0 projParam1 pln {dir {}} {tolerance 1.e-7}} {
  32   upvar $pln p
  33   upvar $origCurve origC
  34   upvar $projCurve projC
  35
  36   set isOk 1
  37   for {set i 0} {$i <= $nbSamples} {incr i} {
  38     set parOrig [expr $origParam0 + ($origParam1 - $origParam0) * $i / $nbSamples]
  39     set parProj [expr $projParam0 + ($projParam1 - $projParam0) * $i / $nbSamples]
  40
  41     set pnt [ProjectCurvePointToPlaneAlongDir origC $parOrig p $dir]
  42     cvalue projC $parProj X Y Z
  43
  44     set dx [expr [lindex $pnt 0]-[dval X]]
  45     set dy [expr [lindex $pnt 1]-[dval Y]]
  46     set dz [expr [lindex $pnt 2]-[dval Z]]
  47
  48     if {[expr $dx*$dx + $dy*$dy + $dz*$dz] < [expr $tolerance*$tolerance]} {
  49       puts "OK: Projection correct"
  50     } else {
  51       puts "ERROR: Projection incorrect"
  52       set isOk 0
  53     }
  54   }
  55   return $isOk
  56 }