I've drawn a line, using an X1, X2, Y1, Y2 variable. I'm looking to find any number of points along a this line, and to that extent I've written this:
Private Function genPointsArray(ByRef xPointArray() As Integer, ByRef yPointArray() As Integer, startX As Integer, finX As Integer, startY As Integer, finY As Integer, numPoints As Integer) As Integer
ReDim xPointArray(numPoints)
ReDim yPointArray(numPoints)
xPointArray(0) = startX
xPointArray(numPoints - 1) = finX
yPointArray(0) = startY
yPointArray(numPoints - 1) = finY
For i = 1 To numPoints - 2
xPointArray(i) = xPointArray(i - 1) + (finX - startX) \ numPoints
yPointArray(i) = yPointArray(i - 1) + (finY - startY) \ numPoints
Next
Return 0
End Function
As you can see, it accepts the X1, X2, Y1, Y2 variables (startX etc), two arrays to store the resultant points, and a number of points to find. The issue it has is that (worryingly often) a point is a pixel off (due to the actual result being a decimal). This then gets progressively worse as every following point is 2,3,4,5 etc pixels off, making the effect quite noticeable. Does anyone know of a way to make sure every point is along the line- either through a better algorithm or validation?
Thanks
The reason why your generated points drift is because you're allowing the error of the integer rounding to accumulate. It's like walking with your eyes closed.
Instead of basing each point from the previous, keep going back to your original endpoints. Each point that results will be off at worst one due to rounding.
Replace
xPointArray(0) = startX
xPointArray(numPoints - 1) = finX
yPointArray(0) = startY
yPointArray(numPoints - 1) = finY
For i = 1 To numPoints - 2
xPointArray(i) = xPointArray(i - 1) + (finX - startX) \ numPoints
yPointArray(i) = yPointArray(i - 1) + (finY - startY) \ numPoints
Next
With just
For i = 0 To numPoints - 1
xPointArray(i) = startX + (finX - startX) * i / numPoints
yPointArray(i) = startX + (finX - startX) * i / numPoints
Next
Please forgive any syntax or loop bound errors; I don't write VBA
In terms of geometry a line is unidimensional, i.e. it doesn't have width and hence it's hard to know if a point is on a line without defining a criterion.
A common way to test if a point resides on a line is to compute the distance from that point to the line, and if such a distance is small enough (less than an epsilon value), then the point is considered to be on the line. I don't know VB but here is snippet that illustrates this idea:
boolean inLine(Point2D a, Point2D b, Point2D p)
{
double a1 = b.x() - a.x();
double b1 = b.y() - a.y();
double a2 = p.x() - a.x();
double b2 = p.y() - a.y();
double alpha = Math.atan2(b1, a1);
double beta = Math.atan2(b2, a2);
double theta = Math.abs(alpha - beta);
double dist = Math.abs(a.distanceTo(p) * Math.sin(theta));
double eps = Math.abs(fx(3) - fx(0));
return dist < eps;
}
This algorithm is known as Distance from a Point to a Line.
The epsilon value depends on your particular problem, how much precision is needed, for most applications 1e-9 will be OK.
The method distanceTo() in the code simply computes the Euclidean distance between two points.
A foolproof formula is ((N - I) * Start + I * Fin) / N. For I=0, gives you exactly Start, and for I=N, gives you exactly Fin. Intermediate values will be regularly aligned.
This works both in integer and floating-point coordinates, but mind overflows.
Related
i am a bit new to this but I'm trying to create a randomly generated 3d coordinate points with equal spacing, I've tried using for each loop but im confused on how to use in. the purpose is to generate sphere around that point but some sphere are overlapping each other. thanks in advance. the code below is to show how I'm generating the sphere
For i = 0 To noofsp - 1
x = Rnd(1) * maxDist
ws1.Cells(i + 5, 2) = x
y = Rnd(1) * maxDist
ws1.Cells(i + 5, 3) = y
z = Rnd(1) * maxDist
ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
You'll need to check the new point against all the other points to make sure that your new point is at a greater distance that the sum of the radii of your new sphere and each sphere you're checking against
You'll need to use pythagoras' theorem to check that the distances and I found the code below from this site. The code on the site is written in c#, but here is the vb.net version.
Public Function Distance3D(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double) As Double
' __________________________________
'd = √ (x2-x1)^2 + (y2-y1)^2 + (z2-z1)^2
'
'Our end result
Dim result As Double
'Take x2-x1, then square it
Dim part1 As Double = Math.Pow((x2 - x1), 2)
'Take y2-y1, then square it
Dim part2 As Double = Math.Pow((y2 - y1), 2)
'Take z2-z1, then square it
Dim part3 As Double = Math.Pow((z2 - z1), 2)
'Add both of the parts together
Dim underRadical As Double = part1 + part2 + part3
'Get the square root of the parts
result = Math.Sqrt(underRadical)
'Return our result
Return result
End Function
To generate the spheres, you would need to expand your code to include checking the new point against all the previously generated points. That code is below with comments.
I have assumed the definition of a variable called minDistance to specify how far apart the centre of the spheres should be. I'm also assuming that all the spheres are the same size. The number should be twice the radius of the spheres
Private Sub GenerateSpheres()
Randomize
For i As Integer = 0 To noofsp - 1
Dim distanceOK As Boolean = False
Dim x, y, z As Integer
'keep generating points until one is found that is
'far enough away. When it is, add it to your data
While distanceOK = False
x = Rnd(1) * maxDist
y = Rnd(1) * maxDist
z = Rnd(1) * maxDist
'If no other points have been generated yet, don't bother
'checking your new point
If centers.Count = 0 Then
distanceOK = True
Else
'If other points exist, loop through the list and check distance
For j As Integer = 0 To centers.Count - 1
'if the point is too close to any other, stop checking,
'exit the For Loop and the While Loop will generate a new
'coordinate for checking, and so on
Dim dist As Integer = Distance3D(centers(j)(0), centers(j)(1), centers(j)(2), x, y, z)
If dist <= minDistance Then
distanceOK = False
'exit the For loop and start the next iteration of the While Loop
Continue While
End If
Next
'If all previous points have been checked none are too close
'flag distanceOK as true
distanceOK = True
End If
End While
'ws1.Cells(i + 5, 2) = x
'ws1.Cells(i + 5, 3) = y
'ws1.Cells(i + 5, 4) = z
centers.Add({x, y, z})
Next
End Sub
So I have successfully managed to rotate, move, etc with keyboard keys my camera through my environment. I do this by multiplying my view matrix by rotational matrices:
ViewMatrix = ViewMatrix X Z_Rotational_Matrix(yaw_increment) X X_Rotational_Matrix(pitch_increment) X Y_Rotational_Matrix(roll_increment)
I can do so with inputs of yaw, pitch, and roll. So I am next trying to do these rotations with the mouse. I believe I have all of the heavy lifting done and should just need to supply the yaw, and pitch to my rotational matrix. Correct me if this is the wrong thought process.
I can capture the mouse world coordinate when I click and when I move so supposedly it should just be math based on initial_mouse_click_coordinates and current_mouse_click_coordinates. My thought is to project two vectors, one from the initial_mouse_click_coordinate and the other from current_mouse_click_coordinates. Both vectors are parallel to the vector created from my camera location and my camera lookat point. Then I can calculate the XY planar angle and the XZ planar angle. Once these are determined I pass these as the yaw and pitch to my rotational matrices.
Determining two angles between my two lines:
The problem I have is that these values appear to be really small so on the screen nothing really happens. Am I going about this the wrong way completely?
If this is the right method to try, am I messing up on my math somewhere?
'we have initial_mouse_world_coordinates and mouse_world_coordinates. These are the points on the x screen in world coordinates.
'Two lines must be constructed going through these points, parallel with our lookat vector.
'The two angles between these two vectors are the angles to use on our lookat vector
'X = X0 + Rx*T
'Y = Y0 + Ry*T
'Z = Z0 + Rz*T
'therefore T = (Z-Z0)/Rz
'at Z = 0: T = -Z0/Rz
Dim t As Decimal = -initial_mouse_world_coordinates.Z / cam.lookat.Z
Dim y As Decimal = initial_mouse_world_coordinates.Y + (cam.lookat.Y * t)
Dim x As Decimal = initial_mouse_world_coordinates.X + (cam.lookat.X * t)
Dim z As Decimal = 0
'new point = x,y,z => translate to new vector
Dim startline As New Vector3(initial_mouse_world_coordinates.X - x, initial_mouse_world_coordinates.Y - y, initial_mouse_world_coordinates.Z - z)
t = -mouse_world_coordinates.Z / cam.lookat.Z
y = mouse_world_coordinates.Y + (cam.lookat.Y * t)
x = mouse_world_coordinates.X + (cam.lookat.X * t)
z = 0
Dim endline As New Vector3(mouse_world_coordinates.X - x, mouse_world_coordinates.Y - y, mouse_world_coordinates.Z - z)
'now simply find the two angles between these two lines
'cos(theida) = ((Ai,Ak) ⋅ (Bi,Bk)) / (||Ai,Ak|| * ||Bi,Bk||)
Try
theida = Acos(((startline.X * endline.X) + (startline.Z * endline.Z)) / (Sqrt(startline.X ^ 2 + startline.Z ^ 2) * Sqrt(endline.X ^ 2 + endline.Z ^ 2)))
Catch
theida = 0
End Try
Try
phi = Acos(((startline.X * endline.X) + (startline.Y * endline.Y)) / (Sqrt(startline.X ^ 2 + startline.Y ^ 2) * Sqrt(endline.X ^ 2 + endline.Y ^ 2)))
Catch
phi = 0
End Try
theida = theida * (180 / PI)
phi = phi * (180 / PI)
Any help or guidance is appreciated. Again I may be going at this with the wrong idea in the first place.
I am making an arc with a triangle fan. The triangle fan has to have set points for each of the vertices to make the arc shape. I have found a multitude of docs regarding DrawArc, but that is not what I am after, and cannot find anything on creating "x number of points" across the arc from point A to point B.
It has been several years since my last trig class, so I am hoping someone has an idea of how to increment the x/y location of the points between A-B. Here is what I have so far:
Dim points As Integer = 5 ' the number of points between top and right
Dim radius as Integer = 25
' Center point
Dim cx As Integer = loc.X + (size.Width - (radius))
Dim cy As Integer = loc.Y + thickness
' Top point
Dim x1 As Integer = loc.X + (size.Width - (radius))
Dim y1 As Integer = loc.Y
' Right point
Dim x2 As Integer = loc.X + (size.Width)
Dim y2 As Integer = loc.Y + radius
Dim trifan As New VertexArray(PrimitiveType.TrianglesFan)
trifan .Append(New Vertex(New Vector2f(cx, cy), col2)) ' Center point
trifan .Append(New Vertex(New Vector2f(x1, y1), col1)) ' Top point
For i = 1 To points
' append other points here...
Next
trifan .Append(New Vertex(New Vector2f(x2, y2), col1)) ' Right point
I'm just posting this here so it will have an answer for others who come across it. I had a lot of help with this (as recommended) here: https://math.stackexchange.com/questions/1789110/plot-points-on-an-arc
For i = 0 To points - 1
Dim x As Double
Dim y As Double
Dim t As Double = (PI / 2) * (i / points - 1)
x = cx + Cos(t) * (radius)
y = cy + Sin(t) * (radius)
trifan1.Append(New Vertex(New Vector2f(x, y), col1))
Next
I found a great script to arrange objects (shapes) into a circle here:
Aligning Shapes in a Circle using VBA, Microsoft Community
Sub Test()
Call AlignShapesInCircle(720 / 2, 540 / 2, 100, ActiveWindow.Selection.ShapeRange)
End Sub
Function AlignShapesInCircle(x As Single, y As Single, r As Single, shprng As ShapeRange)
'x,y = center point of the circle
'r = radius of the circle
'shprng = the shape selection that needs to be arranged
Dim angle As Single
Dim currentangle As Single
Dim x1 As Single
Dim y1 As Single
Dim i As Integer
currentangle = 0
angle = 360 / shprng.count
For currentangle = 0 To 359 Step angle
i = i + 1
x1 = r * Cos(D2R(currentangle))
y1 = r * Sin(D2R(currentangle))
shprng(i).Left = x + x1
shprng(i).Top = y + y1
Next
End Function
Function D2R(Degrees) As Double
D2R = Degrees / 57.2957795130823
End Function
Function R2D(Radians) As Double
R2D = 57.2957795130823 * Radians
End Function
Now I want the shapes to rotate so that if I use arrows the tip will always show towards the center.
I have to introduce a line here:
shprng(i).Left = x + x1
shprng(i).Top = y + y1
shprng(i).Rotation = ???
Any ideas where I could find the proper formula?
Silly - figured it out - it was easier than I thought. Don't need any SIN and COS which frightened me - just:
shprng(i).Rotation = (360 / (shprng.Count)) * (i - 1)
Given the image below
1. I have updated the image based on feedback from Steven_W so there are 4 triangles in the right hand diagram instead of 3 which makes more sense!
2. update image again to label sub triangles as A, B, C, D in grey
What is the pseudo algorithm for mapping a coordinate (x,y) in the left hand square such that a coordinate (u,v) is produced within the rectangle bounding the triangle on the right so that points are interpolated between the mapping points as illustrated on the diagram?
1 to 4 are equidistant on the triangle from left to right even though my illustration is a bit rough around the edges :)
This is to generate a rough and ready panel for the lid of a skybox from the top half a 360 degree panoramic photo.
update 3 based on feedback
The first step appears to be working out which triangle we are in for the left hand diagram based on the (x,y) coordinates.
The second steep is to work out the distance along the vertices of that triangle. Then use those distances to get the coordinates on the related triangle in the diagram on the right
update 4 - code to identify triangle in left hand diagram
Public Function TriangleIndex(ByVal x As Integer, ByVal y As Integer, ByVal w as integer, ByVal h as integer) as integer
Dim AboveForwardSlashDiagonal As Boolean = ((((h * x) + (w * y)) - (h * w)) < 0)
Dim AboveBackSlashDiagonal As Boolean = (((h * x) - (w * y)) > 0)
If AboveForwardSlashDiagonal Then
If AboveBackSlashDiagonal
return 2 ' C
else
return 3 ' D
end if
else
If AboveBackSlashDiagonal
return 1 ' B
else
return 0 ' A
end if
End If
End Function
update 5 - template for code solution
w1 and h1 are dimensions of left diagram
w2 and h2 are dimensions of right diagram
Private Function TranslateToTriangle(ByVal x1 As Integer, ByVal y1 As Integer, ByVal w1 As Integer, ByVal h1 As Integer, ByVal w2 As Integer, ByVal h2 As Integer) As System.Drawing.Point
Dim ReturnPoint As New System.Drawing.Point
select case TriangleIndex(x1,y1,w1,h1)
case 0
case 1
case 2
case 3
end select
Return ReturnPoint
End Function
update 6 formula for area of triangle given it's lengths - which might be helpful in calculating barycentric weights?
Private Function AreaOfTriangle(ByVal LengthA As Single, ByVal LengthB As Single, ByVal LengthC As Single) As Single
Dim Perimeter As Single = LengthA + LengthB + LengthC
Return 1 / 4 * Math.Sqrt(Perimeter * (Perimeter - 2 * LengthA) * (Perimeter - 2 * LengthB) * (Perimeter - 2 * LengthC))
End Function
Well, your comment to #Steven_W's answer makes the answer to your question clearer. You actually want to map points in the 4 triangles (125, 235, 435, 415) in your square box to the corresponding 4 triangles in your other square box (125, 235, 435, 415). Oh, you don't have triangle 415 in your second box, perhaps you should or maybe not.
So now you have to map points from triangle to triangle which should be easy. As coordinates for each point in your 'start' triangle use its position relative to all 3 vertices, then use the same position relative to the 3 vertices of the 'destination' triangle. You could probably get away with using just 2 of the triangle vertices for coordinates.
HTH
The Wikipedia entry trilinear coordinates explains the maths well enough I think.
Let's consider first the case of the triangle a.
Assuming that your origin is at point 5, the coordinates of points 1 and 2 are (-x0, y0) and (x0, y0), we should have the following.
The mapping from the old coordinates (x, y) into new (xnew, ynew) must be linear. This means, we've got the following formulae with still undefined coefficients:
xnew = A*x + B*y + C
ynew = D*x + E*y + F
How can we determine the coefficients? We've got three pairs of values: (-x0, y0) -> (-x0, y0), (x0, y0) -> (-x0/2, y0) and (0, 0) -> (0, -y0). This gives us the following:
-x0 = -A*x0 + B*y0 + C (1) -x0/2 = A*x0 + B*y0 + C (3)
y0 = -D*x0 + E*y0 + F (2) y0 = D*x0 + E*y0 + F (4)
0 = A*0 + B*0 + C (5)
-y0 = D*0 + E*0 + F (6)
Good so far. (5) gives us C = 0, (6) gives F = -y0. Adding (2) and (4) we get 2*y0 = 2*E*y0 + 2*(-y0), hence E = 2. Subtracting (2) and (4) we get 0 = 2*D*x0, hence D = 0. Adding (1) and (2) and taking into account that C = 0, we get -(3/4)*x0 = 2*B*y0, hence B = -3/4*x0/y0. Lastly, subtracting (1) and (2) we get x0/2 = 2*A*x0, hence A = 1/4.
Now, we can write down the needed mapping:
xnew = 0.25*x - 0.75*(x0/y0)*y
ynew = 2*y - y0
The same way, for triangle c we obtain:
xnew = -0.25*x - 0.25*(x0/y0)*y
ynew = -2*y - y0
It is not really clear why certain points map to their counterpart on the triangle.
For example, where should a point map to that is equidistant between '1' and '4' ?
Or, a point just "above" number 5 ?