Implementada a atribuição de cotas nas redes de esgoto. Retirado aviso da tela o…

…nde não encontra MDT para calcular cotas. Mostra aviso no GeoSanlogErro.txt

Implementada a atribuição de cotas nas redes de esgoto. Retirado aviso da tela o…
…nde não encontra MDT para calcular cotas. Mostra aviso no GeoSanlogErro.txt
José Maria Villac Pinheiro
1 parent 552061af
Showing 10 changed files with 96 additions and 28 deletions Show diff stats
install/GeraSetupGeoSan/Codigo Gerador Instalador Geosan com TerraComponents.iss
trunk/Controles/variaveisGlobais.txt
trunk/Forms/frmMain.frm
trunk/GeoSan.vbp
trunk/GeoSan.vbw
trunk/Modules/Global.bas
trunk/Projeto_PManager4/PManager4.vbw
trunk/classes/CAcertaZsDosNos.cls
trunk/classes/CAcertaZsDosNosEsgoto.cls
trunk/classes/CObtemZdoNo.cls
 #define SetupBaseName   "SetupGeoSan-v."
-#define AppVersionFile  "08.01.01"
+#define AppVersionFile  "08.02.00"
  
 [Setup]
 AppName=GeoSan
@@ -1014,7 +1014,7 @@ Begin VB.MDIForm FrmMain
          Caption         =   "Exporta consumidores, redes, ramais e nós no formato .shp"
       End
       Begin VB.Menu mnuAtualizaCotas 
-         Caption         =   "Atualiza todas as cotas de todos os nós"
+         Caption         =   "Atualiza todas cotas dos nós de água e esgoto"
       End
       Begin VB.Menu mnuAutoLogin 
          Caption         =   "Logar Automaticamente"
@@ -1450,11 +1450,14 @@ End Sub
 '
 Private Sub mnuAtualizaCotas_Click()
      Dim setaZs As New CAcertaZsDosNos
+     Dim setaZsNosEsgoto as New CAcertaZsDosNosEsgoto
  
      varGlobais.pararExecucao = False               'indica que iniciará sem sem informar que deverá parar a execução
      FrmMain.Timer1.Enabled = True                  'habilita o timer
-     setaZs.AtribuiZs                               'chama método para atualizar todas as cotas da cidade toda
+     setaZs.AtribuiZs                               'chama método para atualizar todas as cotas das redes de água da cidade toda
+     setaZsNosEsgoto.AtribuiZs                      'chama método para atualizar todas as cotas das redes de esgoto da cidade toda
      FrmMain.Timer1.Enabled = False                 'deshabilita o timer
+     FrmMain.sbStatusBar.Panels(2).Text = "Fim dos cálculos"
 End Sub
  
 Private Sub mnuAtualizaNumCasaGps_Click()
@@ -140,6 +140,7 @@ Class=clsConsumidorModel; classes\clsConsumidorModel.cls
 Class=clsConsumidorControler; classes\clsConsumidorControler.cls
 Object={F03ABD98-7B60-43E4-9934-DA5F0D19FDAC}#1.0#0; TeComViewManager.dll
 ResFile32="GeoSan.RES"
+Class=CAcertaZsDosNosEsgoto; classes\CAcertaZsDosNosEsgoto.cls
 IconForm="FrmMain"
 Startup="Sub Main"
 HelpFile=""
@@ -5,7 +5,7 @@ frmAbout = 0, 0, 0, 0, C, 154, 154, 1273, 886, C
 FrmTypes = 0, 0, 0, 0, C, 176, 176, 1295, 908, C
 FrmMain = 16, 71, 1497, 969, C, 139, 12, 1258, 744, C
 FrmAssociation = 35, 68, 1273, 637, C, 220, 220, 1339, 952, C
