外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
tclshで楕円弧の長さ(表示画面のｽｹｰﾙ)を計測表示する
:tclshで楕円弧の長さ(表示画面のｽｹｰﾙ)を計測表示する
@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 #1ci 長さを計測する円・円弧を指示してください
REM #e
#!この次の行からプログラムを書いてください
proc arc_l {r p1 p2 w} { # 弧長を計算する
set x [expr 1.0 - $w]
set s [expr {$x == 0} ? 0 : [expr {$x > 0} ? 1 : -1]]
if {$s == -1} {
set w [expr 1.0 / $w]
set r [expr $r / $w]
set p1 [expr $p1 - 90]
set p2 [expr $p2 - 90]
}
set k [expr sqrt(1.0 - $w * $w)]
set PI [expr acos(-1)]
set ek [e $k [expr $PI / 2] ee hh]
while {$p1 < 0} {set p1 [expr $p1 + 360]}
while {$p1 >= 360} {set p1 [expr $p1 - 360]}
while {$p2 < 0} {set p2 [expr $p2 + 360]}
while {$p2 >= 360} {set p2 [expr $p2 - 360]}
if {$p1 == $p2} {return [expr 4.0 * $ek * $r]}
set n1 [expr 1 + int($p1 / 90.0)]
if {$n1 > 4} {set n1 4}
set lp [expr $ek * ( ($n1 + 1) % 2) + [e $k [expr [apa $n1 $p1] * $PI / 180] ee hh] * pow(-1.0, $n1 - 1)]
set n2 [expr 1 + int($p2 / 90.0)]
if {$n2 > 4} {set n2 4}
if {$n1 == $n2} {set n1 [expr $n1 + 4]}
set n3 [expr 5 + 2 * int( ($n2 - 1) / 2.0)]
set lp [expr $lp + $ek * ( ($n3 - $n1) % 4) + [e $k [expr [apa $n2 $p2] * $PI / 180] ee hh] * pow(-1.0, $n2)]
if {$lp < 0.0} {set lp [expr $lp + 4.0 * $ek]}
return [expr $lp * $r]
}
proc apa {o p} {
return [expr (90.0 * (2 * int( ($o + 1) / 2) - 1) - $p) * pow(-1, $o - 1)]
}
proc e {k p name_e name_h} {
upvar $name_e ee
upvar $name_h hh
# 第２種楕円積分 E(p, k) をガウス積分により算定する
# p --- 始点と終点の角度の差( rad )
if {$k == 0} { return $p }
set n 150; #Gauss-Legendre
set m [expr ($n + $n % 2) / 2]
if {[array size ee] > 0} {} else { eh ee hh $n }
set l 0.0
for {set i 1} {$i <= $m} {incr i} {
set l [expr $l + $hh($i) * sqrt(1.0 - pow($k * sin($ee($i) * $p), 2))]
}
if {[array size hh] == [expr $m + 1]} { # 奇数個の場合
set l [expr $l + $hh($m) * sqrt(1.0 - pow($k * sin($ee($m) * $p), 2)) / 2.0]
}
return [expr $l * $p]
}
proc eh {name_e name_h n} {
upvar $name_e ee
upvar $name_h hh
set PI [expr acos(-1)]
set m [expr ($n + $n % 2) / 2]
set e1 [expr $n * ($n + 1)]
for {set i 1} {$i <= $m} {incr i} {
set t [expr (4.0 * $i - 1.0) * $PI / (4.0 * $n + 2.0)]
set x0 [expr (1.0 - (1.0 - 1.0 / $n) / (8.0 * $n * $n)) * cos($t)]
set pkm1 1.0
set pk $x0
for {set k 2} {$k <= $n} {incr k} {
set t1 [expr $x0 * $pk]
set pkp1 [expr $t1 - $pkm1 - ($t1 - $pkm1) / $k + $t1]
set pkm1 $pk
set pk $pkp1
}
set den [expr 1.0 - $x0 * $x0]
set d1 [expr $n * ($pkm1 - $x0 * $pk)]
set dpn [expr $d1 / $den]
set d2pn [expr (2.0 * $x0 * $dpn - $e1 * $pk) / $den]
set d3pn [expr (4.0 * $x0 * $d2pn + (2.0 - $e1) * $dpn) / $den]
set d4pn [expr (6.0 * $x0 * $d3pn + (6.0 - $e1) * $d2pn) / $den]
set u [expr $pk / $dpn]
set v [expr $d2pn / $dpn]
set h [expr -1.0 * $u * (1.0 + 0.5 * $u * ($v + $u * ($v * $v - $d3pn / (3.0 * $dpn))))]
set pp [expr $pk + $h * ($dpn + 0.5 * $h * ($d2pn + $h / 3.0 * ($d3pn + 0.25 * $h * $d4pn)))]
set dp [expr $dpn + $h * ($d2pn + 0.5 * $h * ($d3pn + $h * $d4pn / 3.0))]
set h [expr $h - $pp / $dp]
set xi [expr $x0 + $h]
set fx [expr $d1 - $h * $e1 * ($pk + 0.5 * $h * ($dpn + $h / 3.0 * ($d2pn + 0.25 * $h * ($d3pn + 0.2 * $h * $d4pn))))]
set wi [expr 2.0 * (1.0 - $xi * $xi) / ($fx * $fx)]
set ee($i) $xi
set hh($i) $wi
}
}
# 主文
set tcl_precision 16; #文字列を数値演算するとき有効桁数 16 (デフォルト 12)
set lg ""
set f [open myfiles]
foreach 0 [split [read $f] \n] {
switch -regexp -matchvar n -- $0 {
^hs {
for {set i 0} {$i <= 15} {incr i} {
set hs([format "%x" $i]) [lindex $0 [expr $i + 1]]
}
}
{^lg[0-9a-f]} {
set plg [string index $0 2]
if {$lg == ""} {set lg $plg}
}
^ci {
set p [expr $hs($lg) / $hs($plg)]
lassign $0 1 2 3 r p1 p2 w d
set NF [llength $0]
if {$NF == 4} { lassign {0 0 1 0} p1 p2 w d }
set r [expr $r * $p]
puts [format "h#円弧長 L = %.03f" [arc_l $r $p1 $p2 $w]]
}
}
}
close $f
