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)
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.
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 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
If I have a convex curve, and want to find the minimum point (x,y) using a for or while loop. I am thinking of something like
dim y as double
dim LastY as double = 0
for i = 0 to a large number
y=computefunction(i)
if lasty > y then exit for
next
how can I that minimum point? (x is always > 0 and integer)
Very Close
you just need to
dim y as double
dim smallestY as double = computefunction(0)
for i = 0 to aLargeNumber as integer
y=computefunction(i)
if smallestY > y then smallestY=y
next
'now that the loop has finished, smallestY should contain the lowest value of Y
If this code takes a long time to run, you could quite easily turn it into a multi-threaded loop using parallel.For - for example
dim y as Double
dim smallestY as double = computefunction(0)
Parallel.For(0, aLargeNumber, Sub(i As Integer)
y=computefunction(i)
if smallestY > y then smallestY=y
End Sub)
This would automatically create separate threads for each iteration of the loop.
For a sample function:
y = 0.01 * (x - 50) ^ 2 - 5
or properly written like this:
A minimum is mathematically obvious at x = 50 and y = -5, you can verify with google:
Below VB.NET console application, converted from python, finds a minimum at x=50.0000703584199, y=-4.9999999999505, which is correct for the specified tolerance of 0.0001:
Module Module1
Sub Main()
Dim result As Double = GoldenSectionSearch(AddressOf ComputeFunction, 0, 100)
Dim resultString As String = "x=" & result.ToString + ", y=" & ComputeFunction(result).ToString
Console.WriteLine(resultString) 'prints x=50.0000703584199, y=-4.9999999999505
End Sub
Function GoldenSectionSearch(f As Func(Of Double, Double), xStart As Double, xEnd As Double, Optional tol As Double = 0.0001) As Double
Dim gr As Double = (Math.Sqrt(5) - 1) / 2
Dim c As Double = xEnd - gr * (xEnd - xStart)
Dim d As Double = xStart + gr * (xEnd - xStart)
While Math.Abs(c - d) > tol
Dim fc As Double = f(c)
Dim fd As Double = f(d)
If fc < fd Then
xEnd = d
d = c
c = xEnd - gr * (xEnd - xStart)
Else
xStart = c
c = d
d = xStart + gr * (xEnd - xStart)
End If
End While
Return (xEnd + xStart) / 2
End Function
Function ComputeFunction(x As Double)
Return 0.01 * (x - 50) ^ 2 - 5
End Function
End Module
Side note: your initial attempt to find minimum is assuming a function is discrete, which is very unlikely in real life. What you would get with a simple for loop is a very rough estimate, and a long time to find it, as linear search is least efficient among other methods.