昨日紹介しました幾何学図形をExcelへ移植してみました。
http://meria21.hamazo.tv/e7634298.html
以下Excel VBA ソースです。
Make_XY で多角形の座標をセルに挿入します。（この場合 N=40 つまり４０角形です。）
次にDrawPolylineで各頂点を作画します。
Option Explicit
Option Base 1
Sub DrawPolyline()
Dim C As Variant
Dim f As Double
Dim N As Integer
Dim m As Integer
Dim i As Integer
Dim j As Integer
Dim i1 As Integer
' セルの読み込み
N = Selection.Rows.Count
m = Selection.Columns.Count
If (N < 2 Or m <> 2) Then
MsgBox ("座標リストには2行以上×2列(x,y)の矩形領域を選択してください")
Exit Sub
End If
C = Selection.Value
' 単位換算（セル入力値[mm] -> 内部処理[pt]）
f = 72 / 25.4 ' 1pt=1/72in, 1in=25.4mm
For i = 1 To N
C(i, 1) = C(i, 1) * f
C(i, 2) = C(i, 2) * f
Next i
' ポリライン（フリーフォーム）の作成
For i = 1 To N
i1 = i + 1
For j = i1 To N
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, C(i, 1), C(i, 2))
.AddNodes msoSegmentLine, msoEditingAuto, C(j, 1), C(j, 2)
.ConvertToShape.Select
End With
Next j
Next i
End Sub
Sub Make_XY()
'N角形の座標を作成する
Dim R As Double '半径
Dim N As Long '頂点数
Dim PI As Double 'π
'---------- 定数 ----------
R = 100
N = 40
PI = 3.14159265358979
'
Dim angT As Double
angT = 2 * PI / N
Debug.Print angT
Dim ang As Double
ang = 0
'
Dim i As Long
Dim X As Double
Dim Y As Double
'
For i = 1 To N
X = R + R * Cos(ang)
Y = R + R * Sin(ang)
Debug.Print i, X, Y, ang, Cos(ang)
Cells(i, 1) = X
Cells(i, 2) = Y
ang = ang + angT
Next i
End Sub
http://meria21.hamazo.tv/e7634298.html
以下Excel VBA ソースです。
Make_XY で多角形の座標をセルに挿入します。（この場合 N=40 つまり４０角形です。）
次にDrawPolylineで各頂点を作画します。
Option Explicit
Option Base 1
Sub DrawPolyline()
Dim C As Variant
Dim f As Double
Dim N As Integer
Dim m As Integer
Dim i As Integer
Dim j As Integer
Dim i1 As Integer
' セルの読み込み
N = Selection.Rows.Count
m = Selection.Columns.Count
If (N < 2 Or m <> 2) Then
MsgBox ("座標リストには2行以上×2列(x,y)の矩形領域を選択してください")
Exit Sub
End If
C = Selection.Value
' 単位換算（セル入力値[mm] -> 内部処理[pt]）
f = 72 / 25.4 ' 1pt=1/72in, 1in=25.4mm
For i = 1 To N
C(i, 1) = C(i, 1) * f
C(i, 2) = C(i, 2) * f
Next i
' ポリライン（フリーフォーム）の作成
For i = 1 To N
i1 = i + 1
For j = i1 To N
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, C(i, 1), C(i, 2))
.AddNodes msoSegmentLine, msoEditingAuto, C(j, 1), C(j, 2)
.ConvertToShape.Select
End With
Next j
Next i
End Sub
Sub Make_XY()
'N角形の座標を作成する
Dim R As Double '半径
Dim N As Long '頂点数
Dim PI As Double 'π
'---------- 定数 ----------
R = 100
N = 40
PI = 3.14159265358979
'
Dim angT As Double
angT = 2 * PI / N
Debug.Print angT
Dim ang As Double
ang = 0
'
Dim i As Long
Dim X As Double
Dim Y As Double
'
For i = 1 To N
X = R + R * Cos(ang)
Y = R + R * Sin(ang)
Debug.Print i, X, Y, ang, Cos(ang)
Cells(i, 1) = X
Cells(i, 2) = Y
ang = ang + angT
Next i
End Sub
コメント