外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
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 #1ci 円・円弧を指示してください。
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 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 hypot(x, y)
hypot = sqr(x * x + y * y)
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 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 ci_hpends(c, p) '指示点近傍の円弧の端点の判別値を返す
if typename(c) = "String" then c = Split(Trim(c))
if typename(p) = "String" then p = Split(Trim(p))
Dim pt, pt1, pt2, l1, l2
pt = cipoint(c,-1)
pt1 = pt(0)
pt = cipoint(c, 1)
pt2 = pt(0)
l1 = ptdist(p, pt1)
l2 = ptdist(p, pt2)
if l1 < l2 then
ci_hpends =-1
else
ci_hpends = 1
end if
end function
function cipoint(c, pm)
Dim x, y, r, p1, p2, w, d, i
if typename(c) = "String" then c = Split(Trim(c))
i = 0
if typename(c(0)) = "String" then
if c(0) = "ci" then i = 1
end if
x = c(0+i)*1.0
y = c(1+i)*1.0
if pm = 0 or pm = "" or typename(pm) = "Empty" then
cipoint = Array(x, y)
exit function
end if
r = c(2+i)*1.0
if UBound(c) > 2+i then
p1 = c(3+i)*1.0
p2 = c(4+i)*1.0
w = c(5+i)*1.0
d = c(6+i) * PI / 180
else
p1 = 0
p2 = 360
w = 1
d = 0
end if
Dim co, si, q, xr, yr, a
co = cos(d)
si = sin(d)
if pm = -1 then q = p1 else q = p2
q = q * PI / 180.0
xr = r * cos(q)
yr = r * sin(q) * w
a = atan2(yr / w, xr * w) + d
cipoint = Array(Array(x + xr * co - yr * si, y + xr * si + yr * co), a)
end function
function arrow(pt1, d, size, xang, xan2)
Dim l, a, pt2, pt4, c, pt3
l = size
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, ci1
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("^ci",line) then ci1 = F '指示円
Loop
End With
End With
Dim pm, p, pt, a, d, size, xang, xan2
pm = ci_hpends(ci1, p1)
p = cipoint(ci1, pm)
pt = p(0): a = p(1)
d = deg(a) + 90
size = 5 '矢印の長さ( 図寸 )
xang = 45 '矢印の交角( ﾟ )
xan2 = 135 '矢尻の交角( ﾟ )
WScript.Echo "bz"
WScript.Echo arrow(pt, d, -size * pm, xang, xan2)
