tests/chamfer/begin

   1 # File : begin
   2
   3 # to prevent loops limit to 10 minutes
   4 cpulimit 600
   5
   6 if { [array get Draw_Groups "TOPOLOGY Fillet construction commands"] == "" } {
   7         pload TOPTEST
   8 }
   9
  10 # This procedure tries to load an EDGE (one point) or EDGE (two points)
  11 proc get_element { type args } {
  12 # First point
  13      set x [lindex $args 0]
  14      set y [lindex $args 1]
  15      set z [lindex $args 2]
  16
  17 # Second point if necessary
  18      if { [string compare $type "FACE"] == 0 } {
  19         set x1 [lindex $args 3]
  20         set y1 [lindex $args 4]
  21         set z1 [lindex $args 5]
  22
  23      } else {
  24         set x1 $x
  25         set y1 $y
  26         set z1 $z
  27      }
  28
  29      global ver
  30      vertex ver $x $y $z
  31      global dd
  32      global dd_val
  33      set res {}
  34
  35 # Try to find element with points inside a bounding box
  36      foreach element [directory] {
  37              global $element
  38              distmini dd ver $element
  39              if { [string match "*$type*" [whatis $element]] } {
  40                 set bbox [bounding $element]
  41 # Get distance
  42                 set dv [lindex [dump dd_val] 5]
  43                 if {    [expr {
  44                         [lindex $bbox 0] - 1e-2 <= $x  && $x  <= [lindex $bbox 3] + 1e-2
  45                    &&   [lindex $bbox 1] - 1e-2 <= $y  && $y  <= [lindex $bbox 4] + 1e-2
  46                    &&   [lindex $bbox 2] - 1e-2 <= $z  && $z  <= [lindex $bbox 5] + 1e-2
  47                    &&   [lindex $bbox 0] - 1e-2 <= $x1 && $x1 <= [lindex $bbox 3] + 1e-2
  48                    &&   [lindex $bbox 1] - 1e-2 <= $y1 && $y1 <= [lindex $bbox 4] + 1e-2
  49                    &&   [lindex $bbox 2] - 1e-2 <= $z1 && $z1 <= [lindex $bbox 5] + 1e-2
  50                         }]
  51                    } {
  52                    if { [llength $res] == 0 } {
  53                       lappend res $element
  54                       lappend res $dv
  55                    } else {
  56                       if { [lindex $res 1] > $dv } {
  57                          lset res 0 $element
  58                          lset res 1 $dv
  59                       }
  60                    }
  61 #                  return $element
  62                 }
  63              }
  64      }
  65
  66      unset dd
  67      if { [llength $res] != 0 } {
  68         return [lindex $res 0]
  69      }
  70
  71      set error "Error  : $type is not found at $x $y $z"
  72      if { [string compare $type "FACE"] == 0 } {
  73         set error "$error and $x1 $y1 $z1"
  74      }
  75
  76      puts $error
  77      return ""
  78 }
  79
  80 # Compute chamfer sequentially
  81 # The edge and face numbers are changed after each step.
  82 # It is necessary to compute new names on result shape after each camf command.
  83 proc chamf_sequence { args } {
  84      set len [llength $args]
  85      if { $len == 1 } {
  86         set args [lindex $args 0]
  87         set len [llength $args]
  88      }
  89      set chamfer_list {}
  90      set chamf_current {}
  91      set result_shape [lindex $args 0]
  92      set shape_edges [lindex $args 1]
  93      set shape_faces [lindex $args 2]
  94
  95      global chamf_edge_face
  96      global chamf_type
  97      global chamf_parameters
  98
  99      global $result_shape
 100      foreach d [directory] {
 101              global $d
 102      }
 103
 104      set len [llength $chamf_edge_face]
 105      for {set i 0} {$i < $len} {incr i} {
 106 # Numbers of EDGE and FACE in inital shape for step $i
 107          set ef [lindex $chamf_edge_face  $i]
 108 # Parameters of chamfer for step $i
 109          set p  [lindex $chamf_parameters $i]
 110
 111 # Name of EDGE in initial shape
 112          set stre "${shape_edges}_[lindex $ef 0]"
 113 # Name of FACE in initial shape
 114          set strf "${shape_faces}_[lindex $ef 1]"
 115 # Get a Cender of gravity for each element and compute new names of on each step.
 116 # get_element procedure tries to find an element with Cender of gravity inside an bounding box.
 117          foreach name [list EDGE FACE] {
 118                  if { [string compare $name "EDGE"] == 0 } {
 119                     set props [lprops $stre]
 120                     if { [llength $chamf_current] != 0 } {
 121                        lappend chamfer_list $chamf_current
 122                        set chamf_current {}
 123                     }
 124                     lappend chamf_current $result_shape
 125                     lappend chamf_current $shape_edges
 126                  } else {
 127                     set props [sprops $strf]
 128                  }
 129                  if { [regexp {Center of gravity[^0-9=]+= +([-0-9.+eE]+)[^0-9=]+= +([-0-9.+eE]+)[^0-9=]+= +([-0-9.+eE]+)} $props full x y z] } {
 130 # New names of element will be computed dynamically on each step.
 131                     if { [string compare $name "EDGE"] == 0 } {
 132                        lappend chamf_current "\[get_element $name $x $y $z\]"
 133 # Save EDGE center for get_element command with FACE argument.
 134                        set x1 $x
 135                        set y1 $y
 136                        set z1 $z
 137                     } else {
 138                        lappend chamf_current "\[get_element $name $x $y $z $x1 $y1 $z1\]"
 139                     }
 140                  }
 141          }
 142          if { [string compare $chamf_type ""] != 0} {
 143             lappend chamf_current $chamf_type
 144          }
 145          foreach pe $p {
 146                  lappend chamf_current $pe
 147          }
 148      }
 149      lappend chamfer_list $chamf_current
 150      foreach chamf_current $chamfer_list {
 151 # Compute new name of EDGE
 152              lset chamf_current 2 [expr [lindex $chamf_current 2]]
 153 # Compute new name of FACE
 154              lset chamf_current 3 [expr [lindex $chamf_current 3]]
 155
 156              set str "chamf $chamf_current"
 157              puts $str
 158 # Compute chamfer
 159              set failed [catch $str res]
 160              if { $failed } {
 161                 puts "Error   : chamfer is not done. $res"
 162 # Save previous shape in new name
 163                 renamevar $shape_edges $result_shape
 164              }
 165 # Delete temporary edges and faces
 166              foreach str [directory] {
 167                      set type [whatis $str]
 168                      set is_edge [string match "*EDGE*" $type]
 169                      set is_face [string match "*FACE*" $type]
 170                      if { $is_edge || $is_face } {
 171                         unset $str
 172                      }
 173              }
 174              if { $failed == 0 } {
 175                 unset $shape_edges
 176              }
 177 # Allow to use exploded elements on next step
 178              set nb [countshapes $result_shape]
 179              regexp {EDGE[^0-9]+([0-9]+)} $nb full nbedges
 180              regexp {FACE[^0-9]+([0-9]+)} $nb full nbfaces
 181              for {set j 1} {$j <= $nbedges} {incr j} {
 182                  global "${result_shape}_$j"
 183              }
 184              for {set j 1} {$j <= $nbfaces} {incr j} {
 185                  global "${shape_edges}_$j"
 186              }
 187              explode $result_shape E
 188              renamevar $result_shape $shape_edges
 189              explode $shape_edges F
 190      }
 191 # Save result shape in new name
 192      renamevar $shape_edges $result_shape
 193 }
 194
 195 # Compute chamfer at one command or sequentially
 196 proc compute_chamf { args } {
 197      global command
 198      if { [string compare $command "chamf_sequence"] == 0 } {
 199         chamf_sequence $args
 200      } else {
 201         set len [llength $args]
 202         set result_shape [lindex $args 0]
 203         set shape_edges [lindex $args 1]
 204         set shape_faces [lindex $args 2]
 205
 206         global chamf_edge_face
 207         global chamf_type
 208         global chamf_parameters
 209
 210         global $result_shape
 211         foreach d [directory] {
 212                 global $d
 213         }
 214
 215         set chamf_str "chamf $result_shape $shape_edges"
 216
 217         set len [llength $chamf_edge_face]
 218         for {set i 0} {$i < $len} {incr i} {
 219             set ef [lindex $chamf_edge_face  $i]
 220             set p  [lindex $chamf_parameters $i]
 221             set chamf_str "${chamf_str} ${shape_edges}_[lindex $ef 0] ${shape_faces}_[lindex $ef 1] $chamf_type $p"
 222         }
 223
 224         puts $chamf_str
 225 # Compute chamfer in one command
 226         if { [catch "$chamf_str" res] } {
 227            puts "Error   : chamfer is not done. $res"
 228            renamevar $shape_edges $result_shape
 229         }
 230      }
 231 }