外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
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 #1%dln 線を指示してください
REM #2%dln 線を指示してください
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 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 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 ln_hpdist(x, p)
if typename(x) = "String" then x = Split(Trim(x))
if typename(p) = "String" then p = Split(Trim(p))
ln_hpdist = lnlength(Array(p(0), p(1), x(0), x(1))) * sin(lnslope(x) - lnslope(Array(p(0), p(1), x(0), x(1))))
end function
function ln_hpsnap(x, p) '線の吸着点を返す
if typename(x) = "String" then x = Split(Trim(x))
if typename(p) = "String" then p = Split(Trim(p))
Dim t, d
t = ln_hpdist(x, p)
d = lnslope(x)
ln_hpsnap = Array(p(0) + t * sin(d), p(1) - t * cos(d))
end function
function inters(ln1, ln2) '線と線の交点
Dim m1, m2, u1, u2
if typename(ln1) = "String" then ln1 = Split(Trim(ln1))
if typename(ln2) = "String" then ln2 = Split(Trim(ln2))
if ln1(2) = ln1(0) then m1 = 1e20 else m1 = (ln1(3) - ln1(1)) / (ln1(2) - ln1(0))
if ln2(2) = ln2(0) then m2 = 1e20 else m2 = (ln2(3) - ln2(1)) / (ln2(2) - ln2(0))
if m1 <> m2 then
u1 = ln1(1) - m1 * ln1(0)
u2 = ln2(1) - m2 * ln2(0)
inters = Array( (u2 - u1) / (m1 - m2), (m1 * u2 - m2 * u1) / (m1 - m2))
else
WScript.Echo "he処理できません"
WScript.Quit
end if
end function
Dim line, F
Dim p1, p2, hk
Dim ln(10), i, j
i = 1
With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile("myfiles")
Do While Not .AtEndOfStream
line = .ReadLine: F = reSplit(line)
if reTest("^hk",line) then hk = Cdbl(F(1))
if reTest("^hp1",line) then p1 = Array(Cdbl(F(1)),Cdbl(F(2)))
if reTest("^hp2",line) then p2 = Array(Cdbl(F(1)),Cdbl(F(2)))
if reTest("^[ ]",line) then '指示線
ln(i) = F
for j = 0 to 3: ln(i)(j) = Cdbl(ln(i)(j)): next
i = i + 1
end if
Loop
End With
End With
Dim pc, d1, d2, xang, d
pc = inters(ln(1), ln(2))
if UBound(pc) = 1 then
d = hk * PI / 180
p1 = ln_hpsnap(ln(1), p1)
p2 = ln_hpsnap(ln(2), p2)
d1 = lnslope(Array(pc(0),pc(1),p1(0),p1(1))) - d
d2 = lnslope(Array(pc(0),pc(1),p2(0),p2(1))) - d
xang = (d2 - d1) * 180 / PI
else
xang = 0
end if
if sgn(xang - 180) = 1 then xang = xang - 360
if sgn(xang + 180) = -1 then xang = xang + 360
WScript.Echo "h#２線の交角 = ∠" & FormatNumber(xang, 6, 0,0,0) & _
"ﾟ : d1 =" & FormatNumber(d1 * 180 / PI, 6, 0,0,0) & _
"ﾟ : d2 =" & FormatNumber(d2 * 180 / PI, 6, 0,0,0)
