jw_cad 外部変形 - (1386) vbscriptで多角形の面積を計算する -

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

 

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-%d 点を指示してください
REM #99#%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

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

Dim line, F
Dim hp(100), hpn
With CreateObject("Scripting.FileSystemObject")
  With .OpenTextFile("myfiles")
  Do While Not .AtEndOfStream
    line = .ReadLine: F = reSplit(line)
    if reTest("^hp([1-9][0-9]?)-?",line) then '指示点の座標値
      hp(re.Replace(F(0),"$1")*1) = Array(F(1)*1.0, F(2)*1.0)
      hpn = hpn + 1
    end if
  Loop
  End With
End With

Dim a, ax, sx, sy, ix, iy, ixy, gx, gy, lr, alpha
Dim u, v, x1, y1, x2, y2
if hp(1)(0) = hp(hpn)(0) and hp(1)(1) = hp(hpn)(1) then
else
  hpn = hpn + 1
  hp(hpn) = hp(1)
end if
x1 = hp(1)(0)*1.0
y1 = hp(1)(1)*1.0
ax = 0: sx = 0: sy = 0: ix = 0: iy = 0: ixy = 0: lr = 0
xmin =  10.0 ^ 10: xmax = -10.0 ^ 10
ymin =  10.0 ^ 10: ymax = -10.0 ^ 10
for i = 2 to hpn
  x2 = hp(i)(0)*1.0
  y2 = hp(i)(1)*1.0
  a = (x1 * y2 - x2 * y1) / 2.0 '左回りが正
  u = x1 + x2
  v = y1 + y2
  ax = ax + a '断面積
  sx = sx + a * u / 3.0
  sy = sy + a * v / 3.0 '1次モーメント
  ix = ix + a * (u * u - x1 * x2) / 6.0
  iy = iy + a * (v * v - y1 * y2) / 6.0 '2次モーメント
  ixy = ixy + a * (u * v + x1 * y1 + x2 * y2) / 12.0 '相乗モーメント
  lr = lr + hypot(x2 - x1, y2 - y1) '周長
  if xmin > x1 then xmin = x1
  if xmax < x1 then xmax = x1
  if ymin > y1 then ymin = y1
  if ymax < y1 then ymax = y1
  x1 = x2
  y1 = y2
next
gx = sx / ax '原点から図心までのX軸方向の距離
gy = sy / ax '原点から図心までのY軸方向の距離
ix = ix - ax * gx * gx '図心まわりの2次モーメント(Y軸) Iy-y
iy = iy - ax * gy * gy '図心まわりの2次モーメント(X軸) Ix-x
ixy = ixy - ax * gx * gy '図心まわりの相乗モーメント
xmin = abs(gx - xmin)
xmax = abs(gx - xmax) '図心からX軸方向の両側の最縁端距離
ymin = abs(gy - ymin)
ymax = abs(gy - ymax) '図心からY軸方向の両側の最縁端距離
alpha = atan2(2.0 * ixy, ix - iy) / 2.0 * 180.0 / PI '主軸の傾き
WScript.Echo "h#Area = " & FormatNumber(ax, 1, 0,0,0) & " Iy = " & FormatNumber(ix, 1, 0,0,0) & " Ix = " & FormatNumber(iy, 1, 0,0,0)