-FrmCadastroRamal = 63, 13, 1453, 868, Z, 45, 39, 1164, 771, C
+FrmCadastroRamal = 63, 13, 1453, 868, C, 45, 39, 1164, 771, C
 frmCadastroRamalFiltro = 100, 100, 1246, 731, C, 264, 264, 1383, 996, C
 frmCanvas = 12, 33, 1492, 898, C, 110, 110, 1229, 842, C
 frmConsumidoresDesabastecidos = 110, 110, 1229, 842, C, 308, 308, 1427, 1040, C
@@ -84,7 +84,7 @@ CViewDatabase = 93, 254, 1219, 987, C
 CDistRamalInicioTrecho = 0, 0, 0, 0, C
 CCoordIniRamalDistTrecho = 0, 0, 0, 0, C
 CEmail = 0, 0, 0, 0, C
-CArquivo = 0, 0, 0, 0, C
+CArquivo = 50, 50, 1301, 607, C
 CIntBilinear = 0, 0, 0, 0, C
 CObtemZdoNo = 0, 0, 0, 0, C
 CAcertaZsDosNos = 125, 125, 785, 625, C
@@ -99,3 +99,4 @@ clsRamalModel = 225, 225, 1371, 856, C
 clsRamalController = 156, 128, 1302, 759, C
 clsConsumidorModel = 0, 0, 0, 0, C
 clsConsumidorControler = 100, 100, 1246, 731, C
+CAcertaZsDosNosEsgoto = 48, 29, 1322, 501, 
@@ -201,7 +201,7 @@ Public Sub Main()
     End If
     'Configura a versão atual do GeoSan
     Versao_Geo = App.Major & "." & App.Minor & "." & App.Revision
-    Versao_Geo = "08.01.01"
+    Versao_Geo = "08.02.00"
     glo.diretorioGeoSan = App.path                                                                  'salva globalmente o caminho onde encontra-se o GeoSan.exe
     SaveLoadGlobalData glo.diretorioGeoSan + "/controles/variaveisGlobais.txt", True                'salva em um arquivo todas as variáveis globais para poderem ser acessadas por outras aplicações
     connn = ""
-ClsAttributes = 88, 116, 785, 604, C
+ClsAttributes = 113, 40, 1299, 759, C
 CItens = 402, 85, 1099, 643, C
-Manager = 158, 24, 1466, 989, , 291, 115, 996, 614, C
-mdlQuerys = 86, 71, 1375, 940, C
+Manager = 16, 13, 1449, 841, , 291, 115, 996, 614, C
+mdlQuerys = 90, 2, 1379, 871, 
@@ -29,22 +29,12 @@ Public Sub AtribuiZs()
     Dim yNo As Double
     Dim objIdNo As String
     Dim zNo As Double
-    Dim diretorio As String                                                 'Diretório onde será salva a exportação das cotas calculadas para conferir a anterior com a nova
     Dim retorno As Boolean
-    Dim arquivoExportacao As String                                         'nome do arquivo junto com o diretório onde serão exportadas as cotas para conferência
     Dim zNoStr As String                                                    'coordenada Z do no convertida para string. Isso para tratar a virgula que o SQL nao permite no UPDATE
  
-    diretorio = arquivo.SelecionaDiretorio
-    If diretorio = "falhou" Then
-        Screen.MousePointer = vbNormal
-        Exit Sub
-    End If
     Screen.MousePointer = vbHourglass
     Set RSNos = New ADODB.Recordset
     RSNos.Open "Select x, y, object_id from Points2", Conn, adOpenKeyset, adLockOptimistic
-    arquivoExportacao = diretorio & "\GeoSan_atualização_cotas.txt"
-    Open arquivoExportacao For Output As #10                                                                            'Abre o arquivo novo
-    Close #10
     retorno = cGeoDatabase.geoDatabase.setCurrentLayer("mdt")                                                       'ativa o layer do MDT
     If retorno = False Then
         Screen.MousePointer = vbNormal
@@ -65,16 +55,12 @@ Public Sub AtribuiZs()
         RSNos.MoveNext
         Set rsAtributoNos = New ADODB.Recordset
         rsAtributoNos.Open "SELECT GROUNDHEIGHT FROM WATERCOMPONENTS WHERE OBJECT_ID_ = " & objIdNo, Conn, adOpenKeyset, adLockOptimistic
