VERSION 5.00 Begin VB.Form frmOpslaan BorderStyle = 1 'Fixed Single Caption = "Opslaan" ClientHeight = 6945 ClientLeft = 45 ClientTop = 435 ClientWidth = 11280 ClipControls = 0 'False Icon = "frmOpslaan.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6945 ScaleWidth = 11280 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame1 Caption = "Selecteer de doellocatie" Height = 6735 Left = 120 TabIndex = 0 Top = 120 Width = 11055 Begin VB.CommandButton cmdTerug Caption = "Ga terug naar het Edit-scherm" Height = 495 Left = 6000 TabIndex = 12 Top = 6120 Width = 4815 End Begin VB.TextBox txtLogBestand Height = 375 Left = 6000 TabIndex = 10 Text = "output_verwijderde_profielen.csv" Top = 4080 Width = 4815 End Begin VB.TextBox txtWaterspanningen Height = 375 Left = 6000 TabIndex = 5 Text = "output_knooppunten.csv" Top = 3240 Width = 4815 End Begin VB.TextBox txtProfielen Height = 375 Left = 6000 TabIndex = 4 Text = "output_profiel.csv" Top = 2400 Width = 4815 End Begin VB.CommandButton cmdStop Caption = "Stop" Height = 495 Left = 6000 TabIndex = 7 Top = 5400 Width = 4815 End Begin VB.DirListBox Dir1 Height = 5940 Left = 120 TabIndex = 2 ToolTipText = "Selecteer hier de map" Top = 720 Width = 5655 End Begin VB.DriveListBox Drive1 Height = 315 Left = 120 TabIndex = 1 ToolTipText = "Selecteer hier de (netwerk) drive" Top = 360 Width = 5655 End Begin VB.FileListBox File1 Height = 1650 Left = 6000 Pattern = "*.txt;*.xyz;*.asc;*.csv" TabIndex = 3 ToolTipText = "Selecteer hier het bestand" Top = 360 Width = 4815 End Begin VB.CommandButton cmdOpslaan Caption = "Opslaan" Height = 495 Left = 6000 TabIndex = 6 Top = 4680 Width = 4815 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Naam logbestand:" Height = 195 Left = 6000 TabIndex = 11 Top = 3840 Width = 1290 End Begin VB.Label Label2 Caption = "Naam doelbestand knooppunten:" Height = 255 Left = 6000 TabIndex = 9 Top = 3000 Width = 3495 End Begin VB.Label Label1 Caption = "Naam doelbestand profielen:" Height = 255 Left = 6000 TabIndex = 8 Top = 2160 Width = 3255 End End End Attribute VB_Name = "frmOpslaan" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub cmdOpslaan_Click() 'Declareer locale variabelen Dim tellerEen, tellerTwee, tellerDrie, tellerVier, aantalPuntenRegel As Long Dim directoryPathPL, directoryPathProfiel, directoryPathLogBestand, outputProfiel, outputPL, tempVarPL, tempVarProfiel, outputLogBestand Dim xOld, yOld, xNew, yNew As Double Dim i As Integer Dim header1, header2 As String 'Tijdelijke variabelen om de header samen te stellen 'Set trap On Error GoTo errorHandler 'Bewaar de geselecteerde bestandsnaam outputProfiel = txtProfielen.Text outputPL = txtWaterspanningen.Text outputLogBestand = txtLogBestand.Text directoryPathProfiel = File1.Path + "\" + outputProfiel directoryPathPL = File1.Path + "\" + outputPL directoryPathLogBestand = File1.Path + "\" + outputLogBestand 'Tijdelijke code om resultaat in bestand te laten zien Open directoryPathProfiel For Output As #1 Open directoryPathPL For Output As #2 header1 = "Profielnaam;X_Maaiveld binnenwaarts;Y_Maaiveld binnenwaarts;Z_Maaiveld binnenwaarts;X_Insteek sloot polderzijde;Y_Insteek sloot polderzijde;Z_Insteek sloot polderzijde;X_Slootbodem polderzijde;Y_Slootbodem polderzijde;Z_Slootbodem polderzijde;X_Slootbodem dijkzijde;Y_Slootbodem dijkzijde;Z_Slootbodem dijkzijde;X_Insteek sloot dijkzijde;Y_Insteek_sloot dijkzijde;Z_Insteek sloot dijkzijde;X_Teen dijk binnenwaarts;Y_Teen dijk binnenwaarts;Z_Teen dijk binnenwaarts;X_Kruin binnenberm;Y_Kruin binnenberm;Z_Kruin binnenberm;X_Insteek binnenberm;Y_Insteek binnenberm;Z_Insteek binnenberm;X_Kruin binnentalud;Y_Kruin binnentalud;Z_Kruin binnentalud;X_Verkeersbelasting kant binnenwaarts;Y_Verkeersbelasting kant binnenwaarts;Z_Verkeersbelasting kant binnenwaarts;" header2 = "X_Verkeersbelasting kant buitenwaarts;Y_Verkeersbelasting kant buitenwaarts;Z_Verkeersbelasting kant buitenwaarts;X_Kruin buitentalud;Y_Kruin buitentalud;Z_Kruin buitentalud;X_Insteek buitenberm;Y_Insteek buitenberm;Z_Insteek buitenberm;X_Kruin buitenberm;Y_Kruin buitenberm;Z_Kruin buitenberm;X_Teen dijk buitenwaarts;Y_Teen dijk buitenwaarts;Z_Teen dijk buitenwaarts;X_Maaiveld buitenwaarts;Y_Maaiveld buitenwaarts;Z_Maaiveld buitenwaarts;X_Dijktafelhoogte;Y_Dijktafelhoogte;Z_Dijktafelhoogte;Volgnummer" Print #1, "Profielnaam;Geologischprofiel;X_GridPoint;Y_GridPoint;ScenarioClusterID;X1;Y1;Z1;.....;Xn;Yn;Zn;(Profiel)" Print #2, header1 & header2 For tellerEen = 1 To aantalProfielen 'Controleer of het profiel verwijderd moet worden bij het opslaan If arrayProcessLog(tellerEen, 2) = "FALSE" Then 'Schrijf profielregel weg For tellerTwee = 1 To totaalAantalKolommen If arrayProfielen(tellerEen, tellerTwee) = "" Then Exit For If tempVarProfiel = "" Then tempVarProfiel = arrayProfielen(tellerEen, tellerTwee) & ";" & arrayGeologischProfiel(tellerEen) & ";" & Format(arrayKnooppunten(tellerEen, 26), "0.000") & ";" & Format(arrayKnooppunten(tellerEen, 27), "0.000") & ";" & (volgNummer + tellerEen - 1) Else If tellerTwee = 2 Then tempVarProfiel = tempVarProfiel & ";" & Format(arrayProfielen(tellerEen, tellerTwee), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 1), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 2), "0.000") 'Bewaar de oude coördinaten xOld = Round(arrayProfielen(tellerEen, tellerTwee), 3) yOld = Round(arrayProfielen(tellerEen, tellerTwee + 1), 3) 'Verhoog tellerTwee met +2 om terug te keren op een x-coördinaat tellerTwee = tellerTwee + 2 Else 'Bewaar de nieuwe coördinaten xNew = Round(arrayProfielen(tellerEen, tellerTwee), 3) yNew = Round(arrayProfielen(tellerEen, tellerTwee + 1), 3) Debug.Print tellerTwee & " Xold = " & xOld & " Yold = " & yOld & " Xnew = " & xNew & " Ynew = " & yNew 'Controleer of het punt niet hetzelfde is als het vooraf ingelezen punt If xNew = xOld Then If yNew = yOld Then 'Coordinaat is hetzelfde schrijf deze niet weg 'Toon waarschwuing i = MsgBox("Profiel " & arrayProfielen(tellerEen, 1) & " bevat een dubbel punt." & Chr$(13) & "xOld = " & xOld & " = xNew " & xNew & Chr$(13) & "yOld = " & yOld & " = yNew = " & yNew & Chr$(13) & "Het punt wordt niet meegenomen in het profielenbestand", vbCritical, "Melding") 'Verhoog tellerTwee met +2 om terug te keren op een x-coördinaat tellerTwee = tellerTwee + 2 Else 'Coördinaat is niet hetzelfde, schrijf deze weg tempVarProfiel = tempVarProfiel & ";" & Format(arrayProfielen(tellerEen, tellerTwee), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 1), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 2), "0.000") 'Verhoog tellerTwee met +2 om terug te keren op een x-coördinaat tellerTwee = tellerTwee + 2 'Bewaar de oude coördinaten xOld = xNew yOld = yNew End If Else 'Coördinaat is niet hetzelfde, schrijf deze weg tempVarProfiel = tempVarProfiel & ";" & Format(arrayProfielen(tellerEen, tellerTwee), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 1), "0.000") & ";" & Format(arrayProfielen(tellerEen, tellerTwee + 2), "0.000") 'Verhoog tellerTwee met +2 om terug te keren op een x-coördinaat tellerTwee = tellerTwee + 2 'Bewaar de oude coördinaten xOld = xNew yOld = yNew End If End If End If Next tellerTwee Print #1, tempVarProfiel 'Maak tempVarProfiel weer leeg tempVarProfiel = "" For tellerDrie = 1 To breedteArrayKnooppunten - 3 '-3 omdat de DTH aan het einde van de regel wordt weggeschreven If tempVarPL = "" Then tempVarPL = arrayKnooppunten(tellerEen, tellerDrie) Else tempVarPL = tempVarPL & ";" & Format(arrayKnooppunten(tellerEen, tellerDrie), "0.000") End If Next tellerDrie 'Bewaar ook het volgnummer in het knooppuntenbestand tempVarPL = tempVarPL & ";" & Format(arrayKnooppunten(tellerEen, tellerDrie), "0.000") & ";" & Format(arrayKnooppunten(tellerEen, tellerDrie + 1), "0.000") & ";" & Format(arrayKnooppunten(tellerEen, tellerDrie + 2), "0.000") & ";" & (volgNummer + tellerEen - 1) 'Schrijf de regel weg Print #2, tempVarPL 'Maak tempVarPL weer leeg tempVarPL = "" End If Next tellerEen 'Geef aan dat het opslaan gelukt is 'i = MsgBox("Bestanden zijn opgeslagen. Het nieuwe volgnummer wordt: " & (volgNummer + tellerEen - 1), vbOKOnly, "Bestand opgeslagen") Open directoryPathLogBestand For Output As #3 Print #3, "profielnaam;Profielverwijderd;Opmerkingen" For tellerEen = 1 To aantalProfielen For tellerTwee = 1 To aantalKolommenArrayProcessLog If tellerTwee = 1 Then tempVar = arrayProcessLog(tellerEen, tellerTwee) Else tempVar = tempVar & ";" & arrayProcessLog(tellerEen, tellerTwee) End If Next tellerTwee Print #3, tempVar Next tellerEen Close #3 'Sluit de bestanden Close #1 Close #2 Close #3 'Activeer de stopknop cmdStop.Enabled = True 'Voorkom dat onnodig de errorHanlder wordt uitgevoerd Exit Sub 'Trap errorHandler: 'Toon waarschuwing i = MsgBox("Fout bij het opslaan, controleer bestandsnaam", vbCritical, "Fout!") 'sluit bestanden Close #1 Close #2 End Sub Private Sub cmdStop_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u wilt stoppen?", vbYesNo, "Let op!") If i = vbYes Then 'Stop het programma End End If End Sub Private Sub cmdTerug_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u naar het Edit scherm wilt?", vbYesNo, "Let op!") If i = vbYes Then 'Sluit het huidige scherm en open het scherm opslaan frmOpslaan.Show frmPL.Show End If End Sub Private Sub Dir1_Change() 'Update de file structuur als het path wordt veranderd File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() Dim i As Integer Dim tempDrive 'Set error trap On Error GoTo errorHandler 'Update de dir structuur als de drive wordt veranderd Dir1.Path = Drive1.Drive 'Voorkom dat de errorHandler zonder reden wordt uitgevoerd Exit Sub 'Trap errorHandler: 'Toon waarschuwing i = MsgBox("Kan niet lezen vanaf het geselecteerde station, kies een ander station", vbCritical, "Leesfout!") End Sub Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub Form_Load() 'Toon voorstel voor de bestandsnamen txtProfielen.Text = "surfacelines.csv" txtWaterspanningen.Text = "characteristicpoints.csv" txtLogBestand.Text = "output_DAM_Edit_log.csv" 'Als het aantalverwijderde profielen groter is dan 0, dan kan het log bestan dopgeslagen worden If aantalVerwijderdeProfielen > 0 Then txtLogBestand.Enabled = True End If End Sub