VERSION 5.00 Begin VB.Form frmPL AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 12705 ClientLeft = 45 ClientTop = 330 ClientWidth = 19830 Icon = "frmPL.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 12705 ScaleWidth = 19830 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton cmdVerwijder Caption = "Verwijder profiel bij opslaan" Height = 495 Left = 13920 TabIndex = 40 Top = 7080 Width = 5775 End Begin VB.ListBox lstLogboeklijst Height = 2790 Left = 7320 TabIndex = 39 Top = 7800 Width = 6495 End Begin VB.TextBox txtLogboek Height = 495 Left = 7320 ScrollBars = 1 'Horizontal TabIndex = 37 Top = 10920 Width = 6495 End Begin VB.Frame Frame4 Caption = "Hulplijnen peilen" Height = 1480 Left = 360 TabIndex = 18 Top = 9960 Width = 6855 Begin VB.TextBox txtLiggingDTH Alignment = 1 'Right Justify Height = 285 Left = 5640 TabIndex = 32 Text = "-0.6" Top = 480 Width = 735 End Begin VB.TextBox txtVerkeersbelasting Alignment = 1 'Right Justify Height = 285 Left = 5640 TabIndex = 28 Text = "2.5" Top = 960 Width = 735 End Begin VB.TextBox txtLiggingPolderpeil Alignment = 1 'Right Justify Height = 285 Left = 2400 TabIndex = 22 Text = "-4" Top = 960 Width = 735 End Begin VB.TextBox txtLiggingBoezempeil Alignment = 1 'Right Justify Height = 285 Left = 2400 TabIndex = 20 Text = "-0.6" Top = 480 Width = 735 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Ligging DTH (t.o.v. NAP):" Height = 195 Left = 3600 TabIndex = 34 Top = 480 Width = 1815 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "m" Height = 195 Left = 6480 TabIndex = 33 Top = 480 Width = 120 End Begin VB.Label Label18 AutoSize = -1 'True Caption = "m" Height = 195 Left = 6480 TabIndex = 29 Top = 960 Width = 120 End Begin VB.Label Label17 AutoSize = -1 'True Caption = "Breedte verkeersbelasting:" Height = 195 Left = 3600 TabIndex = 27 Top = 960 Width = 1890 End Begin VB.Label Label9 AutoSize = -1 'True Caption = "m" Height = 195 Left = 3240 TabIndex = 24 Top = 960 Width = 120 End Begin VB.Label Label8 AutoSize = -1 'True Caption = "m" Height = 195 Left = 3240 TabIndex = 23 Top = 480 Width = 120 End Begin VB.Label Label7 AutoSize = -1 'True Caption = "Binnenwaterstand (t.o.v. NAP):" Height = 195 Left = 120 TabIndex = 21 Top = 960 Width = 2190 End Begin VB.Label Label6 AutoSize = -1 'True Caption = "Buitenwaterstand (t.o.v. NAP):" Height = 195 Left = 120 TabIndex = 19 Top = 480 Width = 2145 End End Begin VB.Frame Frame3 Caption = "Legenda" Height = 1260 Left = 13920 TabIndex = 17 Top = 10200 Width = 5775 Begin VB.CommandButton cdmPuntCodes Caption = "Toon puntcodes (kleuren)" Height = 615 Left = 120 TabIndex = 30 Top = 360 Width = 2535 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "= DTH" Height = 195 Left = 4080 TabIndex = 35 Top = 960 Width = 480 End Begin VB.Line Line4 BorderColor = &H00008000& BorderStyle = 3 'Dot X1 = 3600 X2 = 3960 Y1 = 1080 Y2 = 1080 End Begin VB.Line Line3 BorderColor = &H00FF00FF& BorderStyle = 3 'Dot X1 = 3600 X2 = 3960 Y1 = 720 Y2 = 720 End Begin VB.Label Label12 AutoSize = -1 'True Caption = "= Binnenwaterstand" Height = 195 Left = 4080 TabIndex = 26 Top = 600 Width = 1410 End Begin VB.Label Label10 AutoSize = -1 'True Caption = "= Buitenwaterstand" Height = 195 Left = 4080 TabIndex = 25 Top = 240 Width = 1365 End Begin VB.Line Line2 BorderColor = &H00FF0000& BorderStyle = 3 'Dot X1 = 3600 X2 = 3960 Y1 = 360 Y2 = 360 End End Begin VB.Frame Frame1 Caption = "Instellingen" Height = 2175 Left = 4680 TabIndex = 14 Top = 7680 Width = 2535 Begin VB.CommandButton cmdUpdate Caption = "Update peilen" Height = 375 Left = 120 TabIndex = 31 Top = 1560 Width = 2295 End Begin VB.CommandButton cmdWis Caption = "Wis punten" Height = 375 Left = 120 TabIndex = 16 Top = 960 Width = 2295 End Begin VB.CommandButton cmdSkipPunt Caption = "Skip punt" Height = 375 Left = 120 TabIndex = 15 Top = 360 Width = 2295 End End Begin VB.ListBox List1 Height = 2205 ItemData = "frmPL.frx":08CA Left = 13920 List = "frmPL.frx":08CC TabIndex = 13 Top = 7800 Width = 5775 End Begin VB.CommandButton cmdOK Caption = "OK >>" Height = 735 Left = 2520 TabIndex = 3 Top = 9000 Width = 1935 End Begin VB.CommandButton cmdVorrige Caption = "<< Vorige" Height = 735 Left = 360 TabIndex = 1 Top = 7800 Width = 2055 End Begin VB.CommandButton cmdVolgende Caption = "Volgende >>" Height = 735 Left = 2520 TabIndex = 2 Top = 7800 Width = 1935 End Begin VB.Frame Frame2 Caption = "Bestandsinformatie" Height = 1095 Left = 360 TabIndex = 7 Top = 11520 Width = 19335 Begin VB.Label Label11 AutoSize = -1 'True Caption = "Aantal herkende profielen:" Height = 195 Left = 120 TabIndex = 11 Top = 360 Width = 1860 End Begin VB.Label lblAantalProfielen AutoSize = -1 'True Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 195 Left = 2280 TabIndex = 10 Top = 360 Width = 75 End Begin VB.Label lblActiefProfiel AutoSize = -1 'True Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 195 Left = 2280 TabIndex = 9 Top = 720 Width = 75 End Begin VB.Label Label13 AutoSize = -1 'True Caption = "Geselecteerd profiel:" Height = 195 Left = 120 TabIndex = 8 Top = 720 Width = 1455 End End Begin VB.CommandButton cmdStop Caption = "Stop" Height = 735 Left = 360 TabIndex = 4 Top = 9000 Width = 2055 End Begin VB.PictureBox picDwarsprofiel AutoRedraw = -1 'True BackColor = &H00FFFFFF& ForeColor = &H00C00000& Height = 6495 Left = 360 MousePointer = 2 'Cross ScaleHeight = 6435 ScaleWidth = 19275 TabIndex = 0 Top = 120 Width = 19335 Begin VB.Line lineDeleted2 BorderColor = &H000000FF& BorderWidth = 10 Visible = 0 'False X1 = 0 X2 = 19320 Y1 = 6480 Y2 = 0 End Begin VB.Line lineDeleted1 BorderColor = &H000000FF& BorderWidth = 10 Visible = 0 'False X1 = -360 X2 = 19320 Y1 = -120 Y2 = 6360 End Begin VB.Line lineDTH BorderColor = &H00008000& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 1920 Y2 = 1920 End Begin VB.Line linePolderpeil BorderColor = &H00C000C0& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 1680 Y2 = 1680 End Begin VB.Line lineBoezempeil BorderColor = &H00FF0000& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 1440 Y2 = 1440 End Begin VB.Line kruisdraadVerticaal BorderColor = &H00C0C0C0& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 1200 Y2 = 1200 End Begin VB.Line kruisdraadHorizontaal BorderColor = &H00C0C0C0& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 960 Y2 = 960 End End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Opmerkingen voor in het logboek:" Height = 195 Left = 7320 TabIndex = 38 Top = 10680 Width = 2400 End Begin VB.Label lblBericht BackStyle = 0 'Transparent Caption = "Klik de punten aan" BeginProperty Font Name = "MS Sans Serif" Size = 24 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 735 Left = 360 TabIndex = 36 Top = 7800 Visible = 0 'False Width = 4095 End Begin VB.Line Line1 X1 = 360 X2 = 4440 Y1 = 8760 Y2 = 8760 End Begin VB.Label lblSelect Alignment = 2 'Center BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = "Selecteer insteek sloot polderzijde" BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 360 TabIndex = 12 Top = 7080 Width = 13455 End Begin VB.Label Label15 AutoSize = -1 'True Caption = "Z" Height = 195 Left = 120 TabIndex = 6 Top = 3000 Width = 105 End Begin VB.Label Label16 Alignment = 2 'Center AutoSize = -1 'True Caption = "L" Height = 195 Left = 360 TabIndex = 5 Top = 6720 Width = 19290 End End Attribute VB_Name = "frmPL" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Declareer module variabelen en constanten Public laatsteX, laatsteY As Double 'Variable voor de laatste geselecteerde X en Y Public eersteX, eersteY, startYprofiel As Double 'Variable voor de eerste geselecteerde X en Y Public fout As Boolean 'Houdt bij of er een fout opgetreden is Public startXPL, startYPL, endXPL, endYPL 'Start en eindpunt gekozen profiel Public muispositieX, muispositieY As Double 'Huidige muispositie Public schaal As Double 'Schaal van de grafiek Public aantalPunten2DArray As Long 'Aantal punten in 2D array Public knooppuntNummer As Integer 'Te selecteren knooppunt Const constDTH = 17 'Knooppuntnummer Dijktafelhoogte Const constMVBoezem = 16 'Knooppuntnummer maaiveld buitenwaarts Const constMVPolder = 1 'Knooppuntnummer maaiveld binnenwaarts Private Sub cdmPuntCodes_Click() 'Toon het schema met de puntcodes frmPuntCodes.Show 1 End Sub Private Sub leesDitchIni() 'Deze routine leest de logboeken termen uit het ditch.ini Dim i As Integer Dim leesregel As String On Error GoTo errorHandlerIni Open "damedit.ini" For Input As #1 Do While Not EOF(1) Line Input #1, leesregel lstLogboeklijst.AddItem leesregel Loop Close #1 Exit Sub errorHandlerIni: i = MsgBox("Het damedit.ini bestand kan niet worden geopend." & Chr(13) & "De standaard logboek items worden niet aangemaakt", vbCritical, "Kan bestand niet vinden") Close #1 lstLogboeklijst.Enabled = False End Sub Private Sub cmdOk_Click() 'Sluit het huidige scherm en open het scherm opslaan Unload frmPL frmOpslaan.Show End Sub Private Sub cmdSkipPunt_Click() Dim caseSelect '1 = Maaiveld binnenwaarts '2 = Insteek sloot polderzijde '3 = Slootbodem polderzijde '4 = Slootbodem dijkzijde '5 = Insteek sloot dijkzijde '6 = Teen dijk binnenwaarts '7 = Kruin binnenberm '8 = Insteek binnenberm '9 = Kruin binnentalud '10 = Verkeersbelasting kant binnenwaarts '11 = Verkeersbelasting kant buitenwaarts '12 = Kruin buitentalud '13 = Insteek buitenberm '14 = Kruin buitenberm '15 = Teen dijk buitenwaarts '16 = Maaiveld buitenwaarts '17 = Dijktafelhoogte 'Disable de knoppen cmdVorrige.Enabled = False cmdVolgende.Enabled = False cmdOk.Enabled = False cmdVorrige.Visible = False cmdVolgende.Visible = False cmdOk.Visible = False lblBericht.Visible = True 'Laatste punt, dus profiel blokkeren If knooppuntNummer = (breedteArrayKnooppunten - 1) / 3 Then picDwarsprofiel.Enabled = False End If knooppuntNummer = knooppuntNummer + 1 caseSelect = knooppuntNummer 'Bepaal welk punt aangeklikt wordt en bewaar het punt Select Case caseSelect Case 3 lblSelect.Caption = "Selecteer teen dijk binnendijks" knooppuntNummer = knooppuntNummer + 3 cmdSkipPunt.Enabled = False Case 8 lblSelect.Caption = "Selecteer kruin polder" knooppuntNummer = knooppuntNummer + 1 cmdSkipPunt.Enabled = False Case 14 lblSelect.Caption = "Selecteer teen dijk buitenwaarts" knooppuntNummer = knooppuntNummer + 1 cmdSkipPunt.Enabled = False End Select End Sub Private Sub cmdStop_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u wilt stoppen? Wijzigingen worden niet opgeslagen!", vbYesNo, "Let op!") If i = vbYes Then 'Stop het programma End End If End Sub Private Sub cmdUpdate_Click() If lineBoezempeil = True Then lineBoezempeil.Visible = False linePolderpeil.Visible = False lineDTH.Visible = False Else lineBoezempeil.Visible = True linePolderpeil.Visible = True lineDTH.Visible = True End If 'Teken de peilen in Call tekenPeilen(picDwarsprofiel.ScaleWidth) End Sub Private Sub cmdVerwijder_Click() If lineDeleted1.Visible = True Then lineDeleted1.Visible = False lineDeleted2.Visible = False arrayProcessLog(geselecteerdProfiel, 2) = "FALSE" cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True cmdWis.Enabled = True cmdSkipPunt.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True arrayProcessLog(geselecteerdProfiel, 2) = "TRUE" cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False cmdWis.Enabled = False cmdSkipPunt.Enabled = False End If End Sub Private Sub cmdVolgende_Click() 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdSkipPunt.Enabled = True 'Deblokeer het editvenster picDwarsprofiel.Enabled = True 'Toon de kruisdraden kruisdraadHorizontaal.Visible = True kruisdraadVerticaal.Visible = True 'Set de laatste X laatsteX = 0 'Bewaar de opmerkingen in de logfile Arrau arrayProcessLog(geselecteerdProfiel, 3) = txtLogboek.Text 'Hoog het nummer van het geselecteerde profiel op geselecteerdProfiel = geselecteerdProfiel + 1 'Zorg er voor dat er nooit een profile buiten de array gekozen kan worden If geselecteerdProfiel > aantalProfielen Then geselecteerdProfiel = 1 'Geef aan welk punt geselecteerd moet worden lblSelect.Caption = "Selecteer insteek sloot polderzijde" 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) If arrayProcessLog(geselecteerdProfiel, 2) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True cmdWis.Enabled = True cmdSkipPunt.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False cmdWis.Enabled = False cmdSkipPunt.Enabled = False End If 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 3) txtLogboek.SetFocus 'Set Knooppuntnummer knooppuntNummer = 2 'Bij het laatse profiel, dan zorgen dat weer bij nummer 1 begonnen wordt 'If aantalProfielen = geselecteerdProfiel Then geselecteerdProfiel = 0 'De Blokkeer de command knoppen cmdVolgende.Enabled = True cmdVorrige.Enabled = True End Sub Private Sub cmdVorrige_Click() 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdSkipPunt.Enabled = True 'Deblokeer het editvenster picDwarsprofiel.Enabled = True 'Toon de kruisdraden kruisdraadHorizontaal.Visible = True kruisdraadVerticaal.Visible = True 'Set de laatste X laatsteX = 0 'Bewaar de opmerkingen in de logfile Arrau arrayProcessLog(geselecteerdProfiel, 3) = txtLogboek.Text 'Verminder het nummer van het geselecteerde profiel If geselecteerdProfiel = 1 Then geselecteerdProfiel = aantalProfielen Else geselecteerdProfiel = geselecteerdProfiel - 1 End If 'Geef aan welk punt geselecteerd moet worden lblSelect.Caption = "Selecteer insteek sloot polderzijde" 'Set Knooppuntnummer knooppuntNummer = 2 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) If arrayProcessLog(geselecteerdProfiel, 2) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True cmdWis.Enabled = True cmdSkipPunt.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False cmdWis.Enabled = False cmdSkipPunt.Enabled = False End If 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 3) txtLogboek.SetFocus 'De Blokkeer de command knoppen cmdVolgende.Enabled = True cmdVorrige.Enabled = True End Sub Private Sub cmdWis_Click() 'Declareer lokale variabelen Dim teller As Integer 'Wis alle knooppunten in dit profiel For teller = 2 To breedteArrayKnooppunten arrayKnooppunten(geselecteerdProfiel, teller) = -1 Next teller 'Activeer het scherm weer dat er getekend kan worden picDwarsprofiel.Enabled = True 'Set het eerste te selecteren knooppunt knooppuntNummer = 2 'Geef aan welk punt geselecteerd moet worden lblSelect.Caption = "Selecteer insteek sloot polderzijde" 'Teken het profiel opnieuw Call tekenProfielen(geselecteerdProfiel) 'Enable de skipPunt knop weer cmdSkipPunt.Enabled = True 'Zet de knoppen vorige en volgende aan cmdVorrige.Enabled = True cmdVolgende.Enabled = True cmdOk.Enabled = True cmdVorrige.Visible = True cmdVolgende.Visible = True cmdOk.Visible = True lblBericht.Visible = False End Sub Private Sub Form_Load() 'Declareer lokale constanten Const defaultBoezempeil = -0.4 Const defaultPolderpeil = -2 Const defaultVerkeersbelasting = 2.5 Const defaultDTH = -0.4 'Toon de default waarden in de tekstvakken txtLiggingBoezempeil.Text = defaultBoezempeil txtLiggingPolderpeil.Text = defaultPolderpeil txtVerkeersbelasting.Text = defaultVerkeersbelasting txtLiggingDTH.Text = defaultDTH 'Toon de bestandsnaam in het form caption frmPL.Caption = "Point Edit: " + inputBestand 'Toon het aantal ingelezen profielen lblAantalProfielen.Caption = aantalProfielen 'Teken het eerste profiel Call tekenProfielen(1) ' Lees het ini bestand met daarin de logboek items Call leesDitchIni 'Geef de waarde 1 mee met het 1e profiel geselecteerdProfiel = 1 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 3) 'txtLogboek.SetFocus If arrayProcessLog(geselecteerdProfiel, 2) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True cmdWis.Enabled = True cmdSkipPunt.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False cmdWis.Enabled = False cmdSkipPunt.Enabled = False End If 'Set te selecteren knoopPunt '1 = Maaiveld binnenwaarts '2 = Insteek sloot polderzijde '3 = Slootbodem polderzijde '4 = Slootbodem dijkzijde '5 = Insteek sloot dijkzijde '6 = Teen dijk binnenwaarts '7 = Kruin binnenberm '8 = Insteek binnenberm '9 = Kruin binnentalud '10 = Verkeersbelasting kant binnenwaarts '11 = Verkeersbelasting kant buitenwaarts '12 = Kruin buitentalud '13 = Insteek buitenberm '14 = Kruin buitenberm '15 = Teen dijk buitenwaarts '16 = Maaiveld buitenwaarts '17 = Dijktafelhoogte 'Set insteeksloot Polderzijde knooppuntNummer = 2 End Sub Sub tekenProfielen(profielNummer As Long) 'Deze routine tekent de profielen en het bovenaanzicht 'Declareer lokale variabelen Dim minX, maxX, minY, maxY, minZ, maxZ, newX, oldX, newY, oldY, newZ, oldZ, oldXPL, oldYPL, oldZPL, newXPL, newYPL, newZPL, lengteProfiel, lengteProfielPL, oudeLengteProfiel, oudeLengteProfielPL, knooppuntL As Double Dim tellerEen, tellerTwee, tellerDrie, tellerVier, tellerVijf, aantalPunten, tellerCode, teller2D, aantallijnen As Long Dim leesVariabeleX, leesVariabeleY, leesVariabeleZ, caseSelect Dim liggingBoezempeil, liggingPolderpeil, liggingDTH As Double 'Wis de plot areas picDwarsprofiel.Cls 'Geselecteerd profiel tellerEen = profielNummer tellerCode = 2 'Toon geselecteerd profielnaam lblActiefProfiel.Caption = arrayProfielen(tellerEen, 1) & " (" & tellerEen & "/" & aantalProfielen & ")" 'Lees de eerste coördinaten oldX = (arrayProfielen(tellerEen, 2)) oldY = (arrayProfielen(tellerEen, 3)) 'Lees de benodige array regel door voor het tekenen van het profiel en vaststellen van de schaal For tellerTwee = 2 To totaalAantalKolommen If tellerTwee = 2 Then maxX = arrayProfielen(tellerEen, tellerTwee) minX = maxX maxY = arrayProfielen(tellerEen, tellerTwee + 1) minY = maxY maxZ = arrayProfielen(tellerEen, tellerTwee + 2) minZ = maxZ 'Bewaar de startcoördinaten van het geselecteerde profiel startX = maxX startY = maxY startZ = maxZ Else leesVariabeleX = arrayProfielen(tellerEen, tellerTwee) 'Controleer of er nog een waarde aanwezig is, zoniet verlaat dan de For Loop If leesVariabeleX = "" Then aantalPunten = (tellerTwee - 2) / 3 Exit For End If leesVariabeleY = arrayProfielen(tellerEen, tellerTwee + 1) leesVariabeleZ = arrayProfielen(tellerEen, tellerTwee + 2) 'Controleer of de ingelezen variabele de limiet is van het gebied If leesVariabeleX > maxX Then maxX = leesVariabeleX If leesVariabeleX < minX Then minX = leesVariabeleX If leesVariabeleY > maxY Then maxY = leesVariabeleY If leesVariabeleY < minY Then minY = leesVariabeleY If leesVariabeleZ > maxZ Then maxZ = leesVariabeleZ If leesVariabeleZ < minZ Then minZ = leesVariabeleZ End If 'Verhoog de teller met 2 om weer op de positie van een X-coördinaat terug te keren tellerTwee = tellerTwee + 2 Next tellerTwee 'Controleer of het aantalpunten niet gelijk is aan nul If aantalPunten = 0 Then aantalPunten = (tellerTwee - 2) / 3 End If 'Teken de meetposities For tellerTwee = 5 To (aantalPunten * 3) newX = (arrayProfielen(tellerEen, tellerTwee)) newY = (arrayProfielen(tellerEen, tellerTwee + 1)) lengteProfiel = lengteProfiel + Sqr((newX - oldX) ^ 2 + (newY - oldY) ^ 2) oldX = newX oldY = newY 'Verhoog de teller met 2 om weer op de positie van een X-coördinaat terug te keren tellerTwee = tellerTwee + 2 Next tellerTwee 'Set schaal voor dwarsporiel picDwarsprofiel.ScaleWidth = lengteProfiel + lengteProfiel * 0.1 picDwarsprofiel.ScaleHeight = -(maxZ - minZ) - (maxZ - minZ) * 0.7 picDwarsprofiel.ScaleLeft = 0 - 0.5 * lengteProfiel * 0.1 picDwarsprofiel.ScaleTop = maxZ + 0.5 * (maxZ - minZ) * 0.7 'Tekenkruisdraden kruisdraadHorizontaal.X1 = 0 - 0.5 * lengteProfiel * 0.1 kruisdraadHorizontaal.X2 = lengteProfiel + lengteProfiel * 0.1 kruisdraadHorizontaal.Y1 = maxZ + 0.5 * (maxZ - minZ) * 0.7 kruisdraadHorizontaal.Y2 = maxZ + 0.5 * (maxZ - minZ) * 0.7 kruisdraadVerticaal.X1 = 0 - 0.5 * lengteProfiel * 0.1 kruisdraadVerticaal.X2 = 0 - 0.5 * lengteProfiel * 0.1 kruisdraadVerticaal.Y1 = maxZ + 0.5 * (maxZ - minZ) * 0.7 kruisdraadVerticaal.Y2 = kruisdraadVerticaal.Y1 - (maxZ - minZ) - (maxZ - minZ) * 0.7 'Bewaar de lengte van het lengteprofiel globaal totaalLengteprofiel = lengteProfiel 'Bewaar de schaal in de variabele schaal schaal = lengteProfiel 'Lees de startposities oldX = (arrayProfielen(tellerEen, 2)) oldY = (arrayProfielen(tellerEen, 3)) oldZ = (arrayProfielen(tellerEen, 4)) 'Teken het eerste punt in 'picDwarsprofiel.Circle (0, oldZ), schaal / 100, vbRed 'Initialiseer de eerste waar op 0 oudeLengteProfiel = 0 lengteProfiel = 0 'Keer in array naar positie X-coördinaat tellerCode = 4 'Redefine de array tempArray2Dprofiel om het 2D profiel bij te houden ReDim tempArray2DProfiel(aantalPunten, 2) 'Bewaar de grootte van de tempArray2DProfielen aantalPunten2DArray = aantalPunten 'Vul de eerste regel in de array met de startpunten L = 0 tempArray2DProfiel(1, 1) = 0 'L tempArray2DProfiel(1, 2) = arrayProfielen(tellerEen, 4) 'Z 'Vul startlocatie voor array 2D-profiel in teller2D = 2 'Teken het dwarsprofiel For tellerTwee = 5 To (aantalPunten * 3) newX = (arrayProfielen(tellerEen, tellerTwee)) newY = (arrayProfielen(tellerEen, tellerTwee + 1)) newZ = (arrayProfielen(tellerEen, tellerTwee + 2)) lengteProfiel = lengteProfiel + Sqr((newX - oldX) ^ 2 + (newY - oldY) ^ 2) 'Schrijf resultaten weg in de array voor het 2D profiel tempArray2DProfiel(teller2D, 1) = Round(lengteProfiel, 3) tempArray2DProfiel(teller2D, 2) = newZ 'Teken lijn segmenten picDwarsprofiel.Line (oudeLengteProfiel, oldZ)-(lengteProfiel, newZ), vbBlack 'Teken punt in bij meegegeven code If arrayPuntCode(tellerEen, tellerCode) <> 99 Or arrayPuntCode(tellerEen, tellerCode + 1) <> 999 Then If arrayPuntCode(tellerEen, tellerCode) = 1 Or arrayPuntCode(tellerEen, tellerCode + 1) = 1 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 2 Or arrayPuntCode(tellerEen, tellerCode + 1) = 2 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 3 Or arrayPuntCode(tellerEen, tellerCode + 1) = 3 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 4 Or arrayPuntCode(tellerEen, tellerCode + 1) = 4 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 5 Or arrayPuntCode(tellerEen, tellerCode + 1) = 5 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 6 Or arrayPuntCode(tellerEen, tellerCode + 1) = 6 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 7 Or arrayPuntCode(tellerEen, tellerCode + 1) = 7 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 8 Or arrayPuntCode(tellerEen, tellerCode + 1) = 8 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 9 Or arrayPuntCode(tellerEen, tellerCode + 1) = 9 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 36, 0) ElseIf arrayPuntCode(tellerEen, tellerCode) = 10 Or arrayPuntCode(tellerEen, tellerCode + 1) = 10 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(64, 64, 64) ElseIf arrayPuntCode(tellerEen, tellerCode) = 11 Or arrayPuntCode(tellerEen, tellerCode + 1) = 11 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(64, 64, 64) ElseIf arrayPuntCode(tellerEen, tellerCode) = 12 Or arrayPuntCode(tellerEen, tellerCode + 1) = 12 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 127, 36) ElseIf arrayPuntCode(tellerEen, tellerCode) = 13 Or arrayPuntCode(tellerEen, tellerCode + 1) = 13 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 14 Or arrayPuntCode(tellerEen, tellerCode + 1) = 14 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 15 Or arrayPuntCode(tellerEen, tellerCode + 1) = 15 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 16 Or arrayPuntCode(tellerEen, tellerCode + 1) = 16 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 17 Or arrayPuntCode(tellerEen, tellerCode + 1) = 17 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 50 Or arrayPuntCode(tellerEen, tellerCode + 1) = 50 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) ElseIf arrayPuntCode(tellerEen, tellerCode) = 51 Or arrayPuntCode(tellerEen, tellerCode + 1) = 51 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) ElseIf arrayPuntCode(tellerEen, tellerCode) = 60 Or arrayPuntCode(tellerEen, tellerCode + 1) = 60 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) ElseIf arrayPuntCode(tellerEen, tellerCode) = 61 Or arrayPuntCode(tellerEen, tellerCode + 1) = 61 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) ElseIf arrayPuntCode(tellerEen, tellerCode) = 70 Or arrayPuntCode(tellerEen, tellerCode + 1) = 70 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) ElseIf arrayPuntCode(tellerEen, tellerCode) = 71 Or arrayPuntCode(tellerEen, tellerCode + 1) = 71 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 255) Else picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(0, 0, 0) End If End If '1 Maaiveld binnenwaarts (roze) RGB(255, 193, 193) '2 Insteek sloot polderzijde (roze) RGB(255, 193, 193) '3 Slootbodem polderzijde (roze) RGB(255, 193, 193) '4 Slootbodem dijkzijde (roze) RGB(255, 193, 193) '5 Insteek sloot dijkzijde (roze) RGB(255, 193, 193) '6 Teen dijk binnenwaarts (roze) RGB(255, 193, 193) '7 Kruin binnenberm (roze) RGB(255, 193, 193) '8 Insteek binnenberm (roze) RGB(255, 193, 193) '9 Kruin binnentalud (rood) RGB(255, 36, 0) '10 Rand verkeersbelasting binnenwaarts (grijs) RGB(64, 64, 64) '11 Rand verkeersbelasting buitenwaarts (grijs) RGB(64, 64, 64) '12 Kruin buitentalud (oranje) RGB(255, 127, 36) '13 Insteek buitenberm (roze) RGB(255, 193, 193) '14 Kruin buitenberm (roze) RGB(255, 193, 193) '15 Teen dijk buitenwaarts (roze) RGB(255, 193, 193) '16 Maaiveld buitenwaarts (roze) RGB(255, 193, 193) '17 Dijktafelhoogte (roze) RGB(255, 193, 193) '50 Kant water boezemzijde (blauw) RGB(0, 0, 255) '51 Kant water boezemzijde is damwand, keerwand o.i.d. (blauw) RGB(0, 0, 255) '60 Kant water dijkzijde (blauw) RGB(0, 0, 255) '61 Kant water dijkzijde is damwand, keerwand o.i.d. (blauw) RGB(0, 0, 255) '70 Kant water dijkzijde (blauw) RGB(0, 0, 255) '71 Kant water dijkzijde is damwand, keerwand o.i.d. (blauw) RGB(0, 0, 255) oldX = newX oldY = newY oldZ = newZ oudeLengteProfiel = lengteProfiel 'Laatste ingelezen Z waarde endZ = oldZ 'Verhoog de teller met 2 om weer op de positie van een X-coördinaat terug te keren tellerTwee = tellerTwee + 2 tellerCode = tellerCode + 2 teller2D = teller2D + 1 Next tellerTwee 'Bewaar het aantal punten in een globale variabele puntenGeselecteerdProfiel = aantalPunten 'Definieer de knooppunten MV_polder arrayKnooppunten(tellerEen, (constMVPolder * 3 - 1)) = oldX arrayKnooppunten(tellerEen, (constMVPolder * 3)) = oldY arrayKnooppunten(tellerEen, (constMVPolder * 3 + 1)) = oldZ 'Definieer de knooppunten MV_boezem arrayKnooppunten(tellerEen, (constMVBoezem * 3 - 1)) = startX arrayKnooppunten(tellerEen, (constMVBoezem * 3)) = startY arrayKnooppunten(tellerEen, (constMVBoezem * 3 + 1)) = startZ 'Wis listbox List1.Clear 'Teken de knooppunten For tellerVier = 2 To breedteArrayKnooppunten - 2 'Controleer of de X coördinaat <> -1 is If arrayKnooppunten(tellerEen, tellerVier) <> -1 Then 'Set de case select caseSelect = tellerVier Select Case caseSelect Case 2 List1.AddItem "Maaiveld binnenwaarts" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") Case 5 List1.AddItem "Insteek sloot polderzijde" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 8 List1.AddItem "Slootbodem polderzijde" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 11 List1.AddItem "Slootbodem dijkzijde" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 14 List1.AddItem "Insteek sloot dijkzijde" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 17 List1.AddItem "Teen dijk binnenwaarts" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 20 List1.AddItem "Kruin binnenberm" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 23 List1.AddItem "Insteek binnenberm" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 26 List1.AddItem "Kruin binnentalud" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 29 List1.AddItem "Verkeersbelasting kant binnenwaarts" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 32 List1.AddItem "Verkeersbelasting kant buitenwaarts" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 35 List1.AddItem "Kruin buitentalud" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 38 List1.AddItem "Insteek buitenberm" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 41 List1.AddItem "Kruin buitenberm" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 44 List1.AddItem "Teen dijk buitenwaarts" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False Case 47 List1.AddItem "Maaiveld Boezem" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") Case 50 List1.AddItem "Dijktafelhoogte (DTH)" List1.AddItem "X = " & Format(arrayKnooppunten(tellerEen, tellerVier), "###0.00") & " Y = " & Format(arrayKnooppunten(tellerEen, tellerVier + 1), "###0.00") & " Z = " & Format(arrayKnooppunten(tellerEen, tellerVier + 2), "###0.00") 'Bij één punt aanwezig in de array, uitgezonder MV polder en boezem 'het kunnen aanklikken van punten uitzetten picDwarsprofiel.Enabled = False 'Geef aan dat alle punten geselecteerd zijn lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False End Select 'Bereken locatie knooppunt t.o.v. 0-punt profiel knooppuntL = Sqr((startX - arrayKnooppunten(tellerEen, tellerVier)) ^ 2 + (startY - arrayKnooppunten(tellerEen, tellerVier + 1)) ^ 2) 'Teken de cirkel, als het DTH is, teken deze dan rood If tellerVier = (constDTH * 3 - 1) Then picDwarsprofiel.Circle (knooppuntL, arrayKnooppunten(tellerEen, tellerVier + 2)), schaal / 100, QBColor(12) Else picDwarsprofiel.Circle (knooppuntL, arrayKnooppunten(tellerEen, tellerVier + 2)), schaal / 100, QBColor(8) End If End If 'Keer terug op een X-Coördinaat in de array tellerVier = tellerVier + 2 Next tellerVier Call tekenPeilen(picDwarsprofiel.ScaleWidth) aantallijnen = (Fix(kruisdraadVerticaal.Y1 - kruisdraadVerticaal.Y2)) 'Teken referentielijnen For tellerEen = 1 To aantallijnen * 2 picDwarsprofiel.DrawStyle = vbDot picDwarsprofiel.Line (kruisdraadHorizontaal.X1, kruisdraadHorizontaal.Y1 - tellerEen / 2)-(kruisdraadHorizontaal.X2, kruisdraadHorizontaal.Y2 - tellerEen / 2), QBColor(7) picDwarsprofiel.DrawStyle = vbSolid Next tellerEen End Sub Sub tekenPeilen(lengteProfiel) 'Set trap On Error GoTo errorHandler 'Lees de peilen liggingBoezempeil = txtLiggingBoezempeil.Text liggingPolderpeil = txtLiggingPolderpeil.Text liggingDTH = txtLiggingDTH.Text 'Teken de peilen in lineBoezempeil.X1 = 0 - 0.5 * lengteProfiel * 0.1 lineBoezempeil.X2 = lengteProfiel + lengteProfiel * 0.1 lineBoezempeil.Y1 = liggingBoezempeil lineBoezempeil.Y2 = liggingBoezempeil linePolderpeil.X1 = 0 - 0.5 * lengteProfiel * 0.1 linePolderpeil.X2 = lengteProfiel + lengteProfiel * 0.1 linePolderpeil.Y1 = liggingPolderpeil linePolderpeil.Y2 = liggingPolderpeil lineDTH.X1 = 0 - 0.5 * lengteProfiel * 0.1 lineDTH.X2 = lengteProfiel + lengteProfiel * 0.1 lineDTH.Y1 = liggingDTH lineDTH.Y2 = liggingDTH 'voorkom dat de routine onnodig wordt uitgevoerd Exit Sub errorHandler: liggingBoezempeil = -0.4 liggingPolderpeil = -2 liggingDTH = -0.4 'Teken de default peilen in lineBoezempeil.X1 = 0 - 0.5 * lengteProfiel * 0.1 lineBoezempeil.X2 = lengteProfiel + lengteProfiel * 0.1 lineBoezempeil.Y1 = liggingBoezempeil lineBoezempeil.Y2 = liggingBoezempeil linePolderpeil.X1 = 0 - 0.5 * lengteProfiel * 0.1 linePolderpeil.X2 = lengteProfiel + lengteProfiel * 0.1 linePolderpeil.Y1 = liggingPolderpeil linePolderpeil.Y2 = liggingPolderpeil lineDTH.X1 = 0 - 0.5 * lengteProfiel * 0.1 lineDTH.X2 = lengteProfiel + lengteProfiel * 0.1 lineDTH.Y1 = liggingDTH lineDTH.Y2 = liggingDTH 'Toon waarschuwing i = MsgBox("De peilen zijn geen getal. Kan de waarden niet veranderen", vbCritical, "Fout!") End Sub Private Sub lstLogboeklijst_Click() txtLogboek.Text = lstLogboeklijst.Text txtLogboek.SetFocus End Sub Private Sub picDwarsprofiel_Click() 'Declareren lokale variabelen Dim xNa, xVoor, xNaVB, xVoorVB, zNaVB, zVoorVB As Double 'Coördinaat voor en Coördinaat rond aangeklikt punt Dim tempPositieX As Double Dim xCode, yCode, zCode As Double 'De x,y en z coördinaten van de aangeklikte code Dim teller, tellerTwee, tellerDrie, tellerVijf, tellerZes As Long Dim caseSelect Dim breedteVerkeersbelasting As Double 'Breedte van de verkeersbelasting Dim kaarthoek As Double Dim dX, dY, x2D, z2D As Double Dim xVerkeersbelastingBoezem, yVerkeersbelastingBoezem As Double 'Coördinaten van de verkeersbelasting aan de boezemzijde Dim deltaZ, deltaL As Double 'Variabelen benodigd voor het berekenen van de tussenpunten Dim aantalGebruikteKolommen As Long 'Het aantal gebruikte posities in de array door het geselecteerde profiel Dim tempVar Dim tijdelijkeArray() Dim lengteTijdelijkeArray As Long Dim tijdelijkeArrayPuntCodes() Dim lengteTijdelijkeArrayPuntCodes As Long Const knooppuntNummerDTH = 17 'Het knooppuntnummer voor de DTH 'Set trap On Error GoTo errorHandler 'Zet de knoppen vorige en volgende uit cmdVorrige.Enabled = False cmdVolgende.Enabled = False cmdOk.Enabled = False cmdVorrige.Visible = False cmdVolgende.Visible = False cmdOk.Visible = False lblBericht.Visible = True 'Bewaar locatiemuispositie op moment van klikken tempPositieX = muispositieX 'Zoek het dichtsbijgelegen punt (X richting) For teller = 2 To aantalPunten2DArray If (tempPositieX = tempArray2DProfiel(teller, 1)) Or (tempPositieX <= 0) Then 'Als het eerste punt is aangeklikt, dan een punt opschuiven om dubbele punten in MGeobase te vermijden If teller = 1 Then teller = 2 End If 'Kleur de DTH rood If knooppuntNummer = knooppuntNummerDTH Then picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(12) Else picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) End If 'Verlaat de for loop Exit For ElseIf tempPositieX > tempArray2DProfiel(aantalPunten2DArray, 1) Then 'Als er buiten het profiel geklikt is aan de polderzijde teller = aantalPunten2DArray - 1 'Kleur de DTH rood If knooppuntNummer = knooppuntNummerDTH Then picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(12) Else picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) End If 'Verlaat de for loop Exit For ElseIf tempPositieX < tempArray2DProfiel(teller, 1) Then 'Als het eerste punt is aangeklikt, dan een punt opschuiven om dubbele punten in MGeobase te vermijden If teller = aantalPunten2DArray Then teller = teller - 1 End If xNa = tempArray2DProfiel(teller, 1) xVoor = tempArray2DProfiel(teller - 1, 1) If (xNa - tempPositieX) <= (tempPositieX - xVoor) Then 'Kleur de DTH rood If knooppuntNummer = knooppuntNummerDTH Then picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(12) Else picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) End If Else teller = teller - 1 'Voorkom dat het eerste punt gekozen wordt If teller = 1 Then teller = 2 End If 'Kleur de DTH rood If knooppuntNummer = knooppuntNummerDTH Then picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(12) Else picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) End If End If 'Verlaat de for loop Exit For End If Next teller 'zoek de xy coördinaten bij het geselecteerde punt xCode = arrayProfielen(geselecteerdProfiel, (1 + teller * 3 - 2)) yCode = arrayProfielen(geselecteerdProfiel, (1 + teller * 3 - 1)) zCode = arrayProfielen(geselecteerdProfiel, (1 + teller * 3)) '1 = Maaiveld binnenwaarts '2 = Insteek sloot polderzijde '3 = Slootbodem polderzijde '4 = Slootbodem dijkzijde '5 = Insteek sloot dijkzijde '6 = Teen dijk binnenwaarts '7 = Kruin binnenberm '8 = Insteek binnenberm '9 = Kruin binnentalud '10 = Verkeersbelasting kant binnenwaarts '11 = Verkeersbelasting kant buitenwaarts '12 = Kruin buitentalud '13 = Insteek buitenberm '14 = Kruin buitenberm '15 = Teen dijk buitenwaarts '16 = Maaiveld buitenwaarts '17 = Dijktafelhoogte caseSelect = knooppuntNummer 'Bepaal welk punt aangeklikt wordt en bewaar het punt Select Case caseSelect Case 2 arrayKnooppunten(geselecteerdProfiel, caseSelect + 3) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 4) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 5) = zCode List1.AddItem "Insteek sloot polderzijde" lblSelect.Caption = "Selecteer slootbodem polderzijde" cmdSkipPunt.Enabled = False Case 3 arrayKnooppunten(geselecteerdProfiel, caseSelect + 5) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 6) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 7) = zCode List1.AddItem "Slootbodem polderzijde" lblSelect.Caption = "Selecteer slootbodem dijkzijde" cmdSkipPunt.Enabled = False Case 4 arrayKnooppunten(geselecteerdProfiel, caseSelect + 7) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 8) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 9) = zCode List1.AddItem "Slootbodem dijkzijde" lblSelect.Caption = "Selecteer insteek sloot dijkzijde" cmdSkipPunt.Enabled = False Case 5 arrayKnooppunten(geselecteerdProfiel, caseSelect + 9) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 10) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 11) = zCode List1.AddItem "Insteek sloot dijkzijde" lblSelect.Caption = "Teen dijk binnenwaarts" cmdSkipPunt.Enabled = False Case 6 arrayKnooppunten(geselecteerdProfiel, caseSelect + 11) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 12) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 13) = zCode List1.AddItem "Teen dijk binnenwaarts" lblSelect.Caption = "Kruin binnenberm" cmdSkipPunt.Enabled = True Case 7 arrayKnooppunten(geselecteerdProfiel, caseSelect + 13) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 14) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 15) = zCode List1.AddItem "Kruin binnenberm" lblSelect.Caption = "Selecteer insteek binnenberm" cmdSkipPunt.Enabled = False Case 8 arrayKnooppunten(geselecteerdProfiel, caseSelect + 15) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 16) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 17) = zCode List1.AddItem "Insteek binnenberm" lblSelect.Caption = "Selecteer kruin binnentalud" cmdSkipPunt.Enabled = False Case 9 arrayKnooppunten(geselecteerdProfiel, caseSelect + 17) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 18) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 19) = zCode List1.AddItem "Kruin binnentalud" lblSelect.Caption = "Selecteer rand verkeersbelasting binnenwaarts" cmdSkipPunt.Enabled = False Case 10 arrayKnooppunten(geselecteerdProfiel, caseSelect + 19) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 20) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 21) = zCode List1.AddItem "Rand verkeersbelasting binnenwaarts" List1.AddItem "X = " & Format(xCode, "###0.00") & " Y = " & Format(yCode, "###0.00") & " Z = " & Format(zCode, "###0.00") List1.AddItem "Rand verkeersbelasting buitenwaarts" 'Het punt tbv de verkeersbelasting aan de boezemkant wordt automatisch gegenereerd 'Lees breedte van de verkeersbelasting in breedteVerkeersbelasting = txtVerkeersbelasting.Text 'Bereken 2D coördinaten van de verkeersbelasting aan de boezemzijde x2D = Round((tempArray2DProfiel(teller, 1) - breedteVerkeersbelasting), 3) z2D = tempArray2DProfiel(teller, 2) 'Zoek het dichtsbijgelegen punt (X richting) For tellerTwee = 1 To aantalPunten2DArray If (tellerTwee = aantalPunten2DArray) And (x2D <> tempArray2DProfiel(tellerTwee, 1)) Then 'Toon waarschuwing i = MsgBox("Het aangeklikte punt en de breedte van de verkeersbelasting vallen buiten het profiel, kies een nieuw punt", vbCritical, "Fout!") 'Verlaag tijdelijk het knooppuntnummer (later komt er weer 1 bij) knooppuntNummer = knooppuntNummer - 1 Exit For ElseIf x2D = tempArray2DProfiel(tellerTwee, 1) Then 'Het punt valt precies gelijk met een ingemeten punt 'Er hoeft geen ander punt aangemaakt te worden. Neem deze waarden over xCode = arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3 - 2)) yCode = arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3 - 1)) zCode = arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3)) Debug.Print "Punt valt precies gelijk" 'Toon het nieuwe extra punt picDwarsprofiel.Circle (x2D, zCode), schaal / 100, QBColor(8) 'Verlaat de for loop Exit For ElseIf x2D < tempArray2DProfiel(tellerTwee, 1) Then 'Bereken de z waarde van de verkeersbelasting aan de boezemzijde 'dmv liniaire interpolatie xNaVB = tempArray2DProfiel(tellerTwee, 1) zNaVB = tempArray2DProfiel(tellerTwee, 2) xVoorVB = tempArray2DProfiel(tellerTwee - 1, 1) zVoorVB = tempArray2DProfiel(tellerTwee - 1, 2) deltaL = xNaVB - xVoorVB deltaZ = zNaVB - zVoorVB zCode = Round((zVoorVB + ((deltaZ / deltaL) * (x2D - xVoorVB))), 3) 'Bereken dX en dY dX = arrayKnooppunten(geselecteerdProfiel, (constMVBoezem * 3 - 1)) - arrayKnooppunten(geselecteerdProfiel, (constMVPolder * 3 - 1)) dY = arrayKnooppunten(geselecteerdProfiel, (constMVBoezem * 3)) - arrayKnooppunten(geselecteerdProfiel, (constMVPolder * 3)) 'Bereken de kaarthoek van het profiel If dY = 0 Then 'Controleer welke kant het profiel op loopt (Oost west of anders om) If dX < 0 Then kaarthoek = -0.5 * PI Else kaarthoek = 0.5 * PI End If Else kaarthoek = Atn(dX / dY) End If 'Controleer in welk kwadrant het punt zich bevindt en pas zonodig de kaarthoek aan If dY < 0 Then kaarthoek = kaarthoek + PI End If If dY > 0 And dX < 0 Then kaarthoek = kaarthoek + 2 * PI End If 'Bereken coördinaten punt xCode = Round((xCode + breedteVerkeersbelasting * Sin(kaarthoek)), 3) yCode = Round((yCode + breedteVerkeersbelasting * Cos(kaarthoek)), 3) 'Om in MGeobase de verkeersbelasting exact samen te laten vallen met de surface lijn moet een 'nieuw punt tussen gevoegd worden in de array voor de surface lijn. 'Definiëer tijdelijke array lengteTijdelijkeArray = totaalAantalKolommen - (1 + (tellerTwee - 1) * 3) lengteTijdelijkeArrayPuntCodes = totaalAantalKolommenPuntCodes - (1 + (tellerTwee - 1) * 2) ReDim tijdelijkeArray(1, (lengteTijdelijkeArray)) ReDim tijdelijkeArrayPuntCodes(1, lengteTijdelijkeArrayPuntCodes) 'Lees data vanaf de locatie in waar het nieuwe punt moet komen in een tijdelijke array For tellerVijf = 1 To lengteTijdelijkeArray tijdelijkeArray(1, tellerVijf) = arrayProfielen(geselecteerdProfiel, ((1 + (tellerTwee - 1) * 3) + tellerVijf)) Next tellerVijf 'Lees data vanaf de locatie in waar het nieuwe punt moet komen in een tijdelijke array For tellerVijf = 1 To lengteTijdelijkeArrayPuntCodes tijdelijkeArrayPuntCodes(1, tellerVijf) = arrayPuntCode(geselecteerdProfiel, ((1 + (tellerTwee - 1) * 2) + tellerVijf)) Next tellerVijf 'Controleer het aantal punten in het profiel For tellerDrie = 1 To totaalAantalKolommen tempVar = arrayProfielen(geselecteerdProfiel, tellerDrie) 'Sop met inlezen als er geen waarde meer wordt gevonden in de regel If tempVar = "" Then Exit For Next tellerDrie 'Als het profiel zo groot is dat hij de totale breedte van de array gebruikt, dan de array vergroten If tellerDrie >= totaalAantalKolommen Then 'Reserveer een extra ruimte voor de inpassing van de verkeersbelasting (x, y, z) in de array totaalAantalKolommen = totaalAantalKolommen + 3 totaalAantalKolommenPuntCodes = totaalAantalKolommenPuntCodes + 2 'ReDefine de dynamic Array en behoud de vulling er van ReDim Preserve arrayProfielen(aantalProfielen, totaalAantalKolommen) 'ReDefine de dynamic Array en behoud de vulling er van ReDim Preserve arrayPuntCode(aantalProfielen, totaalAantalKolommenPuntCodes) End If 'Voeg het nieuwe punt toe in de array's arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3 - 2)) = xCode arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3 - 1)) = yCode arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3)) = zCode arrayPuntCode(geselecteerdProfiel, (tellerTwee * 2)) = 99 arrayPuntCode(geselecteerdProfiel, (1 + tellerTwee * 2)) = 999 'kopieër de data uit de tijdelijke array terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArray 'Controleer of er wel een waarde staat If tijdelijkeArray(1, tellerZes) = "" Then Exit For End If 'Controleer of de teller niet groter wordt dan de breedte van de array If (1 + tellerTwee * 3 + tellerZes) > totaalAantalKolommen Then Exit For End If arrayProfielen(geselecteerdProfiel, (1 + tellerTwee * 3 + tellerZes)) = tijdelijkeArray(1, tellerZes) Next tellerZes 'kopieër de data uit de tijdelijke puntCodeArray terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArrayPuntCodes 'Controleer of er wel een waarde staat If tijdelijkeArrayPuntCodes(1, tellerZes) = "" Then Exit For End If 'Controleer of de teller niet groter wordt dan de breedte van de array If (1 + tellerTwee * 2 + tellerZes) > totaalAantalKolommenPuntCodes Then Exit For End If arrayPuntCode(geselecteerdProfiel, (1 + tellerTwee * 2 + tellerZes)) = tijdelijkeArrayPuntCodes(1, tellerZes) Next tellerZes 'Voeg punt tussen in de 2D array 'Maak eerst tijdelijke array aan ReDim tijdelijkeArray(aantalPunten2DArray, 2) 'Kopieër punten uit de 2D array naar de tijdelijke array For tellerZes = 1 To aantalPunten2DArray tijdelijkeArray(tellerZes, 1) = tempArray2DProfiel(tellerZes, 1) tijdelijkeArray(tellerZes, 2) = tempArray2DProfiel(tellerZes, 2) Next tellerZes 'Vergroot de 2d array om het nieuwe punt toe te voegen ReDim tempArray2DProfiel(aantalPunten2DArray + 1, 2) 'Kopieër data tot de locatie waar het nieuwe punt toegevoegd moet worden For tellerZes = 1 To tellerTwee - 1 tempArray2DProfiel(tellerZes, 1) = tijdelijkeArray(tellerZes, 1) tempArray2DProfiel(tellerZes, 2) = tijdelijkeArray(tellerZes, 2) Next tellerZes 'voeg nieuw punt toe tempArray2DProfiel(tellerTwee, 1) = x2D tempArray2DProfiel(tellerTwee, 2) = zCode 'Kopieër data na nieuw punt terug in de 2d array For tellerZes = tellerTwee To aantalPunten2DArray tempArray2DProfiel(tellerZes + 1, 1) = tijdelijkeArray(tellerZes, 1) tempArray2DProfiel(tellerZes + 1, 2) = tijdelijkeArray(tellerZes, 2) Next tellerZes 'Toon het nieuwe extra punt picDwarsprofiel.Circle (x2D, zCode), schaal / 100, QBColor(8) aantalPunten2DArray = aantalPunten2DArray + 1 'Verlaat de for loop Exit For End If Next tellerTwee 'Bewaar de verkeersbelasting aan de boezemzijde arrayKnooppunten(geselecteerdProfiel, (caseSelect + 1) + 21) = xCode arrayKnooppunten(geselecteerdProfiel, (caseSelect + 1) + 22) = yCode arrayKnooppunten(geselecteerdProfiel, (caseSelect + 1) + 23) = zCode lblSelect.Caption = "Selecteer kruin buitentalud" 'Verhoog het knooppuntnummer omdat case 8 met 9 is gecombineerd knooppuntNummer = knooppuntNummer + 1 cmdSkipPunt.Enabled = False Case 12 arrayKnooppunten(geselecteerdProfiel, caseSelect + 23) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 24) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 25) = zCode List1.AddItem "Kruin buitentalud" lblSelect.Caption = "Selecteer insteek buitenberm" cmdSkipPunt.Enabled = True Case 13 arrayKnooppunten(geselecteerdProfiel, caseSelect + 25) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 26) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 27) = zCode List1.AddItem "Insteek buitenberm" lblSelect.Caption = "Selecteer kruin buitenberm" cmdSkipPunt.Enabled = False Case 14 arrayKnooppunten(geselecteerdProfiel, caseSelect + 27) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 28) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 29) = zCode List1.AddItem "Kruin buitenberm" lblSelect.Caption = "Selecteer teen dijk buitenwaarts" cmdSkipPunt.Enabled = False Case 15 arrayKnooppunten(geselecteerdProfiel, caseSelect + 29) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 30) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 31) = zCode List1.AddItem "Teen dijk buitenwaarts" 'lblSelect.Caption = "Selecteer de dijktafelhoogte" cmdSkipPunt.Enabled = False 'Verhoog het knooppuntnummer omdat maaiveld boezem automatisch geselecteerd wordt knooppuntNummer = knooppuntNummer + 2 caseSelect = knooppuntNummer 'Case 17 arrayKnooppunten(geselecteerdProfiel, caseSelect + 33) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 34) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 35) = zCode 'List1.AddItem "Dijktafelhoogte (DTH)" lblSelect.Caption = "Alle punten zijn geselecteerd" cmdSkipPunt.Enabled = False 'Zet de knoppen vorige en volgende aan cmdVorrige.Enabled = True cmdVolgende.Enabled = True cmdOk.Enabled = True cmdVorrige.Visible = True cmdVolgende.Visible = True cmdOk.Visible = True lblBericht.Visible = False 'Voorkom dat er verder getekend kan worden picDwarsprofiel.Enabled = False End Select 'Verhoog het knooppuntnummer knooppuntNummer = knooppuntNummer + 1 List1.AddItem "X = " & Format(xCode, "###0.00") & " Y = " & Format(yCode, "###0.00") & " Z = " & Format(zCode, "###0.00") 'voorkom dat de routine onnodig wordt uitgevoerd Exit Sub errorHandler: 'Toon waarschuwing i = MsgBox("Er is een verkeerd punt aangeklikt of de breedte van de verkeersbelasting is geen getal", vbCritical, "Fout!") End Sub Private Sub picDwarsprofiel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) kruisdraadHorizontaal.Visible = True kruisdraadVerticaal.Visible = True picDwarsprofiel.ToolTipText = "L = " & Format(X, "###0.00") & "m, Z = " & Format(Y, "###0.00") & "m" 'Beweeg de kruisdraden met de cursor mee kruisdraadHorizontaal.Y1 = Y kruisdraadHorizontaal.Y2 = Y kruisdraadVerticaal.X1 = X kruisdraadVerticaal.X2 = X muispositieX = X muispositieY = Y End Sub