-        Open arquivoExportacao For Append As #10
-        Print #10, objIdNo & " , " & xNo & " , " & yNo & " , " & rsAtributoNos.Fields("GROUNDHEIGHT").value & " , " & CStr(zNo)
-        Close #10
-        FrmMain.sbStatusBar.Panels(2).Text = "Z nó " & objIdNo & " calculado = " & zNo
+        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
-    Close #10
     Screen.MousePointer = vbNormalObtemZ
     Exit Sub
  
@@ -83,7 +69,7 @@ Trata_Erro:
         Resume Next
     Else
         Screen.MousePointer = vbNormal
-        ErroUsuario.Registra "CAcertaZsDosNos", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
+        ErroUsuario.Registra "CAcertaZsDosNos", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), False, False
     End If
 End Sub
  
@@ -0,0 +1,77 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "CAcertaZsDosNosEsgoto"
+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 Points4", Conn, adOpenKeyset, adLockOptimistic
+    arquivoExportacao = diretorio & "\GeoSan_atualização_cotas_esgoto.txt"
+    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 SEWERCOMPONENTS WHERE OBJECT_ID_ = " & objIdNo, Conn, adOpenKeyset, adLockOptimistic
+        FrmMain.sbStatusBar.Panels(2).Text = " Z nó esgoto " & 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 SEWERCOMPONENTS 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 "CAcertaZsDosNosEsgoto", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), False, False
+    End If
+End Sub
+
+
@@ -140,7 +140,7 @@ Public Function ObtemZ(xNo As Double, yNo As Double, object_Id_No As String) As 
     'obtem agora as cotas dos 4 pontos do MDT
     mensagemDeErro = mensagemDeErro + "Nó com obj_id = " & object_Id_No & " coord. x = " & CStr(Round(xNo, 2)) & " coord. y = " & CStr(Round(yNo, 2)) & "MDT com obj_ids: ObjId1 = " & idObjPonto1 & ", ObjId2 = " & idObjPonto2 & ", ObjId3 = " & idObjPonto3 & ", ObjId4 = " & idObjPonto4
     If idObjPonto1 = Null Or idObjPonto2 = Null Or idObjPonto3 = Null Or idObjPonto4 = Null Then                                        'verifica se ele encontrou os nós do MDT, pois se não encontra não adianta realizar o cálculo
-        ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, glo.enviaEmails, mensagemDeErro   'não exibe mensagem para o usuário
+        ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, False, mensagemDeErro             'não exibe mensagem para o usuário
         ObtemZ = 0                                                                                                                      'retorna sem calcular a cota Z
     Else                                                                                                                                'encontrou
         rs.Open "SELECT * from MDT where " & nomeColunaObjIdMdt & " = " & idObjPonto1, Conn, adOpenKeyset, adLockOptimistic
@@ -176,7 +176,7 @@ Trata_Erro:
     If Err.Number = 0 Or Err.Number = 20 Then
     Resume Next
     Else
-    ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails, mensagemDeErro
+    ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, False, mensagemDeErro
     End If
 End Function
 ' Obtem o z de um nó a partir do Object_id do nó
@@ -214,6 +214,6 @@ Trata_Erro:
     If Err.Number = 0 Or Err.Number = 20 Then
         Resume Next
     Else
-        ErroUsuario.Registra "CObtemZdoNo", "CObtemZFromObjIdNo", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
+        ErroUsuario.Registra "CObtemZdoNo", "CObtemZFromObjIdNo", CStr(Err.Number), CStr(Err.Description), False, False
     End If
 End Function
1	1	#define SetupBaseName "SetupGeoSan-v."
2		-#define AppVersionFile "08.01.01"
	2	+#define AppVersionFile "08.02.00"
