VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmPL AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 13200 ClientLeft = 45 ClientTop = 630 ClientWidth = 19830 Icon = "frmPL.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 13200 ScaleWidth = 19830 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame6 Caption = "Hulplijnen" Height = 735 Left = 8640 TabIndex = 45 Top = 12360 Width = 11055 Begin VB.CheckBox chckToonProfielpunten Caption = "Toon profielpunten" Height = 255 Left = 5880 TabIndex = 50 Top = 360 Value = 1 'Checked Width = 2655 End Begin VB.TextBox txtAfstandTussenHulplijnen Alignment = 1 'Right Justify Height = 285 Left = 4200 TabIndex = 48 Text = "0.5" Top = 360 Width = 615 End Begin VB.CheckBox chckTekenHulplijnen Caption = "Toon hulplijnen" Height = 255 Left = 120 TabIndex = 46 Top = 330 Value = 1 'Checked Width = 1575 End Begin VB.Label Label19 AutoSize = -1 'True Caption = "m" Height = 195 Left = 4920 TabIndex = 49 Top = 360 Width = 120 End Begin VB.Label Label14 AutoSize = -1 'True Caption = "Afstand tussen de hulplijnen:" Height = 195 Left = 2040 TabIndex = 47 Top = 360 Width = 2025 End End Begin VB.Frame Frame5 Caption = "Schaal" Height = 735 Left = 360 TabIndex = 41 Top = 12360 Width = 8175 Begin VB.HScrollBar scrollSchaal Height = 255 LargeChange = 10 Left = 120 Max = 100 Min = 1 TabIndex = 42 Top = 340 Value = 20 Width = 5655 End Begin VB.Label lblSchaalfactor 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 = 7080 TabIndex = 44 Top = 360 Width = 75 End Begin VB.Label Label5 AutoSize = -1 'True Caption = "Schaalfactor:" Height = 195 Left = 6000 TabIndex = 43 Top = 360 Width = 945 End End 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 = "Actie" 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 = 735 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 = 5880 TabIndex = 9 Top = 360 Width = 75 End Begin VB.Label Label13 AutoSize = -1 'True Caption = "Geselecteerd profiel:" Height = 195 Left = 3720 TabIndex = 8 Top = 360 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 lineTaludMeting BorderColor = &H000000FF& BorderWidth = 2 Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 2160 Y2 = 2160 End Begin VB.Label lblTaludhelling Alignment = 2 'Center BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6840 TabIndex = 51 Top = 6000 Visible = 0 'False Width = 5415 End 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 = &H0000C000& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 1200 Y2 = 1200 End Begin VB.Line kruisdraadHorizontaal BorderColor = &H0000C000& Visible = 0 'False X1 = 360 X2 = 1560 Y1 = 960 Y2 = 960 End End Begin MSComDlg.CommonDialog openBestand Left = 20040 Top = 120 _ExtentX = 847 _ExtentY = 847 _Version = 393216 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 Begin VB.Menu menuFile Caption = "&File" Begin VB.Menu menuSaveFile Caption = "&Bewaar DAM Edit Database" Shortcut = ^S End Begin VB.Menu s1 Caption = "-" End Begin VB.Menu menuStop Caption = "S&top" End 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 Public startTaludmetingL, startTaludmetingZ As Double 'Startpunt en eindpunt taludmeting Const constDTH = 17 'Knooppuntnummer Dijktafelhoogte Const constMVBoezem = 18 '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 Dim pathDAMini As String On Error GoTo errorHandlerIni pathDAMini = App.Path & "\damedit.ini" Open pathDAMini 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 chckTekenHulplijnen_Click() 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel, True) End Sub Private Sub chckToonProfielpunten_Click() 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel, True) 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 = Insteek geul '17 = Teen geul '18 = Maaiveld buitenwaarts '19 = 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 Case 17 lblSelect.Caption = "Alle punten zijn geselecteerd" knooppuntNummer = knooppuntNummer + 1 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 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" 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 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel, False) '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 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 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel, False) '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, False) '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 startTaludmetingL = -9999 'Verkrijg default schaalfactor schaalFactor = scrollSchaal.Value / 100 '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, False) ' 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 = Insteek geul '17 = Teen geul '18 = Maaiveld buitenwaarts '19 = Dijktafelhoogte 'Set insteeksloot Polderzijde knooppuntNummer = 2 End Sub Sub tekenProfielen(profielNummer As Long, alleenTekenen As Boolean) '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, tellerZes, aantalPunten, tellerCode, teller2D, aantallijnen As Long Dim leesVariabeleX, leesVariabeleY, leesVariabeleZ, caseSelect Dim liggingBoezempeil, liggingPolderpeil, liggingDTH As Double Dim AfstandTussenHulplijnen As Double Dim checkIsNummeric As Boolean Dim i As Integer '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 he bereik van de scrollbar scrollSchaal.Max = 100 scrollSchaal.Min = 1 '((maxZ - minZ) / lengteProfiel) * 100 'Set schaal voor dwarsporiel picDwarsprofiel.ScaleWidth = lengteProfiel + lengteProfiel * 0.1 picDwarsprofiel.ScaleHeight = schaalFactor * -lengteProfiel '(-(maxZ - minZ) - (maxZ - minZ) * 0.1) picDwarsprofiel.ScaleLeft = 0 - 0.5 * lengteProfiel * 0.1 picDwarsprofiel.ScaleTop = (((maxZ - minZ) / 2) + minZ) + schaalFactor * 0.5 * lengteProfiel '(maxZ - minZ) '(maxZ + 0.5 * (maxZ - minZ) * 0.1) '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 = picDwarsprofiel.ScaleTop 'maxZ + 0.5 * (maxZ - minZ) * 0.7 + (schaalFactor * 0.5 * lengteProfiel) kruisdraadVerticaal.Y2 = picDwarsprofiel.ScaleTop + picDwarsprofiel.ScaleHeight 'kruisdraadVerticaal.Y1 - (maxZ - minZ) - (maxZ - minZ) * 0.7 + (schaalFactor * -lengteProfiel) 'Bewaar de lengte van het lengteprofiel globaal totaalLengteprofiel = lengteProfiel 'Bewaar de schaal in de variabele schaal schaal = lengteProfiel 'Alles de hulplijnen aangeklikt zijn dan de hulplijnen tekenen If chckTekenHulplijnen.Value = 1 Then aantallijnen = (Fix(kruisdraadVerticaal.Y1 - kruisdraadVerticaal.Y2)) + 1 'Controleer of de ingevoerde waarde wel een nummer is checkIsNummeric = IsNumeric(txtAfstandTussenHulplijnen.Text) If checkIsNummeric = False Then 'Toon waarschuwing i = MsgBox("De opgegeven waarde voor de afstand tussen de hulplijnen is geen getal." & Chr(13) & "De hulplijnen worden niet getekend.", vbCritical, "Fout!") Else AfstandTussenHulplijnen = Abs(txtAfstandTussenHulplijnen.Text) 'Teken referentielijnen For tellerZes = 1 To aantallijnen * (1 / AfstandTussenHulplijnen) picDwarsprofiel.DrawStyle = vbDot picDwarsprofiel.Line (kruisdraadHorizontaal.X1, kruisdraadVerticaal.Y1 - tellerZes / (1 / AfstandTussenHulplijnen))-(kruisdraadHorizontaal.X2, kruisdraadVerticaal.Y1 - tellerZes / (1 / AfstandTussenHulplijnen)), QBColor(7) picDwarsprofiel.DrawStyle = vbSolid Next tellerZes End If End If '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 en profielnpunten, mits optie geselecteerd. If chckToonProfielpunten.Value = 1 Then picDwarsprofiel.FillStyle = vbFSSolid picDwarsprofiel.FillColor = vbMagenta picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 800, vbMagenta picDwarsprofiel.FillStyle = vbFSTransparent End If 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) = 17 Or arrayPuntCode(tellerEen, tellerCode + 1) = 18 Then picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, RGB(255, 193, 193) ElseIf arrayPuntCode(tellerEen, tellerCode) = 17 Or arrayPuntCode(tellerEen, tellerCode + 1) = 19 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If 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") If alleenTekenen = False Then '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 If Case 47 List1.AddItem "Insteek geul" 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") If alleenTekenen = False Then '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 If Case 50 List1.AddItem "Teen geul" 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") If alleenTekenen = False Then '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 If Case 53 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 56 ' 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 'Toon de schaalfactor lblSchaalfactor.Caption = schaalFactor Call tekenPeilen(picDwarsprofiel.ScaleWidth) 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 menuSaveFile_Click() Dim directoryPathDAMEditDesignFile, outputDAMEditDesignFile As String Dim tellerEen, tellerTwee As Long 'Declareer locale variabele ' Dim myString As String 'Sets the Dialog Title to Open File titleMenu = "Opslaan DAM Edit Projectdatabase" 'Selecteer bronbestand outputDAMEditDesignFile = openBestanden(titleMenu) If outputDAMEditDesignFile <> "" Then 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 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 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 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 Next tellerEen Close #1 Else Dim i As Integer i = MsgBox("Er is geen bestand geselecteerd, projectdatase is niet opgeslagen", vbCritical, "Fout!") End If End Sub Private Sub menuStop_Click() Call cmdStop_Click 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 = 19 'Het knooppuntnummer voor de DTH 'Set trap On Error GoTo errorHandler If startTaludmetingL <> -9999 Then Exit Sub End If '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 = Insteek geul '17 = Teen geul '18 = Maaiveld buitenwaarts '19 = 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 insteek geul" cmdSkipPunt.Enabled = True Case 16 arrayKnooppunten(geselecteerdProfiel, caseSelect + 31) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 32) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 33) = zCode List1.AddItem "Insteek geul" lblSelect.Caption = "Selecteer teen geul" cmdSkipPunt.Enabled = False Case 17 arrayKnooppunten(geselecteerdProfiel, caseSelect + 33) = xCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 34) = yCode arrayKnooppunten(geselecteerdProfiel, caseSelect + 35) = zCode List1.AddItem "Teen geul" 'Verhoog het knooppuntnummer omdat maaiveld boezem automatisch geselecteerd wordt knooppuntNummer = knooppuntNummer + 2 caseSelect = knooppuntNummer 'Case 17 ' arrayKnooppunten(geselecteerdProfiel, caseSelect + 35) = xCode ' arrayKnooppunten(geselecteerdProfiel, caseSelect + 36) = yCode ' arrayKnooppunten(geselecteerdProfiel, caseSelect + 37) = 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_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Declareer lokale variabelen Dim i As Integer If (Button = 1 And Shift = 1) Then If lblTaludhelling.Visible = False Then startTaludmetingL = X startTaludmetingZ = Y lblTaludhelling.Visible = True lineTaludMeting.Visible = True lineTaludMeting.X1 = startTaludmetingL lineTaludMeting.Y1 = startTaludmetingZ Else lblTaludhelling.Visible = False lineTaludMeting.Visible = False End If ElseIf lblTaludhelling.Visible = False Then startTaludmetingL = -9999 End If End Sub Private Sub picDwarsprofiel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim taludHelling As Double Dim dL, dZ As Double If startL <> -9999 Then lineTaludMeting.X2 = X lineTaludMeting.Y2 = Y dL = X - startTaludmetingL dZ = Y - startTaludmetingZ If dZ = 0 Then taludHelling = 1E+15 Else taludHelling = dL / dZ End If lblTaludhelling.Caption = "taludhelling = 1:" & Round(taludHelling, 2) End If 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 Private Sub scrollSchaal_Change() 'Verkijg de schaalfactor uit de scrollbar value schaalFactor = scrollSchaal.Value / 100 'Teken het profiel opnieuw bij verandering van de schaal Call tekenProfielen(geselecteerdProfiel, True) If lineTaludMeting.Visible = True Then lineTaludMeting.X1 = startTaludmetingL lineTaludMeting.Y1 = startTaludmetingZ End If End Sub Private Sub txtAfstandTussenHulplijnen_Change() chckTekenHulplijnen.Value = 0 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel, True) End Sub Private Sub txtAfstandTussenHulplijnen_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then chckTekenHulplijnen.Value = 1 'Teken het profiel opnieuw bij verandering van de schaal Call tekenProfielen(geselecteerdProfiel, True) End If End Sub Function openBestanden(ByVal titleOpenDialog As String) As String Dim myString 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 openBestand.Filter = "DAM Edit Projectdatabase (*.ded)|*.ded" '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