Source of algorithm idea
I took that idea and I am trying to detect if an entire polygon is inside the other polygon. Here is my code that I came up with adding an additional check for X because sometimes it will equal zero and cause a issue.
Public Shared Function ContainsOutsidePoints(ByVal ToBeChecked As Polygon, ByVal CheckAgainst As Polygon) As Boolean
For Each pt As Point In ToBeChecked.Coordinates
If CheckAgainst.Inside(pt) = False Then
Return True
End If
Next
Return False
End Function
Public Function Inside(ByVal Value As Point) As Boolean
Dim j As Integer = Lines.Count - 1
Dim pxi As Double
Dim pxj As Double
Dim pyi As Double
Dim pyj As Double
Inside = False
For i As Integer = 0 To Lines.Count - 1
pxi = Lines.Item(i).EndPointA.X
pxj = Lines.Item(j).EndPointA.X
pyi = Lines.Item(i).EndPointA.Y
pyj = Lines.Item(j).EndPointA.Y
If (pyi < Value.Y AndAlso pyj >= Value.Y OrElse _
pyj < Value.Y AndAlso pyi >= Value.Y) And _
pxi <= Value.X OrElse pxj <= Value.X AndAlso _
pxi <> pxj Then
If (pxi + (Value.Y - pyi) / (pyj - pyi) * (pxj - pxi) < Value.X) Then
Inside = Not Inside
End If
End If
j = i
Next
Return Inside
End Function
When I run it it will sometimes say polygons that I can see are not inside the other when it clearly is and sometimes it will return is inside when not all points are inside the other polygon. Is this caused by adding the additional check of the X since even less statements match the if statement requirements.
The intersection of an horizontal line with the interior of a polygon is a set of 1D intervals.
If P is inside Q, all 1D intervals of P will be wholly inside a corresponding interval of Q.
It suffices to check that this property holds for all horizontals though all vertices of both polygons.
You can do that by considering every vertex in turn, finding the intersections with the horizontals and sorting them left-to-right before checking for inclusion.
You can save operations by using the sweepline paradigm, i.e. scanning the vertices top-to-bottom and maintaining a list of the edges that straddle the current horizontal. This way you know exactly which edge will intersect; the update of the straddling list from vertex to vertex is straightforward.
Related
I'm stumped... I'm trying to get the hang of splitting up calculations in tasks to speed up the program. That seems to work fine for small pieces of code, but I'm failing miserably when it gets a little more difficult.
Situation:
I have a program that calculates about 1,000 factors in a 5-step process for each factor. I want to split the calculation of those factors up into tasks.
The code that does the trick (but without using Tasks):
Public Overridable Function GetFactor(Gender As Short, Age As Short) As Double Implements IFactor.GetFactor
'Set up the Markov Chain associated with a factor
Me.Markov = New MarkovChain(Gender, Age)
'Set up the payment schedule
Me.Payments = New PaymentsAnnuity(Age, Me.MaxAge)
'Determine the benefits
Me.Benefits = New Benefit(Age, Me.MaxAge)
'Calculate the cash flows
Call Me.CalcCashFlow()
'Calculate the factor and return it
Return Me.CalcFactor()
End Function
That code works fine for one factor. I then have a calculation engine that iterates through all factors and ages
Public Sub RunCalculations(ByVal MinAge As Short, ByVal MaxAge As Short)
'Cycle through all available factors
For iParam As Integer = 0 To Me.Factors.Length - 1
'Fetch the new factor specific parameter set
Dim Param As FactorParameters = Me.Factors(iParam)
'Get a new factor generator of the proper kind. Note that all generators are stored in their corresponding
'FactorParameters "FactorType" value upon creation of the Calculation Engine to allow for easy selection
Dim Generator As IFactor = Me.Generators(Param.FactorType).GetInstance(Me.Assumptions, Param)
'Calculate the factors for both males and females and store them in the Output matrices
For iAge As Short = MinAge To MaxAge
Me.OutputResultsMale(iAge - MinAge, iParam + 1) = Generator.GetFactor(0, iAge)
Me.OutputResultsFemale(iAge - MinAge, iParam + 1) = Generator.GetFactor(1, iAge)
Next iAge
Next iParam
End Sub
The above code runs fine and I get all the factors I asked for, but it takes ages. I therefore tried to generate tasks, one for each factor and have it run on multiple cores. I changed the code in the Sub RunCalculations (most notably the iAge For-loop):
Public Sub RunCalculations(ByVal MinAge As Short, ByVal MaxAge As Short)
'Set up Task matrices to populate the output matrices
Dim aTasksMale(MaxAge - MinAge, Me.Factors.Length) As Task(Of Double)
Dim aTasksFemale(MaxAge - MinAge, Me.Factors.Length) As Task(Of Double)
'Cycle through all available factors
For iParam As Integer = 0 To Me.Factors.Length - 1
'Fetch the new factor specific parameter set
Dim Param As FactorParameters = Me.Factors(iParam)
'Get a new factor generator of the proper kind. Note that all generators are stored in their corresponding
'FactorParameters "FactorType" value upon creation of the Calculation Engine to allow for easy selection
Dim Generator As IFactor = Me.Generators(Param.FactorType).GetInstance(Me.Assumptions, Param)
'Calculate the factors for both males and females and store them in the Task matrices
For iAge As Short = MinAge To MaxAge
'Set up a local variable and set it to the iteration value
'Note: not doing this results in the following Warning: "Using the iteration variable in a lambda expression may have unexpected results.
'Instead, create a local variable within the loop and assign it the value of the iteration variable."
Dim iLoopAge As Short = iAge
'Run the tasks of generating the factors for both males and females
aTasksMale(iLoopAge - MinAge, iParam + 1) = Task.Run(Function() Generator.GetFactor(0, iLoopAge))
aTasksFemale(iLoopAge - MinAge, iParam + 1) = Task.Run(Function() Generator.GetFactor(1, iLoopAge))
Next iAge
Next iParam
'Wait for all tasks to complete
Task.WaitAll()
'Populate the output matrices
For iAge = MinAge To MaxAge
For iFactor = 1 To Me.Factors.Length
'Copy the factors to the output matrices
Me.OutputResultsMale(iAge - MinAge, iFactor) = aTasksMale(iAge - MinAge, iFactor).Result
Me.OutputResultsFemale(iAge - MinAge, iFactor) = aTasksFemale(iAge - MinAge, iFactor).Result
Next iFactor
Next iAge
End Sub
I was hoping (and perhaps even expecting) that would do the trick and speed up the process, but instead I get a weird error I can't seem to fix, especially in the CalcCashFlow and CalcFactor routines. The CalcFactor routine is pretty short and simple:
Friend Overridable Function CalcFactor() As Double
'Set up a double representing the factor
Dim dFactor As Double
'Cycle through all cash flows
For iPeriod As Short = 0 To Me.CashFlow.Length - 1
'Determine the present value of the cash flow and add it to the factor value
dFactor += Me.CashFlow(iPeriod) * Me.Assumptions.Yield.GetPV(iPeriod)
Next iPeriod
'Return the factor
Return dFactor
End Function
I get an IndexOutOfBounds error for the iPeriod loop variable in the CalcFactor routine. When I get the OutOfBounds error I noticed that the iPeriod variable would be (e.g.) 118 whereas the cash flow array holds only 113 values (the values for both the iPeriod variable and the length of the Factor array differ between runs / errors). I don't understand why, because the loop explicitly says iPeriod should only loop until the end of the cash flow array.
When running the 'regular' (slow) program, iPeriod would never get above 113 in that example. But adding it to a Task somehow screws that all up. It looks like the iPeriod loop variable gets mixed up with other tasks or something, so I also tried adding a new local looping variable and setting it to the iPeriod variable, but to no avail.
What am I doing wrong here?
If you need more explanation / code, just let me know.
Fixed with the help of commenters: I used one class instance (Generator) for two simultaneous tasks, which .Net apparently did not appreciate. Changed part of the RunCalculations code to reflect that and added a separate function that always instantiates a new Generator for each calculation:
'Set up Task lists to populate the output matrices
Dim TaskListMale As New List(Of Task(Of Double))
Dim TaskListFemale As New List(Of Task(Of Double))
Dim NextTask As Task(Of Double)
'Cycle through all available factors
For iParam As Short = 0 To Me.Factors.Length - 1
'Fetch the next factor specific parameter set
Dim Param As FactorParameters = Me.Factors(iParam)
'Set up the tasks
For iAge As Short = MinAge To MaxAge
'Set up a local variable and set it to the iteration value
'Note: not doing this results in the following Warning: "Using the iteration variable in a lambda expression may have unexpected results.
'Instead, create a local variable within the loop and assign it the value of the iteration variable."
Dim iLoopAge As Short = iAge
'Calculate the factors for both males and females and add them to the Task lists
NextTask = Task.Run(Function() GenerateFactorAsync(Param, Gender.Male, iLoopAge))
TaskListMale.Add(NextTask)
NextTask = Task.Run(Function() GenerateFactorAsync(Param, Gender.Female, iLoopAge))
TaskListFemale.Add(NextTask)
Next iAge
Next iParam
'Wait for all tasks to complete
Task.WaitAll(TaskListMale.ToArray)
Task.WaitAll(TaskListFemale.ToArray)
'Populate the output matrices from the task lists. For easier reference, a counter variable is used
Dim iTask As Short = 0
For iFactor = 0 To Me.Factors.Length - 1
For iAge = MinAge To MaxAge
'Copy the factors to the output matrices
Me.OutputResultsMale(iAge - MinAge, iFactor + 1) = TaskListMale(iTask).Result
Me.OutputResultsFemale(iAge - MinAge, iFactor + 1) = TaskListFemale(iTask).Result
iTask += 1
Next iAge
Next iFactor
End Sub
Private Function GenerateFactorAsync(ByVal Param As FactorParameters, ByVal Gender As Gender, ByVal Age As Short) As Double
'Get a new factor generator of the proper kind. Note that all generators are stored in their corresponding
'FactorParameters "FactorType" value upon creation of the Calculation Engine to allow for easy selection
Dim Generator As IFactor = Me.Generators(Param.FactorType).GetInstance(Me.Assumptions, Param)
'Calculate the corresponding factor for the gender and age given and return it
Return Generator.GetFactor(Gender.Type, Age)
End Function
It now works as intended
I'm trying to figure out how to code a straight line to the straight part of a curve, the curve should look something like the exponential, click the link to open the image:
Straight line to Curve and determining the x-intercept
Here is the code, I'm only using the exponential as an example
`
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim s As String
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
wb = xl.Workbooks.Add 'create new workbook
ws = wb.Worksheets(1) 'select sheet 1
ws.Activate()
Dim Currents() As Double
Dim PhotodiodeValues() As Double
Dim AppliedCurrent As Double
'AppliedCurrent = SerialPort1.ReadLine
AppliedCurrent = 0
If AppliedCurrent >= 0 And AppliedCurrent < 0.1 Then
Dim j As Integer = 1
For i As Double = 0 To 5 Step 0.5
ReDim Preserve Currents(j)
ReDim Preserve PhotodiodeValues(j)
MsgBox(i)
MsgBox("LDI " & CType(i, String))
s = ("LDI " & CType(i, String))
AppliedCurrent = i
If AppliedCurrent >= i And AppliedCurrent < (i + 0.1) Then
Currents(j) = CType(i, Double)
Label1.Text = Currents(j)
PhotodiodeValues(j) = CType(Math.E ^ (i), Double)
ws.Cells(j, 1) = Currents(j)
ws.Cells(j, 2) = PhotodiodeValues(j)
Else
System.Threading.Thread.Sleep(1000)
End If
j = j + 1
Next
Else
System.Threading.Thread.Sleep(1000)
End If
sfd1.ShowDialog() 'get file name
wb.SaveAs(sfd1.FileName) 'save data to file
wb.Close()
xl = Nothing 'dispose of excel
ScatterGraph1.PlotXY(Currents, PhotodiodeValues)
'SerialPort1.Close()
End Sub
End Class`
First off, I'll explain my thought process. If I have misunderstood, please let me know and I will update my answer. The slope dy/dx of the curve y = e^x is dy/dx = e^x, a monotonically increasing function of x for all real x. There is never a point at which the function becomes linear and, while it has a horizontal asymptote (y = 0) it has no vertical asymptote.
I take it that what you want is the equation of a tangent line taken at a point where the slope first becomes greater than some cutoff value m*. After that point, the graph of y = e^x "might as well" be a straight line for your intents and purposes.
So, we must first solve the equation m* = dy/dx = e^x for the x at which m* occurs. The range of e^x is all positive real numbers and e^x is monotonically increasing, so any positive real number m* will have a unique solution x*. indeed, x* = ln(m*). Our tangent line will pass through the point (x*, e^x*) and have slope m*. Recall that m* = e^x*, so the point is (ln(m*), m*) and the slope is m*.
With a point and the slope, we can figure out the equation of a line. We have that the slope from the given point to any other point must be m*; so, (y - y*)/(x - x*) = m*. Rearranging, (y - y*) = m*(x - x*), y = mx - mx* + y*, and finally y = mx + (y - mx) = mx + (m - mln(m)). The Y-intercept is therefore (m* - mln(m)). We can get the X-intercept by setting y = 0 and solving for x: 0 = mx + (m - mln(m)), mx = mln(m*) - m*, x = ln(m*) - 1.
In summary:
the equation of the line tangent to y = e^x with slope m* is y = mx + (m - mln(m)).
the Y-intercept of this line is (m* - mln(m)).
the X-intercept of this line is ln(m*) - 1
If the curve is known at compile time, I recommend hard-coding a closed form analytical solution for the derivative and any asymptotes. If the function is not known until runtime, the derivative at a given point can be approximated numerically using a variety of methods. Intuitively, the definition of the derivative as the limit of (f(x+d) - f(x)) / d as d approaches zero can be used to find approximations of the derivative where the derivative (likely) exists. For well-behaved analytic functions, you will typically be safe except in special cases.
If the function's derivative is monotonically non-decreasing, as in this example, you can find the point (if any) at which the function's slope meets or exceeds a certain cutoff using approximation (as above) in conjunction with something akin to binary search. Start at a value such as x = 0, and increase or decrease x by some multiplicatively increasing factor until you have passed your target. Now, with bounds on the values of x between which your target can be found, check the middle of the range, and then either the left or right half recursively until a suitably good x* is found.
I am developing a VBA macro to use in AutoCAD. At the moment it converts a circle into a 3D polyline and in itself it is working perfectly. It is just the start and I will be able to put some flesh on the final routine.
This is the VBA macro:
Sub CircleToPolyline()
Dim objSel As AcadEntity
Dim myCircle As AcadCircle
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
Call ThisDrawing.Utility.GetEntity(objSel, pickedPoint, "Select Circle:")
If objSel.ObjectName <> "AcDbCircle" Then GoTo SKIP
Set myCircle = objSel
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
' So our polyline will always have 36 vertices
Dim ptCoord() As Double
Dim ptProject As Variant
Dim i As Integer
i = 0
While dAngle < dMaxAngle
ReDim Preserve ptCoord(0 To i + 2) ' Increase size of array to hold next vertex
' Calculate the next coordinate on the edge of the circle
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
' Add to the coordinate list
ptCoord(i) = ptProject(0)
ptCoord(i + 1) = ptProject(1)
ptCoord(i + 2) = ptProject(2)
' Increment for next coordinate/angle on the circle edge
dAngle = dAngle + dAngleStep
i = i + 3
Wend
' Create the 3D polyline
Dim oPolyline As Acad3DPolyline
Set oPolyline = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
oPolyline.Closed = True
oPolyline.Update
SKIP:
End Sub
I am just wondering if there are any alternative methods for managing my dynamic array (ptCoord)? For example, is there any way that I can just add the ptProject into a dynamic list and then just use this list in the Add3dPoly routine?
The thing is, PolarPoint returns a variant. And ptCoord is a array of doubles (which is what Add3dPoly expects). This is why I have done it like this. I have not used variants (except for handling return values).
My code is quite simple and sufficient, but if it can be further simplified I would be interested in knowing (given the context of VBA and AutoCAD environment).
I hope my question is clear. Thank you.
It is feasible to allocate a chunk of memory and write the sequential results of each of your PolarPoint calls to it. You could then copy that memory to your ptCoord array in one call. However, the APIs are very awkward, there'd be a lot of fiddling with pointers (never straightforward in VBA) and most memory coding errors result in a complete Excel crash. For 108 data points it doesn't seem worth the effort.
I'd say your notion of iterating each of the result arrays and writing them individually to ptCoord is as good a way as any.
Your comments
'We always start at 0 degrees / radians, and 'So our polyline will always have 36 vertices
suggest your ptCoord array will have a fixed dimension (ie 36 * 3). If that's the case couldn't you just dimension the array once? Even if you want to vary the number of degrees to draw through, you could still dimension your array at (n * 3) without having to ReDim Preserve on every iteration.
A snippet of your code could therefore become:
Dim alpha As Double
Dim index As Integer
Dim i As Integer
Dim ptCoord(0 To 107) As Double
Dim ptProject() As Double
Dim pt As Variant
...
For i = 0 To 35
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
For Each pt In ptProject
ptCoord(index) = pt
index = index + 1
Next
alpha = alpha + 0.174532925199433
Next
Your code appears good to me, I was going to suggest a two dimensional array: -
Dim ptCoord(2,0)
...
ptCoord(0,0) = ptProject(0)
ptCoord(1,0) = ptProject(1)
ptCoord(2,0) = ptProject(2)
ReDim Preserve ptCoord(2,1)
ptCoord(0,1) = ptProject(0)
ptCoord(1,1) = ptProject(1)
ptCoord(2,1) = ptProject(2)
The second dimension in a two dimensional array can be dynamically re-dimensioned. But I'm not sure this will save you anything and it may not work with Add3DPoly.
You could use UBound to save on the i variable.
ReDim Preserve ptCoord(UBound(ptCoord,1)+3)
In the above I haven't declared the lower/base (0 To) as 0 is the default base, I have then used UBound (Upper bound) to get the size of the array and added 3 to that to make it 3 larger.
UBound([Array],[Dimension])
Array being the array you want to check
Dimension being the dimension you want to check the size on, it has a base of 1 not 0 (so the first dimension is 1 not 0, the second is 2 not 1, and so on...)
You can omit Dimension and the first will be assumed.
To access it without i you could use: -
ptCoord(UBound(ptCoord,1)-2) = ptProject(0)
ptCoord(UBound(ptCoord,1)-1) = ptProject(1)
ptCoord(UBound(ptCoord,1)) = ptProject(2)
you can skip arrays dimming altogether by use of AppendVertex() method
Option Explicit
Sub CircleToPolyline()
Dim myCircle As AcadCircle
Dim circleCenter As Variant, circleRadius As Double
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
Dim oPolyline As Acad3DPolyline
'Get the user to select a circle
Set myCircle = GetCircle(circleCenter, circleRadius)
If myCircle Is Nothing Then Exit Sub
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
Set oPolyline = GetStarting3dPoly(circleCenter, circleRadius, dAngle, dAngleStep) ' Create the 3D polyline with first two points
Do While dAngle + dAngleStep <= dMaxAngle
dAngle = dAngle + dAngleStep ' Increment for next coordinate/angle on the circle edge
oPolyline.AppendVertex ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius) 'append a new vertex
Loop
'finish the polyline
oPolyline.Closed = True
oPolyline.Update
End Sub
Function GetStarting3dPoly(circleCenter As Variant, circleRadius As Double, dAngle As Double, dAngleStep As Double) As Acad3DPolyline
Dim ptCoord(0 To 5) As Double
Dim ptCoords As Variant
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(0) = ptCoords(0)
ptCoord(1) = ptCoords(1)
ptCoord(2) = ptCoords(2)
dAngle = dAngle + dAngleStep
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(3) = ptCoords(0)
ptCoord(4) = ptCoords(1)
ptCoord(5) = ptCoords(2)
Set GetStarting3dPoly = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
End Function
Function GetCircle(circleCenter As Variant, circleRadius As Double) As AcadCircle
Dim objSel As AcadEntity
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
ThisDrawing.Utility.GetEntity objSel, pickedPoint, "Select Circle:"
If objSel.ObjectName = "AcDbCircle" Then
Set GetCircle = objSel
circleCenter = objSel.Center
circleRadius = objSel.Radius
End If
End Function
as you see I also extracted some actions from the main code and confined them into functions, so to improve further enhancing of your code and its functionalities
VB.NET
My data is coming from an exported DXF file from various cad packages. When a circular arc (defined as a part of a true circle) is exported it is sometimes exported as a bunch of line segments rather than a circular arc.
I have a list of points and I am trying to guess if they were derived from the same circle. Basically I iterate through all the points and use a method to find the center point of a circle from three points. My intention was to compare all the calculated center points generated and make a determination if they are close to each other.
My first thought was that I could check to see if the center points are all equal but they have slight differences between them because of rounding and the underlying estimating routine that generates the point in the first place (I have no control over that).
MY second was to check the standard deviation of the x and y values of the circumference points and compare that against the standard deviation of the x,y of the centers and make some judgement from that. VB.net does not seem to have a native stdev function and I am sometimes a bit lazy.
Does anybody have a simple idea on how to determine if a list of points are all from the same circle?
Here are my functions:
To determine the center of a circle given three points:
Public Function getCenter(p1 As Point2D, p2 As Point2D, p3 As Point2D) As Point2D
Dim yDelta_a As Double = p2.Y - p1.Y
Dim xDelta_a As Double = p2.X - p1.X
Dim yDelta_b As Double = p3.Y - p2.Y
Dim xDelta_b = p3.X - p2.X
Dim center As New Point2D
Dim aSlope As Double = yDelta_a / xDelta_a
Dim bSlope As Double = yDelta_b / xDelta_b
center.X = (aSlope * bSlope * (p1.Y - p3.Y) + bSlope * (p1.X + p2.X) - aSlope * (p2.X + p3.X)) / (2 * (bSlope - aSlope))
center.Y = -1 * (center.X - (p1.X + p2.X) / 2) / aSlope + (p1.Y + p2.Y) / 2
Return center
End Function
And then to iterate the list of points and get a collection of centers. FYI...This function received a list of lines that have endpoints that are points so I do a bit of iterating to get all the correct points.
Public Function MakesCircle(lines As List(Of Line))
Dim points As New List(Of Point2D)
If lines.Count < 2 Then
Return False
Else
//Get points from lines
For i As Int16 = 0 To lines.Count - 2
points.Add(lines(i).StartPoint)
Next
points.Add(lines.Last.StartPoint)
End If
//"Prime the pump" for the center calculation loop
Dim centers As New List(Of Point2D)
Dim a As Point2D = points(0)
Dim b As Point2D = points(1)
Dim c As Point2D = points(2)
//Calc all the centers
For i As Int16 = 3 To lines.Count - 1
centers.Add(getCenter(a, b, c))
a = b
b = c
c = points(i)
Next
//This is where I need logic to determine if the points all actually belong to the same circle
Return True
End Function
You can use a GraphicsPath object to find this out. -not tested-
I figured you would be able to construct a Rectangle Structure based on the data coming in (x,y,w,h) then this make-shift algorithm would do for you.
Private Function areAllPointsInEllipsis(ellipsis As Rectangle, pts() As Point) As Boolean
Dim result As Boolean
Using gp As New System.Drawing.Drawing2D.GraphicsPath
gp.AddEllipsis(ellispsis)
result = pts.All(Function(pt) gp.IsVisible(pt))
End Using
Return result
End Function
What I did was generate all the distances from the average center point to each of the points that make up the circumference. Find the max and min distances. They you can use a threshold of a percentage of the radius - a kind of eccentricity measurement. If the difference between the max and min falls below 1% of the radius then I call it a circle.
I am having a problem in building up VBcode for getting the minimum distance between a set of coordinate points. What I am actually trying is to find the minimum distance between one set of coordinate points (A(x1,y1),Bx2,y2),C(x3,y3),D(x4,y4),E(x5,y5)) with respect to another set of coord points (i(x1,y1),j(x2,y2),k(x3,y3),l(x4,y4),m(x5,y5)).
I hope you understand what I am trying to interpret.
Can anybody help me out?
Public Function DoSearch(ByVal SearchCritera As Bracket, ByVal ListToSearchFrom As System.Collections.Generic.List(Of TRacksDefinitions.Racks.Bracket)) As System.Collections.Generic.List(Of TRacksDefinitions.Search.SearchBracket) Implements TRacksDefinitions.Search.ISearch.DoSearch
_results.Clear()
For Each b As Bracket In ListToSearchFrom
'LAST POINT DISTANCE., WT DIST, number of points, similarity of points (-1 if not used),
Dim dist() As Double = {0, 0, 0, 0, 0}
Dim dx As Double = b.RearPoints(b.RearPoints.Length - 2).X - SearchCritera.RearPoints(SearchCritera.RearPoints.Length - 2).X
Dim dy As Double = b.RearPoints(b.RearPoints.Length - 2).Y - SearchCritera.RearPoints(SearchCritera.RearPoints.Length - 2).Y
Dim dz As Double = b.RearPoints(b.RearPoints.Length - 2).Z - SearchCritera.RearPoints(SearchCritera.RearPoints.Length - 2).Z
dist(0) += Math.Sqrt(dx ^ 2 + dy ^ 2 + dz ^ 2)
dist(1) += Math.Abs(SearchCritera.Wallthickness - b.Wallthickness)
dist(2) += Math.Abs(SearchCritera.RearPoints.Count - b.RearPoints.Count)
If SearchCritera.RearPoints.Count = b.RearPoints.Count Then
Dim d1, d2 As Decimal
' Dim sum As Double = 0
For i As Integer = 0 To b.RearPoints.Count - 1
d1 = Math.Abs(SearchCritera.RearPoints(i).X - b.RearPoints(i).X)
d2 = Math.Abs(SearchCritera.RearPoints(i).Y - b.RearPoints(i).Y)
?????????????????
Next
Else
dist(3) = -1
End If
#LarsTech
The above is code which I have created until now and the next step is calculating the min distance criteria.
Search criteria: rear points is the one we get from solidworks and b.rearpoints is the one present in database we compare both of them find the one which is very similar to the one in database.
You need a distance formula:
Public Function GetDistance(ByVal startPoint As Point, ByVal endPoint As Point) As Integer
Return Math.Sqrt((Math.Abs(endPoint.X - startPoint.X) ^ 2) + _
(Math.Abs(endPoint.Y - startPoint.Y) ^ 2))
End Function
Then you just need to loop through all of your points to find which distance is the smallest:
Dim listOne As New List(Of Point)
listOne.Add(New Point(10, 10))
listOne.Add(New Point(20, 20))
listOne.Add(New Point(30, 30))
listOne.Add(New Point(40, 40))
listOne.Add(New Point(50, 50))
Dim listTwo As New List(Of Point)
listTwo.Add(New Point(50, 10))
listTwo.Add(New Point(50, 20))
listTwo.Add(New Point(50, 30))
listTwo.Add(New Point(50, 40))
'listTwo.Add(New Point(50, 50))
Dim minDistance As Nullable(Of Integer)
For Each p1 As Point In listOne
For Each p2 As Point In listTwo
Dim distance As Integer = GetDistance(p1, p2)
If minDistance Is Nothing OrElse distance < minDistance Then
minDistance = distance
End If
Next
Next
MessageBox.Show("Minimum Distance = " & minDistance.ToString)
In two dimensions, depending upon the distribution of the points, if N exceeds 9, it may make sense to partition the space into int(sqrt(N)-1)^2 identically-sized "boxes". If any box contains more than a hundred or so points, randomly pick ten or so points from the most populous box, find the smallest distance between any pair, and then repartition with a box size of either that smallest distance or a box size reduced by a factor of int(sqrt(k)-1) where k is the population of that box [if a box contains that many points, there must be two within that fraction of the box size.
In the worst case this algorithm could perform badly, since there could be a very dense concentration of points that somehow never get arbitrarily chosen for the distance test, and it could take awhile before the space gets subdivided finely enough to separate them. In practice, however, the points would likely get chosen at some point, allowing the collection to get quickly subdivided.