jw_cad 外部変形 - (527) vbscriptで点を打つ -

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

 

vbscriptで(線の両端に)点を打つ

:vbscriptで点を打つ
@echo off
set src=\jww\Lite\pro\jw2.vbs
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
    type %src%
    more +%%n %0
  ) | cscript //nologo %~dp0eval.vbs %* > jwc_temp.txt
)
goto:eof

REM #jww
REM #1ln 基準線を指示してください
REM #e

#!この次の行からプログラムを書いてください
Dim hs(15), plg, lg
lg = ""
With CreateObject("Scripting.FileSystemObject")
  With .OpenTextFile("myfiles")
  Do While Not .AtEndOfStream
    line = .ReadLine: F = reSplit(line)
    if reTest("^hs",line) then 'hs スケール
      for i = 1 to 16
        hs(i-1) = F(i)
      next
    end if
    if reTest("^lg[A-F0-9]",line) then 'lg レイヤグループ
      plg = LCase(Mid(line,3,1)): if lg = "" then lg = plg
    end if
    if reTest("^[ ]",line) then 'ln 指示線
      p = hs(dec(lg)) / hs(dec(plg))
      x1 = F(0) * p: y1 = F(1) * p
      x2 = F(2) * p: y2 = F(3) * p
    end if
  Loop
  End With
End With
WScript.Echo "pt " & x1 & " " & y1
WScript.Echo "pt " & x2 & " " & y2

 

○jw2.vbs

'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 dec(x)
  if x = "a" then x = 10
  if x = "b" then x = 11
  if x = "c" then x = 12
  if x = "d" then x = 13
  if x = "e" then x = 14
  if x = "f" then x = 15
  dec = x
end function

function deg(x)
  deg = x / PI * 180
end function

function rad(x)
  rad = x / 180 * PI
end function

function hypot(x, y)
  hypot = sqr(x * x + y * y)
end function

function sqrt(x)
  sqrt = sqr(x)
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