Здравствуйте люди. Появился вопрос, связанный с диаграммой.
Каждую секунду в ячейке A3 - меняется число. В таблице C6:D26 - записаны координаты точек диаграмме.
Как заставить точки на диаграмме - двигаться по случайным векторам, отражаясь от стенок ? Событие - изменение числа в ячейке A3 (наверное это событие - Пересчет листа, с выполнением макроса только если изменилось число в ячейке А3).
То есть по сути это имитация броуновского движения. Видимо макрос должен как-то менять координаты, записанные в таблице. Но как это сделать макросом - непонятно.
Димитрий2 написал: То есть по сути это имитация броуновского движения.
с тем серьезным исключением, что нет столкновения между собой, да и скорость не описана. так как его нет, и отталкиваемся от прямоугольных стенок, то движение всегда по прямоугольнику ромбу скорее, частным случаем которого является горизонталь и вертикаль. при первом расчете надо случайным образом определить угол вектора движения и если нужно, то скорость каждой точки. Далее все просто , делаем шаг, с проверкой не пересекли ли границу, если пересекли то рассчитать траекторию отражения, а это просто, и найти точку исходя из дистанции. Тригонометрия в помощь.
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
With Application.Workbooks("1.xls").Sheets("Лист3")
On Error Resume Next
.[A1] = .[A1] + 1
runDotMovementStep
...
Код
' Массив с данными по точкам (x(range),y(range),угол, скорость движения)
Public dotsCoordsArr()
' Точки считаны
Public dotsValuesAreSetBool As Boolean
' Считываем текущие координаты точек, устанавливаем угол направления и скорость движения
Sub dotsInitialise()
Dim coordsRn As Range
Set coordsRn = ThisWorkbook.Sheets("Лист3").Range("C6:D26")
' dotsCoordsArr(i) = (i_xRn,i_yRn,i_curAngle, i_curSpeed)
If dotsValuesAreSetBool = False Then
' Определяем границы массива
ReDim dotsCoordsArr(0 To coordsRn.Rows.Count - 1, 0 To 3)
' Пробегаемся по всем строкам с данными о точках
For i = 0 To coordsRn.Rows.Count
With coordsRn.Rows(i + 1)
' Записываем данные в массив если значение - не пустое
If Not (IsEmpty(.Cells(1).Value)) And Not (IsEmpty(.Cells(2).Value)) Then
' i_xRn
Set dotsCoordsArr(i, 0) = .Cells(1)
' i_yRn
Set dotsCoordsArr(i, 1) = .Cells(2)
' Угол - случайное значение в интервале от -180 до 180
dotsCoordsArr(i, 2) = Application.RandBetween(-180, 180)
' Скорость движения - случайное значение в интервале от 5 до 15
dotsCoordsArr(i, 3) = Application.RandBetween(5, 15)
End If
End With
Next i
' Значения считанын
dotsValuesAreSetBool = True
End If
End Sub
Sub runDotMovementStep()
' Первый запуск - заносим в массив информацию о точках и присваиваем направление со скоростью
If dotsValuesAreSetBool = False Then dotsInitialise
' Пробегаемся по массиву данных
For i = LBound(dotsCoordsArr, 1) To UBound(dotsCoordsArr, 1)
' Если X и Y - не пустые - расчитываем движение точки
If _
Not IsEmpty(dotsCoordsArr(i, 0)) And _
Not IsEmpty(dotsCoordsArr(i, 1)) _
Then
' Запускаем расчет (x,y,angle, speed)
newCoordsArr = evaluateDotMove( _
CInt(dotsCoordsArr(i, 0).Value), _
CInt(dotsCoordsArr(i, 1).Value), _
CInt(dotsCoordsArr(i, 2)), _
CInt(dotsCoordsArr(i, 3)) _
)
' Записываем координаты, обновляем данные об угле и скорости(не реализовано изменение)
dotsCoordsArr(i, 0).Value = newCoordsArr(0)
dotsCoordsArr(i, 1).Value = newCoordsArr(1)
dotsCoordsArr(i, 2) = newCoordsArr(2)
dotsCoordsArr(i, 3) = newCoordsArr(3)
End If
Next i
End Sub
' Расчет движения точки
Function evaluateDotMove( _
x As Integer, _
y As Integer, _
angle As Integer, _
speed As Integer, _
Optional minX As Integer = 0, _
Optional minY As Integer = 0, _
Optional maxX As Integer = 100, _
Optional maxY As Integer = 100 _
) As Variant
newAngle = angle
' Координаты по X и Y
newX = x + CInt((speed * Cos(angle / (180 / Application.Pi()))))
newY = y + CInt((speed * Sin(angle / (180 / Application.Pi()))))
' Если выходим за допустимые диапазоны - расчитаем положение и угол отражения
If newX > maxX Then
newX = maxX - (newX - maxX)
newAngle = angleReflect(angle, 90)
ElseIf newX < minX Then
newAngle = angleReflect(angle, 270)
newX = newX * -1
End If
If newY > maxY Then
newY = maxY - (newY - maxY)
newAngle = angleReflect(angle, 180)
ElseIf newY < minY Then
newY = newY * -1
newAngle = angleReflect(angle, 0)
End If
' Запишем данные в возвращаемый массив
ReDim dotMoveArr(0 To 3)
dotMoveArr(0) = newX
dotMoveArr(1) = newY
dotMoveArr(2) = newAngle
dotMoveArr(3) = speed
evaluateDotMove = dotMoveArr
End Function
' http://qaru.site/questions/14049611/calculate-angle-change-after-hitting-a-tilted-wall
Function angleReflect(incidenceAngle, surfaceAngle) As Integer
a = surfaceAngle * 2 - incidenceAngle
If a >= 360 Then
angleReflect = a - 360
ElseIf a < 0 Then
angleReflect = a + 360
Else
angleReflect = a
End If
End Function
' Скорость движения - случайное значение в интервале от 5 до 15
dotsCoordsArr(i, 3) = 2 ' Фиксированная скорость 2 - как пример
'dotsCoordsArr(i, 3) = Application.RandBetween(5, 15)
tolstak, спасибо. А вот скажите - я добавил аналогичный код - для горизонтального движения оранжевых маркеров.
Но получается, что когда эти оранжевые маркеры достигают границы диаграммы - они просто исчезают, а не отражаются в обратную сторону. Как это поправить ?
Димитрий2, не знаю почему, но когда я меняю вызов evaluateDotMove2 на evaluateDotMove, все работает как надо... Проверил тексты, вроде бы правильно везде добавлены двойки, но почему-то не работает... В целом, идея функций - вынесение одинакового расчета в отдельный блок, и вызов его по необходимости. Т.к evaluateDotMove зависит исключительно от переданных параметров, достаточно вызывать только эту функцию, а evaluateDotMove2 и angleReflect2 не нужны.