3	3
4	4	[Setup]
5	5	AppName=GeoSan
...	...
...	...	@@ -1014,7 +1014,7 @@ Begin VB.MDIForm FrmMain
1014	1014	Caption = "Exporta consumidores, redes, ramais e nós no formato .shp"
1015	1015	End
1016	1016	Begin VB.Menu mnuAtualizaCotas
1017		- Caption = "Atualiza todas as cotas de todos os nós"
	1017	+ Caption = "Atualiza todas cotas dos nós de água e esgoto"
1018	1018	End
1019	1019	Begin VB.Menu mnuAutoLogin
1020	1020	Caption = "Logar Automaticamente"
...	...	@@ -1450,11 +1450,14 @@ End Sub
1450	1450	'
1451	1451	Private Sub mnuAtualizaCotas_Click()
1452	1452	Dim setaZs As New CAcertaZsDosNos
	1453	+ Dim setaZsNosEsgoto as New CAcertaZsDosNosEsgoto
1453	1454
1454	1455	varGlobais.pararExecucao = False 'indica que iniciará sem sem informar que deverá parar a execução
1455	1456	FrmMain.Timer1.Enabled = True 'habilita o timer
1456		- setaZs.AtribuiZs 'chama método para atualizar todas as cotas da cidade toda
	1457	+ setaZs.AtribuiZs 'chama método para atualizar todas as cotas das redes de água da cidade toda
	1458	+ setaZsNosEsgoto.AtribuiZs 'chama método para atualizar todas as cotas das redes de esgoto da cidade toda
1457	1459	FrmMain.Timer1.Enabled = False 'deshabilita o timer
	1460	+ FrmMain.sbStatusBar.Panels(2).Text = "Fim dos cálculos"
1458	1461	End Sub
1459	1462
1460	1463	Private Sub mnuAtualizaNumCasaGps_Click()
...	...
...	...	@@ -140,6 +140,7 @@ Class=clsConsumidorModel; classes\clsConsumidorModel.cls
140	140	Class=clsConsumidorControler; classes\clsConsumidorControler.cls
141	141	Object={F03ABD98-7B60-43E4-9934-DA5F0D19FDAC}#1.0#0; TeComViewManager.dll
142	142	ResFile32="GeoSan.RES"
	143	+Class=CAcertaZsDosNosEsgoto; classes\CAcertaZsDosNosEsgoto.cls
143	144	IconForm="FrmMain"
144	145	Startup="Sub Main"
145	146	HelpFile=""
...	...
...	...	@@ -5,7 +5,7 @@ frmAbout = 0, 0, 0, 0, C, 154, 154, 1273, 886, C
5	5	FrmTypes = 0, 0, 0, 0, C, 176, 176, 1295, 908, C
6	6	FrmMain = 16, 71, 1497, 969, C, 139, 12, 1258, 744, C
7	7	FrmAssociation = 35, 68, 1273, 637, C, 220, 220, 1339, 952, C
8		-FrmCadastroRamal = 63, 13, 1453, 868, Z, 45, 39, 1164, 771, C
	8	+FrmCadastroRamal = 63, 13, 1453, 868, C, 45, 39, 1164, 771, C
9	9	frmCadastroRamalFiltro = 100, 100, 1246, 731, C, 264, 264, 1383, 996, C
10	10	frmCanvas = 12, 33, 1492, 898, C, 110, 110, 1229, 842, C
11	11	frmConsumidoresDesabastecidos = 110, 110, 1229, 842, C, 308, 308, 1427, 1040, C
...	...	@@ -84,7 +84,7 @@ CViewDatabase = 93, 254, 1219, 987, C
84	84	CDistRamalInicioTrecho = 0, 0, 0, 0, C
85	85	CCoordIniRamalDistTrecho = 0, 0, 0, 0, C
86	86	CEmail = 0, 0, 0, 0, C
87		-CArquivo = 0, 0, 0, 0, C
	87	+CArquivo = 50, 50, 1301, 607, C
