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 scale {scale x y z factor
 234   returns vector multiplied by scalar\
 235 } {Vector and measurement Commands}
 236
 237 proc scale {x y z factor} {
 238     list [dval $x*$factor] [dval $y^$factor] [dval $z*$factor]
 239 }
 240
 241 help 2dscale {2dscale x y factor
 242   returns 2D vector multiplied by scalar\
 243 } {Vector and measurement Commands}
 244
 245 proc 2dscale {x y factor} {
 246     list [dval $x*$factor] [dval $y^$factor]
 247 }
 248
 249 help pntc {pntc curve u
 250   returns coordinates of point on curve with given parameter\
 251 } {Vector and measurement Commands}
 252
 253 proc pntc {curv u} {
 254     upvar \#0 $curv c
 255     cvalue c $u x y z
 256     return "[dval x] [dval y] [dval z]"
 257 }
 258
 259 help 2dpntc {2dpntc curv2d u
 260   returns coordinates of 2D point on 2D curve with given parameter\
 261 } {Vector and measurement Commands}
 262
 263 proc 2dpntc {curv2d u} {
 264     upvar \#0 $curv2d c
 265     2dcvalue c $u x y
 266     return "[dval x] [dval y]"
 267 }
 268
 269 help pntsu {pntsu surf u v
 270   returns coordinates of point on surface with given parameters\
 271 } {Vector and measurement Commands}
 272
 273 proc pntsu {surf u v} {
 274     upvar \#0 $surf s
 275     svalue s $u $v x y z
 276     return "[dval x] [dval y] [dval z]"
 277 }
 278
 279 help pntcons {pntcons curv2d surf u
 280   returns coordinates of point on surface defined by
 281   point on 2D curve with given parameter\
 282 } {Vector and measurement Commands}
 283
 284 proc pntcons {curv2d surf u} {
 285     upvar \#0 $curv2d c $surf s
 286     2dcvalue c $u u0 v0
 287     svalue s u0 v0 x y z
 288     return "[dval x] [dval y] [dval z]"
 289 }
 290
 291 help pnt {pnt point_or_vertex
 292   returns coordinates of point in the given Draw variable of type point or vertex\
 293 } {Vector and measurement Commands}
 294
 295 proc pnt var {
 296     upvar \#0 $var v
 297     set type [dtyp v]
 298     set pp v
 299     if {[lindex $type 1] == "VERTEX"} {
 300         mkpoint p v
 301         set pp p
 302         set type "point"
 303     }
 304     if {$type == "point"} {
 305         if [catch {coord $pp x y z}] {
 306             if ![catch {coord $pp x y}] {
 307                 return "[dval x] [dval y]"
 308             }
 309         } else {
 310             return "[dval x] [dval y] [dval z]"
 311         }
 312     }
 313 }
 314
 315 help drseg {drseg name x1 y1 z1 x2 y2 z2
 316   creates a trimmed line between two points\
 317 } {Vector and measurement Commands}
 318
 319 proc drseg {name x1 y1 z1 x2 y2 z2} {
 320     set x [uplevel dval $x1]
 321     set y [uplevel dval $y1]
 322     set z [uplevel dval $z1]
 323     set dx [uplevel dval ($x2)-($x1)]
 324     set dy [uplevel dval ($y2)-($y1)]
 325     set dz [uplevel dval ($z2)-($z1)]
 326     set len [module $dx $dy $dz]
 327     uplevel line $name $x $y $z $dx $dy $dz
 328     uplevel trim $name $name 0 $len
 329 }
 330
 331 help 2ddrseg {2ddrseg name x1 y1 x2 y2
 332   creates a trimmed 2D line between two 2D points\
 333 } {Vector and measurement Commands}
 334
 335 proc 2ddrseg {name x1 y1 x2 y2} {
 336     set x [uplevel dval $x1]
 337     set y [uplevel dval $y1]
 338     set dx [uplevel dval ($x2)-($x1)]
 339     set dy [uplevel dval ($y2)-($y1)]
 340     set len [2dmodule $dx $dy]
 341     uplevel line $name $x $y $dx $dy
 342     uplevel trim $name $name 0 $len
 343 }
 344
 345 help mpick {show coordinates at mouse click\
 346 } {Vector and measurement Commands}
 347
 348 proc mpick {} {
 349     puts "Pick position"
 350     pick id x1 y1 z1 b
 351     concat [dval x1] [dval y1] [dval z1]
 352 }
 353
 354 help mdist {compute distance between two points of mouse clicks\
 355 } {Vector and measurement Commands}
 356
 357 proc mdist {} {
 358     puts "Pick first position"
 359     pick id x1 y1 z1 b
 360     puts "Pick second position"
 361     pick id x2 y2 z2 b
 362     dval sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)+(z1-z2)*(z1-z2))
 363 }