外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
: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-%d 中心を指示してください
REM #2%d 中心線上の外周点を指示してください
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 rot(x, y, d)
rot = Array(x * cos(d) - y * sin(d), x * sin(d) + y * cos(d))
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 ptdist(x, y)
if typename(x) = "Integer" then
ptdist = hypot(y(0), y(1))
exit function
end if
if typename(y) = "Integer" then
ptdist = hypot(x(0), x(1))
exit function
end if
if typename(x) = "String" then x = Split(Trim(x))
if typename(y) = "String" then y = Split(Trim(y))
ptdist = hypot(y(0) - x(0), y(1) - x(1))
end function
function ptslope(x, y)
if typename(x) = "Integer" then
ptslope = atan2(y(1), y(0))
exit function
end if
if typename(y) = "Integer" then
ptslope = atan2(-x(1), -x(0))
exit function
end if
if typename(x) = "String" then x = Split(Trim(x))
if typename(y) = "String" then y = Split(Trim(y))
ptslope = atan2(y(1) - x(1), y(0) - x(0))
end function
function fff(a, p)
fff = a * cos(p) * sqr(1.0 - 0.5 * sin(p) ^ 2)
end function
function ggg(a, p)
ggg = a * sin(p) * cos(p) / sqr(2.0)
end function
sub hhh(n, p1, p2)
Dim d, a, p, i, pa, pb
d = ptslope(p1, p2)
a = ptdist(p1, p2)
p = 2 * PI / n
pa = moveto(p1, rot(fff(a, 0), ggg(a, 0), d))
i = 1
while i < n + 1
pb = moveto(p1, rot(fff(a, i * p), ggg(a, i * p), d))
WScript.Echo Join(pa) & " " & Join(pb)
pa = pb
i = i + 1
wend
end sub
Dim line, F
Dim p1, p2
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),F(2))
if reTest("^hp2",line) then p2 = Array(F(1),F(2))
Loop
End With
End With
call hhh(100, p1, p2)
