jw_cad 外部変形 - (1407) vbscriptで階段を割り付ける -

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

 

vbscriptで階段を割り付ける

:vbscriptで階段を割り付ける
@echo off
set n=%1
if defined n (
  echo ^%1> %~dpn0.txt
) else (
  if exist %~dpn0.txt (
    for /f "tokens=*" %%a in (%~dpn0.txt) do set n=%%a
  )
)
if not defined n set n=12

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 #c 段数 = 
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

'3)環境変数
Dim Env
Set Env = CreateObject("WScript.Shell").Environment("Process")

'4)ユーザ定義関数
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 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 ptspan(x, y, d)
  if typename(x) = "String" then x = Split(Trim(x))
  if typename(y) = "String" then y = Split(Trim(y))
  if d = "" or typename(d) = "Empty" then d = 0
  ptspan = Array( (y(0) - x(0)) * cos(d) + (y(1) - x(1)) * sin(d), (y(1) - x(1)) * cos(d) - (y(0) - x(0)) * sin(d))
end function

Dim line, F
Dim hk, p1, p2
With CreateObject("Scripting.FileSystemObject")
  With .OpenTextFile("myfiles")
  Do While Not .AtEndOfStream
    line = .ReadLine: F = reSplit(line)
    if reTest("^hk",line) then hk = F(1)
    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

Dim n, p, a, b, r, d, i
if Cint(Env("n")) < 1.1 then n = 12 else n = Cint(Env("n"))
p = ptspan(p1, p2, hk * PI / 180)
a = p(1) / n: if n = 1 then b = p(0) else b = p(0) / (n - 1)
r = ptdist(0, p1)
d = ptslope(0, p1) * 180 / PI
WScript.Echo "K1"
WScript.Echo Join(Array(d, r))
for i = 1 to n
  WScript.Echo Join(Array(90 + hk, a))
  WScript.Echo Join(Array(hk, b))
next