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