CAcertaZsDosNos.cls 2.9 KB
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAcertaZsDosNos"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Classe responsável por acertar todos os z's dos nós das redes de água
'
'
'

Private getZNo As New CObtemZdoNo
' Subrotina que atribui a cota Z a todos os nós das redes
'
'
'
Public Sub AtribuiZs()
    On Error GoTo Trata_Erro
    Dim RSNos As ADODB.Recordset
    Dim rsAtributoNos As ADODB.Recordset
    Dim xNo As Double
    Dim yNo As Double
    Dim objIdNo As String
    Dim zNo As Double
    Dim retorno As Boolean
    Dim zNoStr As String                                                    'coordenada Z do no convertida para string. Isso para tratar a virgula que o SQL nao permite no UPDATE
    
    Screen.MousePointer = vbHourglass
    Set RSNos = New ADODB.Recordset
    RSNos.Open "Select x, y, object_id from Points2", Conn, adOpenKeyset, adLockOptimistic
    retorno = cGeoDatabase.geoDatabase.setCurrentLayer("mdt")                                                       'ativa o layer do MDT
    If retorno = False Then
        Screen.MousePointer = vbNormal
        MsgBox ("É necesário antes de iniciar esta operação abrir uma vista do mapa.")
        Exit Sub
    End If
    Do While RSNos.EOF = False
        DoEvents                                                            'para o VB poder escutar o timer e poder parar o processamento caso a tecla ESC tenha sido pressionada
        If varGlobais.pararExecucao = True Then
            varGlobais.pararExecucao = False
            Screen.MousePointer = vbNormal
            Exit Sub
        End If
        xNo = RSNos("x").value
        yNo = RSNos("y").value
        objIdNo = RSNos("object_id").value
        zNo = getZNo.ObtemZ(xNo, yNo, objIdNo)
        RSNos.MoveNext
        Set rsAtributoNos = New ADODB.Recordset
        rsAtributoNos.Open "SELECT GROUNDHEIGHT FROM WATERCOMPONENTS WHERE OBJECT_ID_ = " & objIdNo, Conn, adOpenKeyset, adLockOptimistic
        FrmMain.sbStatusBar.Panels(2).Text = " Z nó água " & objIdNo & " calculado = " & zNo & " "
        rsAtributoNos.Close
        zNoStr = CStr(zNo)                          'converte a cota do no para string para poder atualizar no SQL como ponto
        zNoStr = Replace(zNoStr, ",", ".")          'troca a vírgula por ponto
        Conn.execute "UPDATE WATERCOMPONENTS SET GROUNDHEIGHT = " & zNoStr & " WHERE OBJECT_ID_ = " & objIdNo
    Loop
    Screen.MousePointer = vbNormalObtemZ
    Exit Sub
    
Trata_Erro:
    If Err.Number = 0 Or Err.Number = 20 Then
        Resume Next
    Else
        Screen.MousePointer = vbNormal
        ErroUsuario.Registra "CAcertaZsDosNos", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), False, False
    End If
End Sub