VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmOpslaan BorderStyle = 1 'Fixed Single Caption = "Opslaan" ClientHeight = 5175 ClientLeft = 45 ClientTop = 435 ClientWidth = 11265 ClipControls = 0 'False Icon = "frmOpslaan.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5175 ScaleWidth = 11265 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame4 Caption = "Voortgang opslaan bestanden" Height = 735 Left = 120 TabIndex = 13 Top = 4320 Width = 11055 Begin MSComctlLib.ProgressBar ProgressBar1 Height = 315 Left = 120 TabIndex = 14 Top = 300 Width = 10815 _ExtentX = 19076 _ExtentY = 556 _Version = 393216 Appearance = 1 End End Begin VB.CommandButton cmdTerug Caption = "Ga terug naar het Edit-scherm" Height = 495 Left = 4080 TabIndex = 9 Top = 3600 Width = 3375 End Begin VB.CommandButton cmdStop Caption = "Stop" Height = 495 Left = 7800 TabIndex = 8 Top = 3600 Width = 3375 End Begin VB.CommandButton cmdOpslaan Caption = "Opslaan" Height = 495 Left = 120 TabIndex = 7 Top = 3600 Width = 3375 End Begin MSComDlg.CommonDialog openBestand Left = 11400 Top = 240 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Frame Frame1 Caption = "Selecteer de doellocatie" Height = 3255 Left = 120 TabIndex = 0 Top = 120 Width = 11055 Begin VB.TextBox txtDEDFile Height = 285 Left = 120 TabIndex = 16 Text = "output_verwijderde_profielen.csv" Top = 2040 Width = 10095 End Begin VB.CommandButton cmdLocatieDEDfile Caption = "..." Height = 375 Left = 10320 TabIndex = 15 Top = 1995 Width = 615 End Begin VB.CommandButton cmdLocatieLogfile Caption = "..." Height = 375 Left = 10320 TabIndex = 12 Top = 2715 Width = 615 End Begin VB.CommandButton cmdLocatieKnooppunten Caption = "..." Height = 375 Left = 10320 TabIndex = 11 Top = 1270 Width = 615 End Begin VB.CommandButton cmdLocatieSurfacelines Caption = "..." Height = 375 Left = 10320 TabIndex = 10 Top = 560 Width = 615 End Begin VB.TextBox txtLogBestand Height = 285 Left = 120 TabIndex = 5 Text = "output_verwijderde_profielen.csv" Top = 2760 Width = 10095 End Begin VB.TextBox txtKnooppunten Height = 285 Left = 120 TabIndex = 2 Text = "output_knooppunten.csv" Top = 1320 Width = 10095 End Begin VB.TextBox txtProfielen Height = 285 Left = 120 TabIndex = 1 Text = "output_profiel.csv" Top = 600 Width = 10095 End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Naam DAM Edit Design Database file:" Height = 195 Left = 120 TabIndex = 17 Top = 1800 Width = 2700 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Naam logbestand:" Height = 195 Left = 120 TabIndex = 6 Top = 2520 Width = 1290 End Begin VB.Label Label2 Caption = "Naam doelbestand knooppunten:" Height = 255 Left = 120 TabIndex = 4 Top = 1080 Width = 3495 End Begin VB.Label Label1 Caption = "Naam doelbestand profielen:" Height = 255 Left = 120 TabIndex = 3 Top = 360 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 Function openBestanden(ByVal titleOpenDialog As String, voorstelFilename As String) As String 'Sets the Dialog Title to Open File openBestand.DialogTitle = titleOpenDialog 'Definieer setting file dialog venster 'Sets the File List box to csv files If UCase(Right$(voorstelFilename, 3)) = "DED" Then openBestand.Filter = "DAM Edit Database (*.ded)|*.ded|" Else openBestand.Filter = "DAM Edit Design Output bestand (*.csv)|*.csv" End If 'Set the default files type to csv files openBestand.FilterIndex = 1 openBestand.FileName = voorstelFilename 'Sets the flags - File must exist and Hide Read only openBestand.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly 'Set dialog box so an error occurs if the dialogbox is cancelled openBestand.CancelError = True ' Enables error handling to catch cancel error 'on error Resume Next ' display the dialog box openBestand.ShowSave If Err Then ' This code runs if the dialog was cancelled MsgBox "Geen bestandsnaam geselecteerd" Exit Function End If 'Bewaar de bestandsnaam in de functie variabele openBestanden = openBestand.FileName End Function Private Sub cmdLocatieDEDfile_Click() 'Sets the Dialog Title to Open File titleMenu = "Opslaan DAM Edit Database file" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "DAM_Edit_Database.ded") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtDEDFile.Text = inputBestand End If End Sub Private Sub cmdLocatieKnooppunten_Click() oldInputbestand = txtKnooppunten.Text 'Sets the Dialog Title to Open File titleMenu = "Opslaan DAM Edit Knooppuntenbestand" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "characteristicpoints.csv") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtKnooppunten.Text = inputBestand End If End Sub Private Sub cmdLocatieLogfile_Click() 'Sets the Dialog Title to Open File titleMenu = "Opslaan DAM Edit logbestand" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "output_DAM_Edit_log.csv") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtLogBestand.Text = inputBestand End If End Sub Private Sub cmdLocatieSurfacelines_Click() 'Declareer locale variabele Dim myString As String 'Sets the Dialog Title to Open File titleMenu = "Opslaan DAM Edit profiellijnenbestand" 'Selecteer bronbestand inputBestand = openBestanden(titleMenu, "surfacelines.csv") If inputBestand <> "" Then 'UpdatePath van bestandlocaties txtProfielen.Text = inputBestand myString = inputBestand pathInvoerbestand = (Mid$(myString, 1, InStrRev(myString, "\"))) txtKnooppunten.Text = pathInvoerbestand & "characteristicpoints.csv" txtLogBestand.Text = pathInvoerbestand & "output_DAM_Edit_log.csv" End If End Sub 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 Dim progress As Long 'Set trap 'on error GoTo errorHandler 'Bewaar de geselecteerde bestandsnaam outputProfiel = txtProfielen.Text outputPL = txtKnooppunten.Text outputLogBestand = txtLogBestand.Text outputDAMEditDesignFile = txtDEDFile.Text directoryPathProfiel = outputProfiel directoryPathPL = outputPL directoryPathLogBestand = outputLogBestand 'Set het bereik van de progressbar ProgressBar1.Max = (aantalProfielen * 6) '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_Insteek geul;Y_Insteek geul;Z_Insteek geul;X_Teen geul;Y_Teen geul;Z_Teen geul;X_Maaiveld buitenwaarts;Y_Maaiveld buitenwaarts;Z_Maaiveld buitenwaarts" 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") 'Schrijf de regel weg Print #2, tempVarPL 'Maak tempVarPL weer leeg tempVarPL = "" End If 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress 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 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress Next tellerEen Close #3 'Sluit de bestanden Close #1 Close #2 Close #3 'Selecteer bronbestand Open outputDAMEditDesignFile For Output As #1 Print #1, "*** Knooppunten ***" Print #1, UBound(arrayKnooppunten, 1) Print #1, UBound(arrayKnooppunten, 2) For tellerEen = 1 To UBound(arrayKnooppunten, 1) For tellerTwee = 1 To UBound(arrayKnooppunten, 2) Print #1, arrayKnooppunten(tellerEen, tellerTwee) Next tellerTwee 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress Next tellerEen Print #1, "*** Profielen ***" Print #1, UBound(arrayProfielen, 1) Print #1, UBound(arrayProfielen, 2) For tellerEen = 1 To UBound(arrayProfielen, 1) For tellerTwee = 1 To UBound(arrayProfielen, 2) Print #1, arrayProfielen(tellerEen, tellerTwee) Next tellerTwee 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress Next tellerEen Print #1, "*** Puntcodes ***" Print #1, UBound(arrayPuntCode, 1) Print #1, UBound(arrayPuntCode, 2) For tellerEen = 1 To UBound(arrayPuntCode, 1) For tellerTwee = 1 To UBound(arrayPuntCode, 2) Print #1, arrayPuntCode(tellerEen, tellerTwee) Next tellerTwee 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress Next tellerEen Print #1, "*** Process LOG ***" Print #1, UBound(arrayProcessLog, 1) Print #1, UBound(arrayProcessLog, 2) For tellerEen = 1 To UBound(arrayProcessLog, 1) For tellerTwee = 1 To UBound(arrayProcessLog, 2) Print #1, arrayProcessLog(tellerEen, tellerTwee) Next tellerTwee 'Update de progressbar progress = progress + 1 ProgressBar1.Value = progress Next tellerEen Close #1 'Activeer de stopknop cmdStop.Enabled = True i = MsgBox("Bestanden zijn opgeslagen. Wilt u een nieuw bestand inlezen om te 'klikken'?", vbYesNo, "Let op!") If i = vbYes Then 'Laat het volgende scherm Unload frmOpslaan frmGraphicView.Show Else End End If '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 Form_Load() 'Toon voorstel voor de bestandsnamen txtProfielen.Text = pathInvoerbestand & "surfacelines.csv" txtKnooppunten.Text = pathInvoerbestand & "characteristicpoints.csv" txtDEDFile.Text = pathInvoerbestand & "DAM_Edit_Database.ded" txtLogBestand.Text = pathInvoerbestand & "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