Embedded Files
リサージュ波形です。
f1=5Hz の場合が上図（セルの値を変えて実行すると別の絵に）
f2=6Hz の場合が上図（セルの値を変えて実行すると別の絵に）
w1=2・π・f1
w2=2・π・f2
X=cos(W1・ｔ）
Y=sin(W2・ｔ）
Excel macro Lissajous_figure()
Sub lissajous()
Dim x(5001) As Double
Dim y(5001) As Double
Set RngStart = Worksheets("Sheet1").Range("B30")
xs = RngStart.Left
ys = RngStart.Top
Set RngEnd = Worksheets("Sheet1").Range("D4")
ye = RngEnd.Top
xe = xs + (ys - ye)
pai = 3.14159265
dp = 13# * pai / 5000#
[A1].Select
f1 = ActiveCell.Offset(1, 1)
f2 = ActiveCell.Offset(2, 1)
w1 = 2# * pai * f1
w2 = 2# * pai * f2
dw1 = w1 / 5000#
dw2 = w2 / 5000#
For i = 1 To 5000
x(i) = Cos(dw1 * i)
y(i) = Sin(dw2 * i)
Next i
xmax = -100000#
ymax = -100000#
xmin = 100000#
ymin = 100000#
For i = 1 To 5000
If (x(i) > xmax) Then
xmax = x(i)
Else
End If
If (x(i) < xmin) Then
xmin = x(i)
Else
End If
If (y(i) > ymax) Then
ymax = y(i)
Else
End If
If (y(i) < ymin) Then
ymin = y(i)
Else
End If
Next i
If (xmax > ymax) Then
ymax = xmax
Else
xmax = ymax
End If
If (xmin < ymin) Then
ymin = xmin
Else
xmin = ymin
End If
dx = (xe - xs) / (xmax - xmin)
dy = (ye - ys) / (ymax - ymin)
xg = (xe - xs) * (-xmin / (xmax - xmin)) + xs
yg = (ye - ys) * (-ymin / (ymax - ymin)) + ys
For i = 1 To 4999
x1 = x(i) * dx + xg
y1 = y(i) * dy + yg
x2 = x(i + 1) * dx + xg
y2 = y(i + 1) * dy + yg
ActiveSheet.Shapes.AddLine x1, y1, x2, y2
Next i
End Sub
Page updated
Google Sites
Report abuse