Transformar Azimutes em Rumos

Olá pessoal!

Desenvolvi um sub onde faço a leitura da poligonal e calculo os azimutes por p1 e p2 e assim por diante. Após eu chamo outra sub que transforma azimutes em rumos. Porém as vezes alguns rumos não estão sendo gerados com precisão.
Alguém poderia analisar o código afim de me ajudar a refinar o mesmo. Ou se está faltando setar algum SETVAR antes de aplicar a sub ?
Desde já agradeço.

Segue o código:

Code:

---

Private Sub UserForm_Initialize()

'----setvars-----------------------------------------
ThisDrawing.SendCommand "LUPREC" & vbCr & "4" & vbCr
ThisDrawing.SendCommand "ANGBASE" & vbCr & "0" & vbCr
ThisDrawing.SendCommand "ANGDIR" & vbCr & "0" & vbCr

End Sub



Sub calcular_azimutes()

On Error GoTo u_azm1

ThisDrawing.SendCommand "ANGBASE" & vbCr & "90" & vbCr
ThisDrawing.SendCommand "ANGDIR" & vbCr & "1" & vbCr
   
Dim startPoint1(0 To 2) As Double
Dim endPoint1(0 To 2) As Double
Dim dblAngle1 As Double
Dim azimute1 As String
Dim posicao1 As Integer
Dim indice1 As Integer
Dim ang1 As String


Conectar
Set rsCAD1.ActiveConnection = dbcon
rsCAD1.Open "select * from cad_1_pontos", dbcon, adOpenStatic, adLockOptimistic
rsCAD1.Filter = "id= '" & lblId.Caption & "'"

indice1 = CInt(lblTot.Caption)


Do Until rsCAD1.EOF

  For posicao1 = 1 To indice1

    rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & posicao1 & "'"
    startPoint1(0) = rsCAD1.Fields("este")
    startPoint1(1) = rsCAD1.Fields("norte")
    startPoint1(2) = 0

    rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & posicao1 + 1 & "'"
    endPoint1(0) = rsCAD1.Fields("este")
    endPoint1(1) = rsCAD1.Fields("norte")
    endPoint1(2) = 0

    dblAngle1 = ThisDrawing.Utility.AngleFromXAxis(startPoint1, endPoint1)
    azimute1 = ThisDrawing.Utility.AngleToString(dblAngle1, acDegreeMinuteSeconds, 3)

    ''capturando somente o ângulo
    ang1 = ThisDrawing.Utility.AngleToString(dblAngle1, acDegrees, 1)

    rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & posicao1 & "'"
   
    rsCAD1.Fields("decimal") = Replace(Replace(Replace(azimute1, "d", ","), "'", ""), """", "")
    azimute1 = Replace(azimute1, "d", "°")
    rsCAD1.Fields("azimute") = azimute1
    ang1 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(ang1, ".0", ""), ".1", ""), ".2", ""), ".3", ""), ".4", ""), ".5", ""), ".6", ""), ".7", ""), ".8", ""), ".9", "")
    rsCAD1.Fields("ang") = ang1
    'rsCAD1.Update
    'MsgBox azimute1 & "  " & ang1
  Next

rsCAD1.MoveNext
Loop


u_azm1:

        Dim startP1(0 To 2) As Double
        Dim endP1(0 To 2) As Double
        Dim dblAng1 As Double
        Dim ang2 As String
        Dim azi1 As String

    If Err.Number <> 0 Then
        ' pegando a primeira e última coordenada

        rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & posicao1 & "'"
        startP1(0) = rsCAD1.Fields("este")
        startP1(1) = rsCAD1.Fields("norte")
        startP1(2) = 0

        rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & 1 & "'"
        endP1(0) = rsCAD1.Fields("este")
        endP1(1) = rsCAD1.Fields("norte")
        endP1(2) = 0

        dblAng1 = ThisDrawing.Utility.AngleFromXAxis(startP1, endP1)
        azi1 = ThisDrawing.Utility.AngleToString(dblAng1, acDegreeMinuteSeconds, 3)

        ''capturando somente o ângulo
        ang2 = ThisDrawing.Utility.AngleToString(dblAng1, acDegrees, 1)


        rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & posicao1 & "'"
       
        rsCAD1.Fields("decimal") = Replace(Replace(Replace(azi1, "d", ","), "'", ""), """", "")
        azi1 = Replace(azi1, "d", "°")
        rsCAD1.Fields("azimute") = azi1
        ang2 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(ang2, ".0", ""), ".1", ""), ".2", ""), ".3", ""), ".4", ""), ".5", ""), ".6", ""), ".7", ""), ".8", ""), ".9", "")
        rsCAD1.Fields("ang") = ang2
        'MsgBox azi1 & "  " & ang2

    End If
    rsCAD1.Update

ThisDrawing.Regen acActiveViewport

End Sub



Sub calcular_rumos()

Dim tot As Integer
Dim indice As Integer
Dim azm As Variant
Dim xang As Variant


Conectar
Set rsCAD1.ActiveConnection = dbcon
rsCAD1.Open "select * from cad_1_pontos", dbcon, adOpenStatic, adLockOptimistic
rsCAD1.Filter = "id= '" & lblId.Caption & "'"

tot = lblTot.Caption


For indice = 1 To tot

    rsCAD1.Filter = "id= '" & lblId.Caption & "' and ponto= '" & indice & "'"
   
   
    azm = rsCAD1.Fields("azimute")
    xang = rsCAD1.Fields("ang")

    If xang >= 0 And xang <= 90 Then
      rumo = rsCAD1.Fields("azimute") & "NE"
      rsCAD1.Fields("rumo") = rumo
      rsCAD1.Update
    End If

    If xang > 90 And xang <= 180 Then
      dvalor = rsCAD1.Fields("decimal")
      rumo = (180 - dvalor)
      rumo = Replace(Format(rumo, "##,##,##00.00'00''"), ",", ChrW(176))
      rsCAD1.Fields("rumo") = rumo & "SE"
      rsCAD1.Update
    End If

    If xang > 180 And xang < 270 Then
      dvalor = rsCAD1.Fields("decimal")
      rumo = (dvalor - 180)
      rumo = Replace(Format(rumo, "##,##,##00.00'00''"), ",", ChrW(176))
      rsCAD1.Fields("rumo") = rumo & "SO"
      rsCAD1.Update
    End If

    If xang > 270 And xang < 360 Then
      dvalor = rsCAD1.Fields("decimal")
      rumo = (360 - dvalor)
      rumo = Replace(Format(rumo, "##,##,##00.00'00''"), ",", ChrW(176))
      rsCAD1.Fields("rumo") = rumo & "NO"
      rsCAD1.Update
    End If

Next


End Sub

---