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
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
Introduction
I am somewhat new to using Open GL / Open TK. I have learned how to draw basic shapes, use matrices, lighting, shadowing, etc. I have a function that draws a sphere:
Private Sub drawSphere(r As Double, lats As Integer, longs As Integer)
Dim i As Integer, j As Integer
For i = 0 To lats
Dim lat0 As Double = PI * (-0.5 + CDbl(i - 1) / lats)
Dim z0 As Double = Sin(lat0)
Dim zr0 As Double = Cos(lat0)
Dim lat1 As Double = PI * (-0.5 + CDbl(i) / lats)
Dim z1 As Double = Sin(lat1)
Dim zr1 As Double = Cos(lat1)
GL.Begin(PrimitiveType.QuadStrip)
For j = 0 To longs
Dim lng As Double = 2 * PI * CDbl(j - 1) / longs
Dim x As Double = Cos(lng)
Dim y As Double = Sin(lng)
GL.Normal3(x * zr0 * r, y * zr0 * r, z0 * r)
GL.Vertex3(x * zr0 * r, y * zr0 * r, z0 * r)
GL.Normal3(x * zr1 * r, y * zr1 * r, z1 * r)
GL.Vertex3(x * zr1 * r, y * zr1 * r, z1 * r)
Next
GL.End()
Next
End Sub
I have other code that sets up the lights. I know the other code works because I have a separate function for drawing an STL object:
Dim texture As UInteger() = New UInteger(0) {}
Dim i As Integer = 0
If stl_table.Items.Count > 0 Then
find_center_of_part()
GL.Begin(PrimitiveType.Triangles)
GL.Color3(part_color.R, part_color.G, part_color.B)
Do Until i + 4 >= stl_table.Items.Count
GL.Normal3(Convert.ToSingle(stl_table.Items.Item(i).SubItems(0).Text), Convert.ToSingle(stl_table.Items.Item(i).SubItems(1).Text), Convert.ToSingle(stl_table.Items.Item(i).SubItems(2).Text))
GL.Vertex3(stl_table.Items.Item(i + 1).SubItems(0).Text - avgx, stl_table.Items.Item(i + 1).SubItems(1).Text - avgy, stl_table.Items.Item(i + 1).SubItems(2).Text - avgz)
GL.Vertex3(stl_table.Items.Item(i + 2).SubItems(0).Text - avgx, stl_table.Items.Item(i + 2).SubItems(1).Text - avgy, stl_table.Items.Item(i + 2).SubItems(2).Text - avgz)
GL.Vertex3(stl_table.Items.Item(i + 3).SubItems(0).Text - avgx, stl_table.Items.Item(i + 3).SubItems(1).Text - avgy, stl_table.Items.Item(i + 3).SubItems(2).Text - avgz)
i = i + 4
Loop
GL.End()
End If
This second function basically imports a CAD STL file and draws it as triangles. The normal vectors are simply an input from the CAD file (so they are already computed). This method's lighting works perfectly fine which makes me know my lighting code is correct.
Problem
The problem is that my sphere is not getting light correctly. I know through testing that this is due to my normal vectors.
With the current code, my sphere looks like this:
There is a "spot" of light which makes me think that is simply one of the quadstrips having the normal correct.
Does anybody have any suggestions on setting up the normal vectors correctly inside my function? Also before anybody suggests it, I can't use GLU or GLUT for what I am trying to accomplish, which is why I need the sphere function.
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)
I'm trying to make a line with a fixed x1/y1, and when the user moves the cursor, its other end goes to the cursor. "cannon" is the line. When I try to use it, the line does indeed follow the cursor, but it's got a large offset and is inverted. I'm not really sure what's wrong with it, but it's probably very obvious.
Dim angle as Double = Math.Atan(Math.Abs(Cursor.Position.Y - cannon.Y1) / Math.Abs(Cursor.Position.X - cannon.X1))
Dim h As Double = Math.Sqrt((Math.Abs(Cursor.Position.X - cannon.X1) ^ 2) + Math.Abs(Cursor.Position.Y - cannon.Y1) ^ 2)
Dim a As Double = h * Math.Cos(angle)
Dim o As Double = h * Math.Sin(angle)
cannon.X2 = cannon.X1 + a
cannon.Y2 = cannon.Y1 - o
I suspect that Cursor.Position gives the mouse coordinate relative to the top left corner of your monitor - as does MousePosition.Try this..
PointToClient is a function that calculates the position of the mouse relative to your program window.
Dim angle as Double = Math.Atan(Math.Abs(Me.PointToClient(MousePosition).Y - cannon.Y1) / Math.Abs(Me.PointToClient(MousePosition).X- cannon.X1))
Dim h As Double = Math.Sqrt((Math.Abs(Me.PointToClient(MousePosition).X - cannon.X1) ^ 2) + Math.Abs(Me.PointToClient(MousePosition).Y - cannon.Y1) ^ 2)
Dim a As Double = h * Math.Cos(angle)
Dim o As Double = h * Math.Sin(angle)
cannon.X2 = cannon.X1 + a
cannon.Y2 = cannon.Y1 - o
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.