VB icon

Collision Mathematics

Email
Submitted on: 10/18/2017 8:50:28 PM
By: Nicholas Forystek  
Level: Intermediate
User Rating: Unrated
Compatibility: VB 6.0
Views: 361
author picture
 
     This is some collision routines for performing checks in a 3D world. One of the functions is 2D but can perform nicely in 3D by calling it against the X and Y axis first and then the Z and Y axis. They both (among some other more common vector functions) are testing the presence of a given point with in a dynamic of triangles of which is the input as arguments, exception of the 2D one, where I accepts a triangle list (and even may return hit information on a 100% unit whole of a long data type or if can be changed to single for precision).
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Collision Mathematics
' Description:This is some collision routines for performing checks in a 3D world. One of the functions is 2D but can perform nicely in 3D by calling it against the X and Y axis first and then the Z and Y axis. They both (among some other more common vector functions) are testing the presence of a given point with in a dynamic of triangles of which is the input as arguments, exception of the 2D one, where I accepts a triangle list (and even may return hit information on a 100% unit whole of a long data type or if can be changed to single for precision).
' By: Nicholas Forystek
'**************************************

Public Type Vector3D
 x As Single
 y As Single
 z As Single
End Type
Public Function VertexPoint_Behind_TrianglePlane_VB( _
 ByVal PointX As Single, ByVal PointY As Single, ByVal PointZ As Single, _
 ByVal Length1 As Single, ByVal Length2 As Single, ByVal Length3 As Single, _
 ByVal NormalX As Single, ByVal NormalY As Single, ByVal NormalZ As Single) _
 As Boolean
 
 Dim r1 As Vector3D
 r1.x = Sqr((((PointX + PointX + PointX) + (Length1 + Length2 + Length3)) + _
((PointX + PointY - PointZ) + (Length1 + Length1 - Length1)) * _
(NormalZ * NormalZ * NormalZ)) ^ 2)
 r1.y = Sqr((((PointY + PointY + PointY) + (Length1 + Length2 + Length3)) + _
((PointY + PointZ - PointX) + (Length2 + Length2 - Length2)) * _
(NormalX * NormalX * NormalX)) ^ 2)
 r1.z = Sqr((((PointZ + PointZ + PointZ) + (Length1 + Length2 + Length3)) + _
((PointZ + PointX - PointY) + (Length3 + Length3 - Length3)) * _
(NormalY * NormalY * NormalY)) ^ 2)
 VertexPoint_Behind_TrianglePlane_VB = (((r1.x / 100) + (r1.y / 100) - (r1.z / 100)) >= 0)
End Function
Public Function TwoDimensionPointInsideOfPointList_VB( _
 ByVal PointXCoord As Single, ByVal PointYCoord As Single, _
 PointListsX() As Single, PointListsY() As Single, _
 ByVal PointListsCount As Long) As Long
 
 Dim cnt As Long
 Dim slope1 As Single
 Dim slope2 As Single
 If (PointListsCount > 0) Then
For cnt = 0 To PointListsCount - 1
 slope1 = ((slope1 + Sqr(((PointXCoord - PointListsX(cnt)) ^ 2) + _
 ((PointYCoord - PointListsY(cnt)) ^ 2))) / 2)
 slope2 = ((slope2 + Sqr(((PointListsX(0) - PointListsX(cnt)) ^ 2) + _
 ((PointListsY(0) - PointListsY(cnt)) ^ 2))) / 2)
 If (slope1 < slope2) Then
If (slope2 <> 0) Then
 TwoDimensionPointInsideOfPointList_VB = (slope1 / slope2)
ElseIf (slope1 <> 0) Then
 TwoDimensionPointInsideOfPointList_VB = (slope2 / slope1)
End If
 End If
Next
 End If
End Function
Public Sub Main()
 'make a 8x8 sized box
 Dim PointListsX(0 To 5) As Single
 Dim PointListsY(0 To 5) As Single
 PointListsX(0) = 4: PointListsY(0) = -4
 PointListsX(1) = 4: PointListsY(1) = 4
 PointListsX(2) = -4: PointListsY(2) = 4
 PointListsX(3) = -4: PointListsY(3) = -4
 PointListsX(4) = 4: PointListsY(4) = -4
 Debug.Print "TwoDimensionPointInsideOfPointList_VB: " & _
TwoDimensionPointInsideOfPointList_VB(8, 0, PointListsX, PointListsY, 5) 'try ouside box 'returns 0
 Debug.Print "TwoDimensionPointInsideOfPointList_VB: " & _
TwoDimensionPointInsideOfPointList_VB(0, 0, PointListsX, PointListsY, 5) 'try the center 'returns 1
 Debug.Print "TwoDimensionPointInsideOfPointList_VB: " & _
TwoDimensionPointInsideOfPointList_VB(0, 0, PointListsX, PointListsY, 3) 'try less points 'returns 1
 Debug.Print "TwoDimensionPointInsideOfPointList_VB: " & _
