src/DrawResources/Vector.tcl

   1 # Copyright (c) 2016 OPEN CASCADE SAS
   2 #
   3 # This file is part of Open CASCADE Technology software library.
   4 #
   5 # This library is free software; you can redistribute it and/or modify it under
   6 # the terms of the GNU Lesser General Public License version 2.1 as published
   7 # by the Free Software Foundation, with special exception defined in the file
   8 # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
   9 # distribution for complete text of the license and disclaimer of any warranty.
  10 #
  11 # Alternatively, this file may be used under the terms of Open CASCADE
  12 # commercial license or contractual agreement.
  13 #
  14 # Created by: M.Sazonov
  15 #
  16 # Working with vectors and various measurements
  17 #
  18 # [2d] point is represented by (two/three) coords
  19 # [2d] vector is represented by (two/three) coords
  20 # plane is represented by an origin point and a normal vector
  21 # [2d] line is represented by an origin point and a vector
  22
  23 help vec {vec x1 y1 z1 x2 y2 z2
  24   returns coordinates of vector between two points\
  25 } {Vector and measurement Commands}
  26
  27 proc vec {x1 y1 z1 x2 y2 z2} {
  28     uplevel list [dval ($x2)-($x1)] [dval ($y2)-($y1)] [dval ($z2)-($z1)]
  29 }
  30
  31 help 2dvec {2dvec x1 y1 x2 y2
  32   returns coordinates of 2D vector between two 2D points\
  33 } {Vector and measurement Commands}
  34
  35 proc 2dvec {x1 y1 x2 y2} {
  36     uplevel list [dval ($x2)-($x1)] [dval ($y2)-($y1)]
  37 }
  38
  39 help pln {pln x1 y1 z1 x2 y2 z2 x3 y3 z3
  40   returns plane built on three points\
  41 } {Vector and measurement Commands}
  42
  43 proc pln {x1 y1 z1 x2 y2 z2 x3 y3 z3} {
  44     set v12 [uplevel eval norm [vec $x1 $y1 $z1 $x2 $y2 $z2]]
  45     set v13 [uplevel eval norm [vec $x1 $y1 $z1 $x3 $y3 $z3]]
  46     set vn [eval cross $v12 $v13]
  47     set N [eval module $vn]
  48     if [expr $N < 1e-7] {
  49         puts "points are on a line"
  50         return
  51     }
  52     concat $x1 $y1 $z1 [eval norm $vn]
  53 }
  54
  55 help module {module x y z
  56   returns module of a vector\
  57 } {Vector and measurement Commands}
  58
  59 proc module {x y z} {
  60     uplevel dval sqrt(($x)*($x)+($y)*($y)+($z)*($z))
  61 }
  62
  63 help 2dmodule {2dmodule x y
  64   returns module of a 2D vector\
  65 } {Vector and measurement Commands}
  66
  67 proc 2dmodule {x y} {
  68     uplevel dval sqrt(($x)*($x)+($y)*($y))
  69 }
  70
  71 help norm {norm x y z
  72   returns unified vector from a given vector\
  73 } {Vector and measurement Commands}
  74
  75 proc norm {x y z} {
  76     set N [uplevel dval sqrt(($x)*($x)+($y)*($y)+($z)*($z))]
  77     list [uplevel dval ($x)/$N] [uplevel dval ($y)/$N] [uplevel dval ($z)/$N]
  78 }
  79
  80 help 2dnorm {2dnorm x y
  81   returns unified vector from a given 2D vector\
  82 } {Vector and measurement Commands}
  83
  84 proc 2dnorm {x y} {
  85     set N [uplevel dval sqrt(($x)*($x)+($y)*($y))]
  86     list [uplevel dval ($x)/$N] [uplevel dval ($y)/$N]
  87 }
  88
  89 help inverse {inverse x y z
  90   returns inversed vector\
  91 } {Vector and measurement Commands}
  92
  93 proc inverse {x y z} {
  94     list [uplevel dval -$x] [uplevel dval -$y] [uplevel dval -$z]
  95 }
  96
  97 help 2dinverse {2dinverse x y
  98   returns inversed 2D vector\
  99 } {Vector and measurement Commands}
 100
 101 proc 2dinverse {x y} {
 102     list [uplevel dval -$x] [uplevel dval -$y]
 103 }
 104
 105 help 2dort {2dort x y
 106   returns 2D vector rotated on 90 degrees\
 107 } {Vector and measurement Commands}
 108
 109 proc 2dort {x y} {
 110     list [uplevel dval -$y] [uplevel dval $x]
 111 }
 112
 113 help distpp {distpp x1 y1 z1 x2 y2 z2
 114   returns distance between two points\
 115 } {Vector and measurement Commands}
 116
 117 proc distpp {x1 y1 z1 x2 y2 z2} {
 118     eval module [uplevel vec $x1 $y1 $z1 $x2 $y2 $z2]
 119 }
 120
 121 help 2ddistpp {2ddistpp x1 y1 x2 y2
 122   returns distance between two 2D points\
 123 } {Vector and measurement Commands}
 124
 125 proc 2ddistpp {x1 y1 x2 y2} {
 126     eval 2dmodule [uplevel 1 2dvec $x1 $y1 $x2 $y2]
 127 }
 128
 129 help distplp {distplp xo yo zo dx dy dz xp yp zp
 130   returns distance between plane and point\
 131 } {Vector and measurement Commands}
 132
 133 proc distplp {xo yo zo dx dy dz xp yp zp} {
 134     set vop [uplevel vec $xo $yo $zo $xp $yp $zp]
 135     set vn [uplevel norm $dx $dy $dz]
 136     eval dot $vop $vn
 137 }
 138
 139 help distlp {distlp xo yo zo dx dy dz xp yp zp
 140   returns distance between line and point\
 141 } {Vector and measurement Commands}
 142
 143 proc distlp {xo yo zo dx dy dz xp yp zp} {
 144     set vop [uplevel vec $xo $yo $zo $xp $yp $zp]
 145     set vl [uplevel norm $dx $dy $dz]
 146     eval module [eval cross $vl $vop]
 147 }
 148
 149 help 2ddistlp {2ddistlp xo yo dx dy xp yp
 150   returns distance between 2D line and point\
 151 } {Vector and measurement Commands}
 152
 153 proc 2ddistlp {xo yo dx dy xp yp} {
 154     set vop [uplevel 1 2dvec $xo $yo $xp $yp]
 155     set vl [uplevel 1 2dnorm $dx $dy]
 156     eval 2dcross $vl $vop
 157 }
 158
 159 help distppp {distppp x1 y1 z1 x2 y2 z2 x3 y3 z3
 160   returns deviation of point p2 from segment p1-p3\
 161 } {Vector and measurement Commands}
 162
 163 proc distppp {x1 y1 z1 x2 y2 z2 x3 y3 z3} {
 164     set vop [uplevel vec $x1 $y1 $z1 $x2 $y2 $z2]
 165     set vl [uplevel eval norm [vec $x1 $y1 $z1 $x3 $y3 $z3]]
 166     eval module [eval cross $vl $vop]
 167 }
 168
 169 help 2ddistppp {2ddistppp x1 y1 x2 y2 x3 y3
 170   returns deviation of 2D point p2 from segment p1-p3 (sign shows the side)\
 171 } {Vector and measurement Commands}
 172
 173 proc 2ddistppp {x1 y1 x2 y2 x3 y3} {
 174     set vop [uplevel 1 2dvec $x1 $y1 $x2 $y2]
 175     set vl [uplevel eval 2dnorm [2dvec $x1 $y1 $x3 $y3]]
 176     eval 2dcross $vl $vop
 177 }
 178
 179 help barycen {barycen x1 y1 z1 x2 y2 z2 par
 180   returns point of a given parameter between two points\
 181 } {Vector and measurement Commands}
 182
 183 proc barycen {x1 y1 z1 x2 y2 z2 par} {
 184     uplevel list [dval ($x1)*(1-($par))+($x2)*($par)]\
 185         [dval ($y1)*(1-($par))+($y2)*($par)]\
 186         [dval ($z1)*(1-($par))+($z2)*($par)]
 187 }
 188
 189 help 2dbarycen {2dbarycen x1 y1 x2 y2 par
 190   returns 2D point of a given parameter between two points\
 191 } {Vector and measurement Commands}
 192
 193 proc 2dbarycen {x1 y1 x2 y2 par} {
 194     uplevel list [dval ($x1)*(1-($par))+($x2)*($par)]\
 195         [dval ($y1)*(1-($par))+($y2)*($par)]
 196 }
 197
 198 help cross {cross x1 y1 z1 x2 y2 z2
 199   returns cross product of two vectors\
 200 } {Vector and measurement Commands}
 201
 202 proc cross {x1 y1 z1 x2 y2 z2} {
 203     set x [uplevel dval ($y1)*($z2)-($z1)*($y2)]
 204     set y [uplevel dval ($z1)*($x2)-($x1)*($z2)]
 205     set z [uplevel dval ($x1)*($y2)-($y1)*($x2)]
 206     list $x $y $z
 207 }
 208
 209 help 2dcross {2dcross x1 y1 x2 y2
 210   returns cross product of two 2D vectors\
 211 } {Vector and measurement Commands}
 212
 213 proc 2dcross {x1 y1 x2 y2} {
 214     uplevel dval ($x1)*($y2)-($y1)*($x2)
 215 }
 216
 217 help dot {dot x1 y1 z1 x2 y2 z2
 218   returns scalar product of two vectors\
 219 } {Vector and measurement Commands}
 220
 221 proc dot {x1 y1 z1 x2 y2 z2} {
 222     uplevel dval ($x1)*($x2)+($y1)*($y2)+($z1)*($z2)
 223 }
 224
 225 help 2ddot {2ddot x1 y1 x2 y2
 226   returns scalar product of two 2D vectors\
 227 } {Vector and measurement Commands}
 228
 229 proc 2ddot {x1 y1 x2 y2} {
 230     uplevel dval ($x1)*($x2)+($y1)*($y2)
 231 }
 232
 233 help vecangle {vecangle x1 y1 z1 x2 y2 z2
 234   returns angle between two vectors\
 235 } {Vector and measurement Commands}
 236
 237 proc vecangle {x1 y1 z1 x2 y2 z2} {
 238   set d  [uplevel dot $x1 $y1 $z1 $x2 $y2 $z2]
 239   set c  [uplevel cross $x1 $y1 $z1 $x2 $y2 $z2]
 240   set cm [uplevel module $c]
 241
 242   set m1 [uplevel module $x1 $y1 $z1]
 243   set m2 [uplevel module $x2 $y2 $z2]
 244   set mm [expr $m1*$m2]
 245
 246   if { $cm < $d } {
 247     expr asin($cm/$mm)
 248   } else {
 249     expr acos($d/$mm)
 250   }
 251 }
 252
 253 help 2dvecangle {2dvecangle x1 y1 x2 y2
 254   returns angle between two vectors\
 255 } {Vector and measurement Commands}
 256
 257 proc 2dvecangle {x1 y1 x2 y2} {
 258   set d  [uplevel 1 2ddot $x1 $y1 $x2 $y2]
 259   set c  [uplevel 1 2dcross $x1 $y1 $x2 $y2]
 260
 261   set m1 [uplevel 1 2dmodule $x1 $y1]
 262   set m2 [uplevel 1 2dmodule $x2 $y2]
 263   set mm [expr $m1*$m2]
 264
 265   if { $c < $d } {
 266     expr asin($c/$mm)
 267   } else {
 268     expr acos($d/$mm)
 269   }
 270 }
 271
 272 help scale {scale x y z factor
 273   returns vector multiplied by scalar\
 274 } {Vector and measurement Commands}
 275
 276 proc scale {x y z factor} {
 277     list [dval $x*$factor] [dval $y^$factor] [dval $z*$factor]
 278 }
 279
 280 help 2dscale {2dscale x y factor
 281   returns 2D vector multiplied by scalar\
 282 } {Vector and measurement Commands}
 283
 284 proc 2dscale {x y factor} {
 285     list [dval $x*$factor] [dval $y^$factor]
 286 }
 287
 288 help pntc {pntc curve u
 289   returns coordinates of point on curve with given parameter\
 290 } {Vector and measurement Commands}
 291
 292 proc pntc {curv u} {
 293     upvar \#0 $curv c
 294     cvalue c $u x y z
 295     return "[dval x] [dval y] [dval z]"
 296 }
 297
 298 help 2dpntc {2dpntc curv2d u
 299   returns coordinates of 2D point on 2D curve with given parameter\
 300 } {Vector and measurement Commands}
 301
 302 proc 2dpntc {curv2d u} {
 303     upvar \#0 $curv2d c
 304     2dcvalue c $u x y
 305     return "[dval x] [dval y]"
 306 }
 307
 308 help pntsu {pntsu surf u v
 309   returns coordinates of point on surface with given parameters\
 310 } {Vector and measurement Commands}
 311
 312 proc pntsu {surf u v} {
 313     upvar \#0 $surf s
 314     svalue s $u $v x y z
 315     return "[dval x] [dval y] [dval z]"
 316 }
 317
 318 help pntcons {pntcons curv2d surf u
 319   returns coordinates of point on surface defined by
 320   point on 2D curve with given parameter\
 321 } {Vector and measurement Commands}
 322
 323 proc pntcons {curv2d surf u} {
 324     upvar \#0 $curv2d c $surf s
 325     2dcvalue c $u u0 v0
 326     svalue s u0 v0 x y z
 327     return "[dval x] [dval y] [dval z]"
 328 }
 329
 330 help pnt {pnt point_or_vertex
 331   returns coordinates of point in the given Draw variable of type point or vertex\
 332 } {Vector and measurement Commands}
 333
 334 proc pnt var {
 335     upvar \#0 $var v
 336     set type [dtyp v]
 337     set pp v
 338     if {[lindex $type 1] == "VERTEX"} {
 339         mkpoint p v
 340         set pp p
 341         set type "point"
 342     }
 343     if {$type == "point"} {
 344         if [catch {coord $pp x y z}] {
 345             if ![catch {coord $pp x y}] {
 346                 return "[dval x] [dval y]"
 347             }
 348         } else {
 349             return "[dval x] [dval y] [dval z]"
 350         }
 351     }
 352 }
 353
 354 help drseg {drseg name x1 y1 z1 x2 y2 z2
 355   creates a trimmed line between two points\
 356 } {Vector and measurement Commands}
 357
 358 proc drseg {name x1 y1 z1 x2 y2 z2} {
 359     set x [uplevel dval $x1]
 360     set y [uplevel dval $y1]
 361     set z [uplevel dval $z1]
 362     set dx [uplevel dval ($x2)-($x1)]
 363     set dy [uplevel dval ($y2)-($y1)]
 364     set dz [uplevel dval ($z2)-($z1)]
 365     set len [module $dx $dy $dz]
 366     uplevel line $name $x $y $z $dx $dy $dz
 367     uplevel trim $name $name 0 $len
 368 }
 369
 370 help 2ddrseg {2ddrseg name x1 y1 x2 y2
 371   creates a trimmed 2D line between two 2D points\
 372 } {Vector and measurement Commands}
 373
 374 proc 2ddrseg {name x1 y1 x2 y2} {
 375     set x [uplevel dval $x1]
 376     set y [uplevel dval $y1]
 377     set dx [uplevel dval ($x2)-($x1)]
 378     set dy [uplevel dval ($y2)-($y1)]
 379     set len [2dmodule $dx $dy]
 380     uplevel line $name $x $y $dx $dy
 381     uplevel trim $name $name 0 $len
 382 }
 383
 384 help mpick {show coordinates at mouse click\
 385 } {Vector and measurement Commands}
 386
 387 proc mpick {} {
 388     puts "Pick position"
 389     pick id x1 y1 z1 b
 390     concat [dval x1] [dval y1] [dval z1]
 391 }
 392
 393 help mdist {compute distance between two points of mouse clicks\
 394 } {Vector and measurement Commands}
 395
 396 proc mdist {} {
 397     puts "Pick first position"
 398     pick id x1 y1 z1 b
 399     puts "Pick second position"
 400     pick id x2 y2 z2 b
 401     dval sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)+(z1-z2)*(z1-z2))
 402 }