88	88	CIntBilinear = 0, 0, 0, 0, C
89	89	CObtemZdoNo = 0, 0, 0, 0, C
90	90	CAcertaZsDosNos = 125, 125, 785, 625, C
...	...	@@ -99,3 +99,4 @@ clsRamalModel = 225, 225, 1371, 856, C
99	99	clsRamalController = 156, 128, 1302, 759, C
100	100	clsConsumidorModel = 0, 0, 0, 0, C
101	101	clsConsumidorControler = 100, 100, 1246, 731, C
	102	+CAcertaZsDosNosEsgoto = 48, 29, 1322, 501,
...	...
...	...	@@ -201,7 +201,7 @@ Public Sub Main()
201	201	End If
202	202	'Configura a versão atual do GeoSan
203	203	Versao_Geo = App.Major & "." & App.Minor & "." & App.Revision
204		- Versao_Geo = "08.01.01"
	204	+ Versao_Geo = "08.02.00"
205	205	glo.diretorioGeoSan = App.path 'salva globalmente o caminho onde encontra-se o GeoSan.exe
206	206	SaveLoadGlobalData glo.diretorioGeoSan + "/controles/variaveisGlobais.txt", True 'salva em um arquivo todas as variáveis globais para poderem ser acessadas por outras aplicações
207	207	connn = ""
...	...
1		-ClsAttributes = 88, 116, 785, 604, C
	1	+ClsAttributes = 113, 40, 1299, 759, C
2	2	CItens = 402, 85, 1099, 643, C
3		-Manager = 158, 24, 1466, 989, , 291, 115, 996, 614, C
4		-mdlQuerys = 86, 71, 1375, 940, C
	3	+Manager = 16, 13, 1449, 841, , 291, 115, 996, 614, C
	4	+mdlQuerys = 90, 2, 1379, 871,
...	...
...	...	@@ -29,22 +29,12 @@ Public Sub AtribuiZs()
29	29	Dim yNo As Double
30	30	Dim objIdNo As String
31	31	Dim zNo As Double
32		- Dim diretorio As String 'Diretório onde será salva a exportação das cotas calculadas para conferir a anterior com a nova
33	32	Dim retorno As Boolean
34		- Dim arquivoExportacao As String 'nome do arquivo junto com o diretório onde serão exportadas as cotas para conferência
35	33	Dim zNoStr As String 'coordenada Z do no convertida para string. Isso para tratar a virgula que o SQL nao permite no UPDATE
36	34
37		- diretorio = arquivo.SelecionaDiretorio
38		- If diretorio = "falhou" Then
39		- Screen.MousePointer = vbNormal
40		- Exit Sub
41		- End If
42	35	Screen.MousePointer = vbHourglass
43	36	Set RSNos = New ADODB.Recordset
44	37	RSNos.Open "Select x, y, object_id from Points2", Conn, adOpenKeyset, adLockOptimistic
45		- arquivoExportacao = diretorio & "\GeoSan_atualização_cotas.txt"
46		- Open arquivoExportacao For Output As #10 'Abre o arquivo novo
47		- Close #10
48	38	retorno = cGeoDatabase.geoDatabase.setCurrentLayer("mdt") 'ativa o layer do MDT
49	39	If retorno = False Then
50	40	Screen.MousePointer = vbNormal
...	...	@@ -65,16 +55,12 @@ Public Sub AtribuiZs()
65	55	RSNos.MoveNext
66	56	Set rsAtributoNos = New ADODB.Recordset
67	57	rsAtributoNos.Open "SELECT GROUNDHEIGHT FROM WATERCOMPONENTS WHERE OBJECT_ID_ = " & objIdNo, Conn, adOpenKeyset, adLockOptimistic
68		- Open arquivoExportacao For Append As #10
69		- Print #10, objIdNo & " , " & xNo & " , " & yNo & " , " & rsAtributoNos.Fields("GROUNDHEIGHT").value & " , " & CStr(zNo)
70		- Close #10
71		- FrmMain.sbStatusBar.Panels(2).Text = "Z nó " & objIdNo & " calculado = " & zNo
	58	+ FrmMain.sbStatusBar.Panels(2).Text = " Z nó água " & objIdNo & " calculado = " & zNo & " "
