jw_cad 外部変形 - (1045) tclshで円弧の端点に矢印を描く -

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

 

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 #bz
REM #e

#!この次の行からプログラムを書いてください
proc ptdist {pt1 pt2} {
  lassign $pt1 x1 y1
  lassign $pt2 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 polarto {pt r d} {
  lassign $pt x y
  return [list [expr $x + $r * cos($d)] [expr $y + $r * sin($d)]]
}

proc arrow {pt1 d size xang xan2} {
  set l $size
  set PI [expr acos(-1)]
  set a [expr $xang * $PI / 180 / 2.0]
  set pt2 [polarto $pt1 $l [expr $d - $a]]
  set pt4 [polarto $pt1 $l [expr $d + $a]]
  if {$xan2 == 180} {
    puts "sl $pt1 $pt2 $pt4"
  } else {
    set c [expr cos($a) - sin($a) * tan((90.0 - $xan2 / 2.0) * $PI / 180)]
    set pt3 [polarto $pt1 [expr $l * $c] $d]
    puts "sl $pt1 $pt2 $pt3 $pt4"
  }
}

proc cipoint {ci pm} {
  lassign $ci x y r p1 p2 w d
  set PI [expr acos(-1)]
  set d [expr $d * $PI / 180]
  set co [expr cos($d) * $r]
  set si [expr sin($d) * $r]
  set q [expr [expr {$pm == -1} ? $p1 : $p2] * $PI / 180]
  set xr [expr cos($q)]
  set yr [expr sin($q) * $w]
  set a [expr atan2($yr / $w, $xr * $w) + $d]
  return [list "[expr $x + $xr * $co - $yr * $si] [expr $y + $xr * $si + $yr * $co]" $a]
}

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

set f [open myfiles]
foreach 0 [split [read $f] \n] {
  switch -regexp -- $0 {
    ^hq { puts "bz"; continue }
    ^hp1ci { set pt [lrange $0 1 end] }
    ^ci { 
      lassign $0 1 x y r p1 p2 w d
      set NF [llength $0]
      if {$NF == 4} { lassign "0 0 1 0" p1 p2 w d }
      set ci "$x $y $r $p1 $p2 $w $d"
      set size 5; #矢印の長さ( 図寸 )
      set xang 45; #矢印の交角( ゚ )
      set xan2 120; #矢尻の交角( ゚ )
      lassign [cipoint $ci -1] pt1 a1
      lassign [cipoint $ci  1] pt2 a2
      set l1 [ptdist $pt $pt1]
      set l2 [ptdist $pt $pt2]
      set pm [expr {$l1 <= $l2} ? -1 : 1]
      if {$pm == -1} {
        arrow $pt1 [expr $a1 + $PI / 2] [expr -$pm * $size] $xang $xan2
      } elseif {$pm == 1} {
        arrow $pt2 [expr $a2 + $PI / 2] [expr -$pm * $size] $xang $xan2
      }
    }
  }
}
close $f