Posted to tcl by schmitzu at Mon Apr 17 14:02:39 GMT 2023view raw

  1. # get direction of line segment given
  2. # by start-/endpoint as unit vector [xu:yu]
  3. proc pp2uv {x1 y1 x2 y2} {
  4. set dx [expr {$x2 - $x1}]
  5. set dy [expr {$y2 - $y1}]
  6. set ab [expr {sqrt ($dx * $dx + $dy * $dy)}]
  7. set xu [expr {$dx / $ab}]
  8. set yu [expr {$dy / $ab}]
  9. return [list $xu $yu]
  10. }
  11. # get perpedicular line on linesegment ls at
  12. # position t with lenth l
  13. # ls line segment {x1 y1 x2 y2}
  14. # t positon on ls [0..1]
  15. # l length of result segment
  16. # returns:
  17. # {px1 py1 px2 py2} start-/endpoint perpendicular linesegment
  18. proc getPpline {ls t l} {
  19. lassign $ls x1 y1 x2 y2
  20. # calculate point at t
  21. set it [expr {1-$t}]
  22. set xp [expr {$x1 * $t + $x2 * $it}]
  23. set yp [expr {$y1 * $t + $y2 * $it}]
  24. # get unit vector of ls
  25. lassign [pp2uv $x1 $y1 $x2 $y2] xu yu
  26. set l2 [expr {$l / 2.}]
  27. # generate start point of perpedicular line
  28. set px1 [expr {$xp - $yu * $l2}]
  29. set py1 [expr {$yp + $xu * $l2}]
  30. # generate end point of perpedicular line
  31. set px2 [expr {$xp + $yu * $l2}]
  32. set py2 [expr {$yp - $xu * $l2}]
  33. return [list $px1 $py1 $px2 $py2]
  34. }
  35. set linesegment {1. 1. 9. 9.}
  36. set ppl [getPpline $linesegment 0.5 2.0]
  37. puts $ppl

AltStyle によって変換されたページ (->オリジナル) /