72	59	rsAtributoNos.Close
73	60	zNoStr = CStr(zNo) 'converte a cota do no para string para poder atualizar no SQL como ponto
74	61	zNoStr = Replace(zNoStr, ",", ".") 'troca a vírgula por ponto
75	62	Conn.execute "UPDATE WATERCOMPONENTS SET GROUNDHEIGHT = " & zNoStr & " WHERE OBJECT_ID_ = " & objIdNo
76	63	Loop
77		- Close #10
78	64	Screen.MousePointer = vbNormalObtemZ
79	65	Exit Sub
80	66
...	...	@@ -83,7 +69,7 @@ Trata_Erro:
83	69	Resume Next
84	70	Else
85	71	Screen.MousePointer = vbNormal
86		- ErroUsuario.Registra "CAcertaZsDosNos", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
	72	+ ErroUsuario.Registra "CAcertaZsDosNos", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), False, False
87	73	End If
88	74	End Sub
89	75
...	...
...	...	@@ -0,0 +1,77 @@
	1	+VERSION 1.0 CLASS
	2	+BEGIN
	3	+ MultiUse = -1 'True
	4	+ Persistable = 0 'NotPersistable
	5	+ DataBindingBehavior = 0 'vbNone
	6	+ DataSourceBehavior = 0 'vbNone
	7	+ MTSTransactionMode = 0 'NotAnMTSObject
	8	+END
	9	+Attribute VB_Name = "CAcertaZsDosNosEsgoto"
	10	+Attribute VB_GlobalNameSpace = False
	11	+Attribute VB_Creatable = True
	12	+Attribute VB_PredeclaredId = False
	13	+Attribute VB_Exposed = False
	14	+' Classe responsável por acertar todos os z's dos nós das redes de água
	15	+'
	16	+'
	17	+'
	18	+
	19	+Private getZNo As New CObtemZdoNo
	20	+' Subrotina que atribui a cota Z a todos os nós das redes
	21	+'
	22	+'
	23	+'
	24	+Public Sub AtribuiZs()
	25	+ On Error GoTo Trata_Erro
	26	+ Dim RSNos As ADODB.Recordset
	27	+ Dim rsAtributoNos As ADODB.Recordset
	28	+ Dim xNo As Double
	29	+ Dim yNo As Double
	30	+ Dim objIdNo As String
	31	+ Dim zNo As Double
	32	+ Dim retorno As Boolean
	33	+ Dim zNoStr As String 'coordenada Z do no convertida para string. Isso para tratar a virgula que o SQL nao permite no UPDATE
	34	+
	35	+ Screen.MousePointer = vbHourglass
	36	+ Set RSNos = New ADODB.Recordset
	37	+ RSNos.Open "Select x, y, object_id from Points4", Conn, adOpenKeyset, adLockOptimistic
	38	+ arquivoExportacao = diretorio & "\GeoSan_atualização_cotas_esgoto.txt"
	39	+ retorno = cGeoDatabase.geoDatabase.setCurrentLayer("mdt") 'ativa o layer do MDT
	40	+ If retorno = False Then
	41	+ Screen.MousePointer = vbNormal
	42	+ MsgBox ("É necesário antes de iniciar esta operação abrir uma vista do mapa.")
	43	+ Exit Sub
	44	+ End If
	45	+ Do While RSNos.EOF = False
	46	+ DoEvents 'para o VB poder escutar o timer e poder parar o processamento caso a tecla ESC tenha sido pressionada
	47	+ If varGlobais.pararExecucao = True Then
	48	+ varGlobais.pararExecucao = False
	49	+ Screen.MousePointer = vbNormal
	50	+ Exit Sub
	51	+ End If
	52	+ xNo = RSNos("x").value
	53	+ yNo = RSNos("y").value
	54	+ objIdNo = RSNos("object_id").value
	55	+ zNo = getZNo.ObtemZ(xNo, yNo, objIdNo)
	56	+ RSNos.MoveNext
	57	+ Set rsAtributoNos = New ADODB.Recordset
	58	+ rsAtributoNos.Open "SELECT GROUNDHEIGHT FROM SEWERCOMPONENTS WHERE OBJECT_ID_ = " & objIdNo, Conn, adOpenKeyset, adLockOptimistic
	59	+ FrmMain.sbStatusBar.Panels(2).Text = " Z nó esgoto " & objIdNo & " calculado = " & zNo & " "
	60	+ rsAtributoNos.Close
	61	+ zNoStr = CStr(zNo) 'converte a cota do no para string para poder atualizar no SQL como ponto
	62	+ zNoStr = Replace(zNoStr, ",", ".") 'troca a vírgula por ponto
	63	+ Conn.execute "UPDATE SEWERCOMPONENTS SET GROUNDHEIGHT = " & zNoStr & " WHERE OBJECT_ID_ = " & objIdNo
	64	+ Loop
	65	+ Screen.MousePointer = vbNormalObtemZ
	66	+ Exit Sub
	67	+
	68	+Trata_Erro:
	69	+ If Err.Number = 0 Or Err.Number = 20 Then
	70	+ Resume Next
	71	+ Else
	72	+ Screen.MousePointer = vbNormal
	73	+ ErroUsuario.Registra "CAcertaZsDosNosEsgoto", "AtribuiZs", CStr(Err.Number), CStr(Err.Description), False, False
	74	+ End If
	75	+End Sub
	76	+
	77	+
