外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
vbscriptで線の端点に矢印を描く
:vbscriptで線の端点に矢印を描く
@echo off
if not exist %~dp0eval.vbs echo ExecuteGlobal WScript.StdIn.ReadAll > %~dp0eval.vbs
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
copy jwc_temp.txt myfiles > nul
(
: echo Option Explicit
echo On Error Resume Next
: echo On Error GoTo 0
more +%%n %0
) | cscript //nologo %~dp0eval.vbs > jwc_temp.txt
)
goto:eof
REM #jww
REM #1ln 線を指示してください
REM #bz
REM #e
#!この次の行からプログラムを書いてください
'1)正規表現
Dim re
Set re = New RegExp
re.IgnoreCase = True '大文字と小文字を区別しない
re.Global = True '文字列全体を検索する
function reSplit(str)
re.Pattern = "[ ]+"
reSplit = Split(Trim(re.Replace(str," ")))
end function
function reTest(pat, str)
re.Pattern = pat
reTest = re.Test(str)
end function
'2)円周率
Const PI = 3.141592653589793
'4)ユーザ定義関数
function deg(x)
deg = x / PI * 180
end function
function hypot(x, y)
hypot = sqr(x * x + y * y)
end function
function atan2(y, x)
if x = 0 then
atan2 = atn(1) * 2 * sgn(y)
else
atan2 = atn(y / x)
end if
if x < 0 then
if y < 0 then
atan2 = atan2 - atn(1) * 4
else
atan2 = atan2 + atn(1) * 4
end if
end if
end function
function polar(r, d, w) '方向余弦のセット
if w = NULL or w = "" or typename(w) = "Empty" then w = 1
polar = Array(r * cos(d), r * sin(d) * w)
end function
function moveto(x, y) '点 x を 相対距離 y [a, b] へ移動
if typename(x) = "String" then x = Split(Trim(x))
if typename(y) = "String" then y = Split(Trim(y))
moveto = Array(x(0) + y(0), x(1) + y(1))
end function
function polarto(x, r, d, w)
if typename(x) = "String" then x = Split(Trim(x))
if w = NULL or w = "" or typename(w) = "Empty" then w = 1
polarto = moveto(x, polar(r, d, w))
end function
function lnlength(x) '線長
if typename(x) = "String" then x = Split(Trim(x))
lnlength = hypot(x(2) - x(0), x(3) - x(1))
end function
function lnslope(x) '線角
if typename(x) = "String" then x = Split(Trim(x))
lnslope = atan2(x(3) - x(1), x(2) - x(0))
end function
function lnpoint(x, pm) '線データの値を返す
if typename(x) = "String" then x = Split(Trim(x))
'始点 pm=-1, 終点 pm=1 の座標を返す
if pm = 0 then
lnpoint = Array( (x(0) + x(2)) / 2, (x(1) + x(3)) / 2)
else
if pm < 0 then
lnpoint = Array(x(0), x(1))
else
lnpoint = Array(x(2), x(3))
end if
end if
end function
function ln_hpends(x, p)
if typename(x) = "String" then x = Split(Trim(x))
if typename(p) = "String" then p = Split(Trim(p))
if lnlength(Array(p(0),p(1),x(0),x(1))) < lnlength(Array(p(0),p(1),x(2),x(3))) then
ln_hpends = -1
else
ln_hpends = 1
end if
end function
function arrow(pt1, d, size, xang, xan2)
Dim l, a, pt2, pt4, c, pt3
l = size*1.0
d = d * PI / 180
a = xang * PI / 180 / 2.0
pt2 = polarto(pt1, l, d - a, 1)
pt4 = polarto(pt1, l, d + a, 1)
if xan2 = 180 then
arrow = "sl " & Join(pt1) & " " & Join(pt2) & " " & Join(pt4)
else
c = cos(a) - sin(a) * tan( (90.0 - xan2 / 2.0) * PI / 180)
pt3 = polarto(pt1, l * c, d, 1)
arrow = "sl " & Join(pt1) & " " & Join(pt2) & " " & Join(pt3) & " " & Join(pt4)
end if
end function
Dim line, F
Dim p1, ln1
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile("myfiles")
Do While Not .AtEndOfStream
line = .ReadLine: F = reSplit(line)
if reTest("^hp1",line) then p1 = Array(F(1)*1.0,F(2)*1.0)
if reTest("^[ ]",line) then ln1 = F '指示線
Loop
End With
End With
Dim pt, px, d, size, xang, xan2
pt = lnpoint(ln1, ln_hpends(ln1, p1))
px = lnpoint(ln1,-ln_hpends(ln1, p1))
d = deg(lnslope(Array(pt(0),pt(1),px(0),px(1))))
size = 5 '矢印の長さ( 図寸 )
xang = 45 '矢印の交角( ﾟ )
xan2 = 135 '矢尻の交角( ﾟ )
WScript.Echo "bz"
WScript.Echo arrow(pt, d, size, xang, xan2)
