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