TwoDimensionPointInsideOfPointList_VB(0, 0, PointListsX, PointListsY, 2) 'even less again 'returns 0
 Dim Lengths As Vector3D: Dim Normal As Vector3D: Dim Center As Vector3D: Dim Point As Vector3D
 Dim Vertex1 As Vector3D: Dim Vertex2 As Vector3D: Dim Vertex3 As Vector3D
 'make three vertexes of a triangle
 Vertex1.x = 20: Vertex1.y = 0: Vertex1.z = 0
 Vertex2.x = 20: Vertex2.y = 20: Vertex2.z = 0
 Vertex3.x = -20: Vertex3.y = -20: Vertex3.z = 0
 'get plane normal of a triangle
 Normal = TriangleNormal(Vertex1, Vertex2, Vertex3)
 'get the center of a triangle
 Center = TriangleCenter(Vertex1, Vertex2, Vertex3)
 
 'get lengths of triangles edges
 Lengths.x = Distance(Vertex1, Vertex2)
 Lengths.y = Distance(Vertex2, Vertex3)
 Lengths.z = Distance(Vertex3, Vertex1)
 'make up a point test scenario
 Point.x = 0: Point.y = 0: Point.z = -80
 'localize the point to the center of the triangle
 Point = VectorSubtract(Center, Point)
 Point.x = 0: Point.y = 0: Point.z = -80 'make up a point test scenario
 Point = VectorSubtract(Center, Point) 'localize the point to the center of the triangle
 Debug.Print "VertexPoint_Behind_TrianglePlane_VB: " & VertexPoint_Behind_TrianglePlane_VB( _
Point.x, Point.y, Point.z, Lengths.x, Lengths.y, Lengths.z, Normal.x, Normal.y, Normal.z) 'returns false
 Point.x = 0: Point.y = 0: Point.z = 60 'make up a point test scenario
 Point = VectorSubtract(Center, Point) 'localize the point to the center of the triangle
 Debug.Print "VertexPoint_Behind_TrianglePlane_VB: " & VertexPoint_Behind_TrianglePlane_VB( _
Point.x, Point.y, Point.z, Lengths.x, Lengths.y, Lengths.z, Normal.x, Normal.y, Normal.z) 'returns true
 Point.x = 30: Point.y = 30: Point.z = 60 'make up a point test scenario
 Point = VectorSubtract(Center, Point) 'localize the point to the center of the triangle
 Debug.Print "VertexPoint_Behind_TrianglePlane_VB: " & VertexPoint_Behind_TrianglePlane_VB( _
Point.x, Point.y, Point.z, Lengths.x, Lengths.y, Lengths.z, Normal.x, Normal.y, Normal.z) 'returns true
 Point.x = 30: Point.y = 30: Point.z = -60 'make up a point test scenario
 Point = VectorSubtract(Center, Point) 'localize the point to the center of the triangle
 Debug.Print "VertexPoint_Behind_TrianglePlane_VB: " & VertexPoint_Behind_TrianglePlane_VB( _
Point.x, Point.y, Point.z, Lengths.x, Lengths.y, Lengths.z, Normal.x, Normal.y, Normal.z) 'returns false
End Sub
Public Function Distance(ByRef p1 As Vector3D, ByRef p2 As Vector3D) As Single
 Distance = Sqr(((p1.x - p2.x) ^ 2) + ((p1.y - p2.y) ^ 2) + ((p1.z - p2.z) ^ 2))
End Function
Public Function TriangleNormal(ByRef v0 As Vector3D, ByRef v1 As Vector3D, ByRef v2 As Vector3D) As Vector3D
 TriangleNormal = VectorNormalize(VectorCrossProduct(VectorSubtract(v1, v0), VectorSubtract(v2, v0)))
End Function
Public Function DotProduct(ByRef v As Vector3D, ByRef u As Vector3D) As Single
 DotProduct = (u.x * v.x + u.y * v.y + u.z * v.z)
End Function
Public Function TriangleCenter(ByRef v0 As Vector3D, ByRef v1 As Vector3D, ByRef v2 As Vector3D) As Vector3D
 TriangleCenter.x = ((v0.x + v1.x + v2.x) / 3)
 TriangleCenter.y = ((v0.y + v1.y + v2.y) / 3)
 TriangleCenter.z = ((v0.z + v1.z + v2.z) / 3)
End Function
Public Function VectorCrossProduct(ByRef v As Vector3D, ByRef u As Vector3D) As Vector3D
 VectorCrossProduct.x = ((v.y * u.z) - (v.z * u.y))
 VectorCrossProduct.y = ((v.z * u.x) - (v.x * u.z))
 VectorCrossProduct.z = ((v.x * u.y) - (v.y * u.x))
End Function
Public Function VectorSubtract(ByRef v As Vector3D, ByRef u As Vector3D) As Vector3D
 VectorSubtract.x = (v.x - u.x)
 VectorSubtract.y = (v.y - u.y)
 VectorSubtract.z = (v.z - u.z)
End Function
Public Function VectorNormalize(ByRef v As Vector3D) As Vector3D
 Dim l As Single
 l = Sqr(((v.x * v.x) + (v.y * v.y) + (v.z * v.z)))
 If l = 0 Then l = 1
 VectorNormalize.x = (v.x / l)
 VectorNormalize.y = (v.y / l)
 VectorNormalize.z = (v.z / l)
End Function


Other 11 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.