...	...
...	...	@@ -140,7 +140,7 @@ Public Function ObtemZ(xNo As Double, yNo As Double, object_Id_No As String) As
140	140	'obtem agora as cotas dos 4 pontos do MDT
141	141	mensagemDeErro = mensagemDeErro + "Nó com obj_id = " & object_Id_No & " coord. x = " & CStr(Round(xNo, 2)) & " coord. y = " & CStr(Round(yNo, 2)) & "MDT com obj_ids: ObjId1 = " & idObjPonto1 & ", ObjId2 = " & idObjPonto2 & ", ObjId3 = " & idObjPonto3 & ", ObjId4 = " & idObjPonto4
142	142	If idObjPonto1 = Null Or idObjPonto2 = Null Or idObjPonto3 = Null Or idObjPonto4 = Null Then 'verifica se ele encontrou os nós do MDT, pois se não encontra não adianta realizar o cálculo
143		- ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, glo.enviaEmails, mensagemDeErro 'não exibe mensagem para o usuário
	143	+ ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, False, mensagemDeErro 'não exibe mensagem para o usuário
144	144	ObtemZ = 0 'retorna sem calcular a cota Z
145	145	Else 'encontrou
146	146	rs.Open "SELECT * from MDT where " & nomeColunaObjIdMdt & " = " & idObjPonto1, Conn, adOpenKeyset, adLockOptimistic
...	...	@@ -176,7 +176,7 @@ Trata_Erro:
176	176	If Err.Number = 0 Or Err.Number = 20 Then
177	177	Resume Next
178	178	Else
179		- ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails, mensagemDeErro
	179	+ ErroUsuario.Registra "CObtemZdoNo", "ObtemZ", CStr(Err.Number), CStr(Err.Description), False, False, mensagemDeErro
180	180	End If
181	181	End Function
182	182	' Obtem o z de um nó a partir do Object_id do nó
...	...	@@ -214,6 +214,6 @@ Trata_Erro:
214	214	If Err.Number = 0 Or Err.Number = 20 Then
215	215	Resume Next
216	216	Else
217		- ErroUsuario.Registra "CObtemZdoNo", "CObtemZFromObjIdNo", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
	217	+ ErroUsuario.Registra "CObtemZdoNo", "CObtemZFromObjIdNo", CStr(Err.Number), CStr(Err.Description), False, False
218	218	End If
219	219	End Function
...	...