AK_Beaver
03-02-2017, 07:29 PM
So in my land surveying computations class we were asked to create a code that would find the angular misclosure between a set of angles (i.e. if a polygon has three sides the sum of angles should be 180, angular misclosure is whats the difference) and once we find that we need to distribute the error to the angles so that the balanced sum is what it should be (i.e. distribute error so that the angles do actually equal 180). Sorry for the long winded sentence. We are doing this because we are creating codes that once all completed we will be able to calculate a survey traverse. So far I'm doing them on my own but this one I'm completely stumped. My professor lost me and even he is lost. Awesome - I know, right. If anyone can make sense and give me suggestions or even finish it, I'll take either, and be forever thankful. Here's what I have and I'll include other code in it that I've finished and ran. Thanks again.
Function DASH2DD(strDashAngle As String) As Double
'Converts DMS angles in dash format to decimal degrees
'Written by Evan Venechuk
'1/26/2017
Dim dDash1 As Double
Dim dDash2 As Double
Dim dDegree As Double
Dim dMinute As Double
Dim dSecond As Double
'Find position of dashes
dDash1 = WorksheetFunction.Find("-", strDashAngle)
dDash2 = WorksheetFunction.Find("-", strDashAngle, dDash1 + 1)
'Parse DMS
dDegree = Left(strDashAngle, dDash1 - 1)
dMinute = Mid(strDashAngle, dDash1 + 1, dDash2 - dDash1 - 1)
dSecond = Right(strDashAngle, Len(strDashAngle) - dDash2)
'Convert to DD and return value
DASH2DD = dDegree + dMinute / 60 + dSecond / 3600
End Function
Function DD2DASH(dDDAngle As Double) As String
'Converts DD angles to DMS angles in dash format
'Written by Evan Venechuk
'1/31/2017
Dim dDegrees As Double
Dim dMinutes As Double
Dim dSeconds As Double
'Find Degrees
dDegrees = Int(dDDAngle)
'Find Minutes
dMinutes = (dDDAngle - dDegrees) * 60
'Find Seconds
dSeconds = (dMinutes - Int(dMinutes)) * 60
'Convert to DMS in dash form and return value
DD2DASH = Format(dDegrees, "00") & "-" & Format(Int(dMinutes), "00") & "-" & Format(dSeconds, "00")
End Function
The Code I have Trouble With:
Function AngMisclosure(InRange As Range) As String
Dim mycell As Range
Dim strAngle As String
Dim dAngle, dSum, dNumAng, dSumTheory, dMisc, dOneSec As Double
Dim iMyIndex As Integer
dSum = 0
For Each mycell In InRange
strAngle = mycell.Value
dAngle = DASH2DD(strAngle)
dSum = dSum + dAngle
Next mycell
'-------------------------------------
dNumAng = InRange.Count
dSumTheory = (dNumAng - 2) * 180
dMisc = dSum - dSumTheory
'AngMisclosure = DD2DASH(dMisc)
'-------------------------------------
dOneSec = 1# / 3600#
iMyIndex = 1
Do While dMisc > 0#
InRange.Item(iMyIndex) = InRange.Item(iMyIndex) - 1
iMyIndex = iMyIndex + 1
If iMyIndex > dNumAng Then
iMyIndex = 1
End If
Loop
End Function
Function DASH2DD(strDashAngle As String) As Double
'Converts DMS angles in dash format to decimal degrees
'Written by Evan Venechuk
'1/26/2017
Dim dDash1 As Double
Dim dDash2 As Double
Dim dDegree As Double
Dim dMinute As Double
Dim dSecond As Double
'Find position of dashes
dDash1 = WorksheetFunction.Find("-", strDashAngle)
dDash2 = WorksheetFunction.Find("-", strDashAngle, dDash1 + 1)
'Parse DMS
dDegree = Left(strDashAngle, dDash1 - 1)
dMinute = Mid(strDashAngle, dDash1 + 1, dDash2 - dDash1 - 1)
dSecond = Right(strDashAngle, Len(strDashAngle) - dDash2)
'Convert to DD and return value
DASH2DD = dDegree + dMinute / 60 + dSecond / 3600
End Function
Function DD2DASH(dDDAngle As Double) As String
'Converts DD angles to DMS angles in dash format
'Written by Evan Venechuk
'1/31/2017
Dim dDegrees As Double
Dim dMinutes As Double
Dim dSeconds As Double
'Find Degrees
dDegrees = Int(dDDAngle)
'Find Minutes
dMinutes = (dDDAngle - dDegrees) * 60
'Find Seconds
dSeconds = (dMinutes - Int(dMinutes)) * 60
'Convert to DMS in dash form and return value
DD2DASH = Format(dDegrees, "00") & "-" & Format(Int(dMinutes), "00") & "-" & Format(dSeconds, "00")
End Function
The Code I have Trouble With:
Function AngMisclosure(InRange As Range) As String
Dim mycell As Range
Dim strAngle As String
Dim dAngle, dSum, dNumAng, dSumTheory, dMisc, dOneSec As Double
Dim iMyIndex As Integer
dSum = 0
For Each mycell In InRange
strAngle = mycell.Value
dAngle = DASH2DD(strAngle)
dSum = dSum + dAngle
Next mycell
'-------------------------------------
dNumAng = InRange.Count
dSumTheory = (dNumAng - 2) * 180
dMisc = dSum - dSumTheory
'AngMisclosure = DD2DASH(dMisc)
'-------------------------------------
dOneSec = 1# / 3600#
iMyIndex = 1
Do While dMisc > 0#
InRange.Item(iMyIndex) = InRange.Item(iMyIndex) - 1
iMyIndex = iMyIndex + 1
If iMyIndex > dNumAng Then
iMyIndex = 1
End If
Loop
End Function