Results 1 to 1 of 1

Thread: Transformar Azimutes em Rumos

  1. #1
    Login to Give a bone
    0

    Default 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
    Last edited by Ed Jobe; 2019-01-30 at 07:35 PM.

Similar Threads

  1. Replies: 2
    Last Post: 2012-03-22, 02:20 PM
  2. Como transformar um texto do AutoCAD em 3D
    By Brogueira-CADptbr in forum AutoCAD General
    Replies: 0
    Last Post: 2007-07-18, 11:28 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •