jw_cad 外部変形 - (1040) tclshで2線の交角を計算する -

外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。

 

tclshで2線の交角を計算する

:tclshで2線の交角を計算する
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
  copy jwc_temp.txt myfiles > nul
  more +%%n %0 | tclsh - > jwc_temp.txt
)
goto:eof

REM #jww
REM #1%dln 線を指示してください
REM #2%dln 線を指示してください
REM #bz
REM #e

#!この次の行からプログラムを書いてください
proc sgn {x} {
  return [expr {$x == 0} ? 0 : [expr {$x > 0} ? 1 : -1]]
}

proc ln_hpsnap {ln hp} { #線の吸着点を返す
  set t [ln_hpdist $ln $hp]
  set d [lnslope $ln]
  set x [lindex $hp 0]
  set y [lindex $hp 1]
  return [list [expr $x + $t * sin($d)] [expr $y - $t * cos($d)]]
}

proc lnlength {ln} { #線長を返す
  lassign $ln x1 y1 x2 y2
  return [expr hypot($x2 - $x1, $y2 - $y1)]
}

proc lnslope {ln} { #線の角度を返す
  lassign $ln x1 y1 x2 y2
  return [expr atan2($y2 - $y1, $x2 - $x1)]
}

proc ptslope {p1 p2} {
  lassign $p1 x1 y1
  lassign $p2 x2 y2
  return [expr atan2($y2 - $y1, $x2 - $x1)]
}

proc ln_hpdist {ln hp} { #線と点の最短距離を返す
  lassign $hp x1 y1
  lassign $ln x2 y2 x3 y3
  set x [list $x1 $y1 $x2 $y2]
  return [expr [lnlength $x] * [expr sin([lnslope $ln] - [lnslope $x])]]
}

proc line_x_poi {ln1 ln2} { #線と線の交点
  lassign $ln1 x1 y1 x2 y2
  set dx1 [expr $x2 - $x1]
  set dy1 [expr $y2 - $y1]
  set m1 [expr $dx1 ? $dy1 / $dx1 : 1e20]
  lassign $ln2 x3 y3 x4 y4
  set dx2 [expr $x4 - $x3]
  set dy2 [expr $y4 - $y3]
  set m2 [expr $dx2 ? $dy2 / $dx2 : 1e20]
  set aa [expr $m1 - $m2]
  if {abs($aa) < 1e-10} { set aa 0 }
  if {$aa != 0} {
    set b1 [expr $y1 - $m1 * $x1]
    set b2 [expr $y3 - $m2 * $x3]
    return [list "[expr ($b2 - $b1) / $aa] [expr ($m1 * $b2 - $m2 * $b1) / $aa]" [expr $aa]]
#    return [list [list [expr ($b2 - $b1) / $aa] [expr ($m1 * $b2 - $m2 * $b1) / $aa]] [expr $aa]]
  } else {
    return [list 0 0 [expr $aa]]
  }
}

set tcl_precision 16; #文字列を数値演算するとき有効桁数 16 (デフォルト 12)

set f [open myfiles]
foreach 0 [split [read $f] \n] {
  switch -regexp -matchvar n -- $0 {
    {^hp(\d+)} {
      lassign $0 1 2 3
      set hpn [lindex $n 1]
      if {$hpn == 1} { set hp1 "$2 $3" }
      if {$hpn == 2} { set hp2 "$2 $3" }
      continue
    }
    {^hhp(\d+)} {
      set lnn [lindex $n 1]
      continue
    }
    {^[ ]} { 
      set NF [llength $0]
      if {$NF == 4} {
        if {$lnn == 1} { set ln1 $0 }
        if {$lnn == 2} { set ln2 $0 }
      }
    }
  }
}
close $f

proc deg x {
  return [expr $x * 180 / acos(-1)]
}

lassign [line_x_poi $ln1 $ln2] pt aa
if {$aa != 0} {
  set p1 [ln_hpsnap $ln1 $hp1]
  set p2 [ln_hpsnap $ln2 $hp2]
  set d1 [ptslope $pt $p1]
  set d2 [ptslope $pt $p2]
  set xang [deg [expr $d2 - $d1]]
} else {
  set xang 0
}
if {[sgn [expr $xang - 180]] == 1} { set xang [expr $xang - 360] }
if {[sgn [expr $xang + 180]] ==-1} { set xang [expr $xang + 360] }
puts [format "h#2線の交角 = ∠%.6f゚ : d1=%.6f゚ : d2=%.6f゚" \
                               $xang [deg $d1] [deg $d2]]