The missing post from yesterday’s list was: Drawing in Excel – 2 , with download file:
http://www.interactiveds.com.au/software/animate.zip
Other animation related posts include:
By Jingo
Dancing Pendulums
Yet more pendulums
Rotating Hypercubes
Animated Pythagoras
Nice illustrative post about application of momentum conservation (Newton’s 2nd law). It would be nice to have it generalized to any number of objects, like a molecular dynamics system.
So, reworking a bit your code, Sub Animate, I get something that would look like Sub AnimateGeneralized (it’s yet not finished, … not fully solved registration and storage of multiple collisions, but not far from it’s final stage. It requires only a blank worksheet, beacuse of rnd generation of objects):
Option Explicit
Const Pi As Double = 3.14159265358979
Private Type tXYZ
X As Double
Y As Double
Z As Double
End Type
Private Type tCollision
Shp1 As Long
Shp2 As Long
Time As Double
End Type
Public Sub Animate()
Dim oShpFrm As Excel.Shape
Dim lgShp As Long
Dim lgShpEval As Long
Dim oShp1 As Excel.Shape
Dim oShp2 As Excel.Shape
Dim Ovl1R As Single
Dim Ovl2R As Single
Dim CCDist As Single
Dim TopBox As Single
Dim BottBox As Single
Dim LeftBox As Single
Dim RightBox As Single
Dim CenterShp1 As tXYZ
Dim CenterShp2 As tXYZ
Dim DimShp1 As tXYZ
Dim DimShp2 As tXYZ
Dim vectorShp1 As tXYZ
Dim vectorShp2 As tXYZ
Dim Velocity As tXYZ
Dim CCAng As Single
Dim Shp2_Speed As Single
Dim Shp1_Speed As Single
Dim Angle_Shp2 As Single
Dim Angle_Shp1 As Single
Dim DX As Single
Dim DY As Single
Dim Start As Single
Dim TimeStep As Double
Dim TimeEval As Double
Dim TimeCollision As Double
With ActiveSheet
For Each oShpFrm In .Shapes
oShpFrm.Delete
Next oShpFrm
Velocity.X = 10 ‘.Range(“Hspeed”).Value
Velocity.Y = 10 ‘.Range(“Vspeed”).Value
TimeStep = 0.01
‘ Get frame limits
Set oShpFrm = .Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=20, _
Top:=20, _
Width:=400, _
Height:=400)
‘oShpFrm.Name = “Frame”
With oShpFrm
TopBox = .Top
BottBox = TopBox + .Height
LeftBox = .Left
RightBox = LeftBox + .Width
End With
‘Random shape creation and speed vector assignment
DimShp1.X = (50 * Rnd())
DimShp1.Y = DimShp1.X ‘(50 * Rnd())
CenterShp1.X = LeftBox + ((RightBox – LeftBox – DimShp1.X) * Rnd())
CenterShp1.Y = TopBox + ((BottBox – TopBox – DimShp1.Y) * Rnd())
Set oShp1 = .Shapes.AddShape(Type:=msoShapeOval, _
Left:=CenterShp1.X, _
Top:=CenterShp1.Y, _
Width:=DimShp1.X, _
Height:=DimShp1.Y)
‘oShp1.Name = “Oval1”
With vectorShp1
.X = Velocity.X * (((RightBox – LeftBox) / 1000) * Rnd())
.Y = Velocity.Y * (((BottBox – TopBox) / 1000) * Rnd())
End With
DimShp2.X = (50 * Rnd())
DimShp2.Y = DimShp2.X ‘(50 * Rnd())
CenterShp2.X = LeftBox + ((RightBox – LeftBox – DimShp2.X) * Rnd())
CenterShp2.Y = TopBox + ((BottBox – TopBox – DimShp2.Y) * Rnd())
Set oShp2 = .Shapes.AddShape(Type:=msoShapeOval, _
Left:=CenterShp2.X, _
Top:=CenterShp2.Y, _
Width:=DimShp2.X, _
Height:=DimShp2.Y)
‘oShp1.Name = “Oval2”
With vectorShp2
.X = Velocity.X * (((RightBox – LeftBox) / 1000) * Rnd())
.Y = Velocity.Y * (((BottBox – TopBox) / 1000) * Rnd())
End With
Ovl1R = (DimShp1.X + DimShp1.Y) / 4
Ovl2R = (DimShp2.X + DimShp2.Y) / 4
‘ Random initial movements:
With vectorShp1
.X = Velocity.X * (((RightBox – LeftBox) / 1000) * Rnd())
.Y = Velocity.Y * (((BottBox – TopBox) / 1000) * Rnd())
End With
With vectorShp2
.X = Velocity.X * (((RightBox – LeftBox) / 1000) * Rnd())
.Y = Velocity.Y * (((BottBox – TopBox) / 1000) * Rnd())
End With
Do
With oShp1
.IncrementLeft vectorShp1.X
.IncrementTop vectorShp1.Y
CenterShp1.X = .Left + (DimShp1.X / 2)
CenterShp1.Y = .Top + (DimShp1.Y / 2)
End With
With vectorShp1
If (CenterShp1.X RightBox – (DimShp1.X / 2)) Then .X = -.X
If (CenterShp1.Y BottBox – (DimShp1.Y / 2)) Then .Y = -.Y
End With
With oShp2
.IncrementLeft vectorShp2.X
.IncrementTop vectorShp2.Y
CenterShp2.X = .Left + (DimShp2.X / 2)
CenterShp2.Y = .Top + (DimShp2.Y / 2)
End With
With vectorShp2
If (CenterShp2.X RightBox – (DimShp2.X / 2)) Then .X = -.X
If (CenterShp2.Y BottBox – (DimShp2.Y / 2)) Then .Y = -.Y
End With
‘Distance between shapes
DX = (CenterShp1.X – CenterShp2.X)
DY = (CenterShp1.Y – CenterShp2.Y)
CCDist = Sqr(DX ^ 2 + DY ^ 2)
If CCDist < (Ovl1R + Ovl2R) Then
If DX 0 Then CCAng = Atn(DY / DX) Else CCAng = Pi / 2
With vectorShp1
Angle_Shp1 = Atn(.Y / .X)
Shp1_Speed = Sqr(.X ^ 2 + .Y ^ 2)
End With
With vectorShp2
Angle_Shp2 = Atn(.Y / .X)
Shp2_Speed = Sqr(.X ^ 2 + .Y ^ 2)
End With
Angle_Shp1 = CCAng * 2 – Angle_Shp1
Angle_Shp2 = CCAng * 2 – Angle_Shp2
With vectorShp1
.X = -Shp1_Speed * Cos(Angle_Shp1)
.Y = Shp1_Speed * Sin(Angle_Shp1)
End With
With vectorShp2
.X = Shp2_Speed * Cos(Angle_Shp2)
.Y = -Shp2_Speed * Sin(Angle_Shp2)
End With
End If
Start = VBA.Timer()
Do While VBA.Timer() t = (X2o – X1o)/(vx1 – vx2)
‘ So, we have to find the next collision in time (searching with any next object we find):
For lgShpEval = (lgShp + 1) To UBound(oShp)
TimeEval = (CenterShp(lgShp).X – CenterShp(lgShpEval).X) _
/ (vectorShp(lgShpEval).X – vectorShp(lgShp).X)
CenterShp(lgShp).Y = CenterShp(lgShp).Y + (TimeEval * vectorShp(lgShp).Y)
CenterShp(lgShpEval).Y = CenterShp(lgShpEval).Y + (TimeEval * vectorShp(lgShpEval).Y)
If VBA.Abs(CenterShp(lgShp).Y – CenterShp(lgShpEval).Y) 0 Then ‘ negative times implies that they are getting separated
If TimeCollision > TimeEval Then
TimeCollision = TimeEval
Erase oCollision()
ReDim Preserve oCollision(g_Base)
oCollision(g_Base).Shp1 = lgShp
oCollision(g_Base).Shp2 = lgShpEval
Else ‘If TimeCollision = TimeEval Then
‘More than two objects colliding at the same moment:
TimeCollision = TimeEval
lgCollision = lgCollision + 1
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(lgCollision).Shp1 = lgShp
oCollision(lgCollision).Shp2 = lgShpEval
End If
End If
End If
Next lgShpEval
‘ Check collision against frame walls:
TimeEval = (CenterShp(lgShp).X – (LeftBox + DimShp(lgShp).X / 2)) _
/ vectorShp(lgShp).X
If TimeEval > 0 Then ‘ negative times implies that they are getting separated
If TimeCollision > TimeEval Then
TimeCollision = TimeEval
Erase oCollision()
lgCollision = g_Base
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(lgCollision).Shp1 = lgShp
oCollision(lgCollision).Shp2 = -xlEdgeLeft ‘7
ElseIf TimeCollision = TimeEval Then
TimeCollision = TimeEval
lgCollision = lgCollision + 1
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(g_Base).Shp1 = lgShp
oCollision(g_Base).Shp2 = -xlEdgeLeft ‘7
End If
End If
TimeEval = (RightBox – (DimShp(lgShp).X / 2) – CenterShp(lgShp).X) _
/ vectorShp(lgShp).X
If TimeEval > 0 Then ‘ negative times implies that they are getting separated
If TimeCollision > TimeEval Then
TimeCollision = TimeEval
Erase oCollision()
lgCollision = g_Base
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(lgCollision).Shp1 = lgShp
oCollision(lgCollision).Shp2 = -xlEdgeLeft ‘7
ElseIf TimeCollision = TimeEval Then
TimeCollision = TimeEval
lgCollision = lgCollision + 1
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(g_Base).Shp1 = lgShp
oCollision(g_Base).Shp2 = -xlEdgeRight ’10
End If
End If
TimeEval = (CenterShp(lgShp).Y – (TopBox + DimShp(lgShp).Y / 2)) _
/ vectorShp(lgShp).Y
If TimeEval > 0 Then ‘ negative times implies that they are getting separated
If TimeCollision > TimeEval Then
TimeCollision = TimeEval
Erase oCollision()
lgCollision = g_Base
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(lgCollision).Shp1 = lgShp
oCollision(lgCollision).Shp2 = -xlEdgeLeft ‘7
ElseIf TimeCollision = TimeEval Then
TimeCollision = TimeEval
lgCollision = lgCollision + 1
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(g_Base).Shp1 = lgShp
oCollision(g_Base).Shp2 = -xlEdgeTop ‘8
End If
End If
TimeEval = (BottBox – (DimShp(lgShp).X / 2) – CenterShp(lgShp).Y) _
/ vectorShp(lgShp).Y
If TimeEval > 0 Then ‘ negative times implies that they are getting separated
If TimeCollision > TimeEval Then
TimeCollision = TimeEval
Erase oCollision()
lgCollision = g_Base
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(lgCollision).Shp1 = lgShp
oCollision(lgCollision).Shp2 = -xlEdgeLeft ‘7
ElseIf TimeCollision = TimeEval Then
TimeCollision = TimeEval
lgCollision = lgCollision + 1
ReDim Preserve oCollision(g_Base To lgCollision)
oCollision(g_Base).Shp1 = lgShp
oCollision(g_Base).Shp2 = -xlEdgeBottom ‘9
End If
End If
Next lgShp
‘ No object collide with anything until TimeCollision, so:
For lgShp = LBound(oShp) To UBound(oShp)
With oShp(lgShp)
.IncrementLeft (vectorShp(lgShp).X * TimeCollision)
.IncrementTop (vectorShp(lgShp).Y * TimeCollision)
CenterShp(lgShp).X = .Left + (DimShp(lgShp).X / 2)
CenterShp(lgShp).Y = .Top + (DimShp(lgShp).Y / 2)
End With
Next lgShp
Stop
‘ First check collisions against walls
lgCounter = LBound(oCollision)
For lgCollision = LBound(oCollision) To UBound(oCollision)
If oCollision(lgCollision).Shp2 < 0 Then 'Wall collision
If oCollision(lgCollision).Shp2 = xlEdgeLeft Then
With vectorShp(oCollision(lgCollision).Shp1)
.X = -.X
End With
End If
If oCollision(lgCollision).Shp2 = xlEdgeRight Then
With vectorShp(oCollision(lgCollision).Shp1)
.X = -.X
End With
End If
If oCollision(lgCollision).Shp2 = xlEdgeBottom Then
With vectorShp(oCollision(lgCollision).Shp1)
.Y = -.Y
End With
End If
If oCollision(lgCollision).Shp2 = xlEdgeTop Then
With vectorShp(oCollision(lgCollision).Shp1)
.Y = -.Y
End With
End If
Else
lgCounter = lgCounter + 1 'Counter with other particles
ReDim Preserve PtrCollision(g_Base To lgCounter)
PtrCollision(lgCounter) = lgCollision
'If they are not repeated…
' bStack = True
' For lgPtr = LBound(PtrCollision) To UBound(PtrCollision)
' If oCollision(PtrCollision(lgPtr)).Shp1 = …lgShp1 Then
' bStack = False
' Exit For
' End If
' If oCollision(PtrCollision(lgPtr)).Shp2 = …lgShp1 Then
' bStack = False
' Exit For
' End If
' Next lgPtr
' If bStack Then
' ReDim Preserve PtrObj(g_Base To lgCounter)
' PtrObj(lgCounter) = oCollision(lgCollision).Shp1
' End If
'
' bStack = True
' For lgPtr = LBound(PtrCollision) To UBound(PtrCollision)
' If oCollision(PtrCollision(lgPtr)).Shp1 = …lgShp2 Then
' bStack = False
' Exit For
' End If
' If oCollision(PtrCollision(lgPtr)).Shp2 = …lgShp2 Then
' bStack = False
' Exit For
' End If
' Next lgPtr
' If bStack Then
' ReDim Preserve PtrObj(g_Base To lgCounter)
' PtrObj(lgCounter) = oCollision(lgCollision).Shp2
' End If
End If
Next lgCollision
Stop
' Then process collisions against other particles
If Not (Not PtrCollision()) Then
'Create XYZ systems of equations for the momentum (call Gauss-Jordan solver):
ReDim mCollision(LBound(PtrCollision) To UBound(PtrCollision), _
LBound(PtrCollision) To UBound(PtrCollision) + 1)
ReDim PtrObj(LBound(PtrCollision) To UBound(PtrCollision))
For lgCollision = LBound(PtrCollision) To UBound(PtrCollision)
Next lgCollision
' Sort elements by Id
'Call fQuickSort_ArrayLng(PtrObj())
'For X direction
For lgCollision = LBound(PtrCollision) To UBound(PtrCollision)
'…………
' mMomentum(lgCollision).X = mMomentum(lgCollision).X _
' + vectorShp(lgShp1).X * (DimShp(lgShp1).X + DimShp(lgShp1).Y) / 2 _
' + vectorShp(lgShp2).X * (DimShp(lgShp2).X + DimShp(lgShp2).Y) / 2
' mMomentum(lgCollision).Y = mMomentum(lgCollision).Y _
' + vectorShp(lgShp1).Y * (DimShp(lgShp1).Y + DimShp(lgShp1).Y) / 2 _
' + vectorShp(lgShp2).Y * (DimShp(lgShp2).Y + DimShp(lgShp2).Y) / 2
' 'Distance between shapes (lgShp1, lgShp2)
' DX = (CenterShp(lgShp1).X – CenterShp(lgShp2).X)
' DY = (CenterShp(lgShp1).Y – CenterShp(lgShp2).Y)
'
' If DX 0 Then CCAng = Atn(DY / DX) Else CCAng = Pi / 2
‘ With vectorShp(oCollision(lgCollision).Shp1)
‘ Angle_Shp1 = Atn(.Y / .X)
‘ Shp1_Speed = Sqr(.X ^ 2 + .Y ^ 2)
‘ End With
‘ With vectorShp(oCollision(lgCollision).Shp2)
‘ Angle_Shp2 = Atn(.Y / .X)
‘ Shp2_Speed = Sqr(.X ^ 2 + .Y ^ 2)
‘ End With
‘
‘ Angle_Shp1 = CCAng * 2 – Angle_Shp1
‘ Angle_Shp2 = CCAng * 2 – Angle_Shp2
‘
‘ With vectorShp(oCollision(lgCollision).Shp1)
‘ .X = -Shp1_Speed * Cos(Angle_Shp1)
‘ .Y = Shp1_Speed * Sin(Angle_Shp1)
‘ End With
‘ With vectorShp(oCollision(lgCollision).Shp2)
‘ .X = Shp2_Speed * Cos(Angle_Shp2)
‘ .Y = -Shp2_Speed * Sin(Angle_Shp2)
‘ End With
‘…………
Next lgCollision
‘Call fGaussJordan(mMomentum)
‘For Y direction…
‘…
‘For Z direction…
‘…
End If
Start = VBA.Timer()
Do While VBA.Timer() < (Start + TimeStep) 'TimeCollision
DoEvents
Loop
Loop
End With
End Sub
'Public Function fGaussJordan()
'End Function
'Public Function fQuickSort_ArrayLng()
'End Function
As I stated, is not yet finished. I have -somewhere- another code for colliding cars with no-elastic collision implementation that I'll post on my blog (by the way, I recomend to take a look it, as following posts will deal with structural calculations on Excel… following your guidances, as well as Turan Babacan's implementations on Excel and Youtuber Manos).
And finally related to this
LikeLike
The fQuickSort_ArrayLng() will be post as the code is finally finished, so here only the fGaussJordan() function:
Public Function fGaussJordan(ByRef mArray() As Double) As Double()
Dim lgR As Long
Dim lgC As Long
Dim lgPivot As Long
Dim lgR_Homogenize As Long
Dim dbTmp As Double
Dim lgRetVal As Long
Dim mArrayTmp() As Double
Dim Nm As Integer
On Error GoTo ErrControl
Nm = UBound(mArray, 1) – LBound(mArray, 1) + 1
ReDim mArrayTmp(LBound(mArray, 1) To UBound(mArray, 1), LBound(mArray, 2) To UBound(mArray, 2))
‘ Swap rows (if needed)
If (mArray(0, 0) = 0) Then
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
If (mArray(lgR, 0) 0) Then
For lgC = LBound(mArray, 2) To UBound(mArray, 2)
mArrayTmp(0, lgC) = mArray(0, lgC)
mArray(0, lgC) = mArray(lgR, lgC)
mArray(lgR, lgC) = mArrayTmp(0, lgC)
Next lgC
End If
Next lgR
End If
For lgPivot = LBound(mArray, 1) To UBound(mArray, 1)
dbTmp = mArray(lgPivot, lgPivot)
For lgC = LBound(mArray, 2) To UBound(mArray, 2)
mArray(lgPivot, lgC) = mArray(lgPivot, lgC) / dbTmp
Next lgC
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
If (lgR = lgPivot) Then GoTo NextRow
dbTmp = mArray(lgR, lgPivot)
For lgR_Homogenize = LBound(mArray, 2) To UBound(mArray, 2)
mArray(lgR, lgR_Homogenize) = mArray(lgR, lgR_Homogenize) – (dbTmp * mArray(lgPivot, lgR_Homogenize))
Next lgR_Homogenize
NextRow:
Next lgR
Next lgPivot
‘Print solution
ReDim mArrayTmp(LBound(mArray, 1) To UBound(mArray, 1))
For lgR = LBound(mArray, 1) To UBound(mArray, 1)
mArrayTmp(lgR) = mArray(lgR, Nm)
‘Debug.Print VBA.Format(mArray(lgR, Nm), “##,##0.00”)
Next lgR
fGaussJordan = mArrayTmp()
ExitProc:
Exit Function
ErrControl:
lgRetVal = VBA.MsgBox(“System has no solution”, vbCritical)
End Function
LikeLike
If you’d like to send sample worksheet and code, please send to Dougaj4 at gmail.
Thanks
LikeLike
Thanks for the code and the links. I’ll reply properly later, but it looks like the end of your message got truncated.
LikeLiked by 1 person
Doug, I have continued working with this subject (collision for a system of particles), and tried to check the moment convervation as well as the kinetic energy.
Following Wikipedia archive found two implementations for 2D collision between two particles, so I’ve included yours, and another one found in a MIT article. So I coded the function fCollision.
To run the program, simply run sCollision_2Objects (paste code in blank worksheet).
Seems no one (the formulations) is verifying the momentum conservation (but they do on the kinetic energy). I’ve done a little visual check and only the formulations for lgSelector = 2 & lgSelector = 3 seem to give good visual results. Your implementation is not considering Mass so it should be discarded… please confirm if your idea was to show the capabilities to draw not the physical properly modelation of the collision.
Anyway, I’ll go a little further to try to get it clear for myself.
Kind regards
LikeLike
Thanks for the new code. Using the format tags makes it much easier to use. I tried it pasting into a new module in my animate spreadsheet, and it seems to work OK, but stops at the first collision.
Yes, my code was more a demonstration of animation in VBA, rather than the physics, so the assumption was that the objects had the same mass, but it shouldn’t be too hard to add in the mass.
Looking at your blog, some things here that you might find interesting include:
-A VBA sort function.
-Code linking to Python, Numpy and Scipy using xlwings
-Links to the Alglib maths library
-Frame analysis routines, including linear algebra solvers in VBA, Fortran, Alglib and Python.
LikeLike
Hi Doug,
I’ve, in the past, got in touch with you, dealing with the Visualization procedures.
Your blog is incredible, and is a big reference for me, as it seems I’m always five years behind what you’re researching 🙂
One thing that I “do not enjoy” is that you have moved to Python as calculations got more complicated. For me, it has been very hard to learn Python (VBA is much more human readable i think), but it may be the direction things should go (learn Python), as Microsoft is not pushing to much in favor of VBA (VBasic6).
Kind regards.
LikeLike
Finally, the code solution for 2D collision, where Momentum conservation and Kinetic energy conservation are met. I made a mistake, probably during debugging, because lgSelector=2 and lgSelector = 3 formulations both were energy and momentum compliant. So the code amended is here (with a nice arrow to show the movement direction):
I’ll later post a solution for particles system on my blog.
Kind regards
LikeLike
Just for clarifying: some of the functions: fDotProduct, fVector², fVectorModule and the initial declarations (UDT…) should be borrowed from the previous post.
Also, I would recomend to turn off the Momentum check, because is not always “compliant”…
LikeLike