VERSION 5.00 Begin VB.Form frmPL AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 11580 ClientLeft = 45 ClientTop = 330 ClientWidth = 18135 ControlBox = 0 'False Icon = "frmPL.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 11580 ScaleWidth = 18135 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame6 Caption = "Spring naar profiel nummer:" Height = 975 Left = 15360 TabIndex = 44 Top = 10440 Width = 2655 Begin VB.CommandButton cmdJump Caption = "Spring >>" Height = 495 Left = 1320 TabIndex = 46 Top = 300 Width = 1095 End Begin VB.TextBox txtJumpTo Alignment = 1 'Right Justify Height = 375 Left = 120 MaxLength = 4 TabIndex = 45 Text = "1" Top = 360 Width = 855 End End Begin VB.CommandButton cmdVerwijder Caption = "Verwijder profiel bij opslaan" Height = 495 Left = 3960 TabIndex = 41 Top = 9960 Width = 4095 End Begin VB.Frame Frame5 Caption = "Profiel eigenschappen:" Height = 855 Left = 8280 TabIndex = 34 Top = 9840 Width = 6855 Begin VB.Label lblLengte 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 = &H00FF0000& Height = 255 Left = 5760 TabIndex = 43 Top = 360 Width = 735 End Begin VB.Label Label14 AutoSize = -1 'True Caption = "L:" Height = 195 Left = 5520 TabIndex = 42 Top = 360 Width = 135 End Begin VB.Label lblDZ 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 = &H00FF0000& Height = 195 Left = 4560 TabIndex = 40 Top = 360 Width = 75 End Begin VB.Label Label5 AutoSize = -1 'True Caption = "dZ:" Height = 195 Left = 4200 TabIndex = 39 Top = 360 Width = 240 End Begin VB.Label lblMaxZ 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 = &H00FF0000& Height = 195 Left = 3120 TabIndex = 38 Top = 360 Width = 75 End Begin VB.Label lblMinZ 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 = &H00FF0000& Height = 195 Left = 1080 TabIndex = 37 Top = 360 Width = 75 End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Maximale Z:" Height = 195 Left = 2160 TabIndex = 36 Top = 360 Width = 855 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Minimale Z:" Height = 195 Left = 120 TabIndex = 35 Top = 360 Width = 810 End End Begin VB.TextBox txtLogboek Height = 450 Left = 3960 MaxLength = 256 TabIndex = 32 Top = 10920 Width = 11175 End Begin VB.ListBox lstLogboeklijst Height = 3180 Left = 360 TabIndex = 31 Top = 8160 Width = 3375 End Begin VB.Frame Frame1 Caption = "Selecteer" Height = 1095 Left = 12600 TabIndex = 29 Top = 6960 Width = 5415 Begin VB.Label lblSelect Alignment = 2 'Center BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = "Rechter punt voor interpolatie" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 120 TabIndex = 30 Top = 360 Width = 5175 End End Begin VB.Frame Frame4 Caption = "Hulplijnen peilen" Height = 1605 Left = 8280 TabIndex = 13 Top = 8160 Width = 6855 Begin VB.TextBox txtDieptefactor Alignment = 1 'Right Justify Enabled = 0 'False Height = 285 Left = 5520 TabIndex = 28 Text = "0.2" Top = 960 Width = 735 End Begin VB.TextBox txtMaxDiepteSloot Alignment = 1 'Right Justify Enabled = 0 'False Height = 285 Left = 5520 TabIndex = 23 Text = "1.5" Top = 480 Width = 735 End Begin VB.TextBox txtLiggingPolderpeil Alignment = 1 'Right Justify Height = 285 Left = 2040 TabIndex = 17 Text = "-4" Top = 960 Width = 735 End Begin VB.TextBox txtLiggingBoezempeil Alignment = 1 'Right Justify Height = 285 Left = 2040 TabIndex = 15 Text = "-0.6" Top = 480 Width = 735 End Begin VB.Label Label1 Caption = "Dieptefactor (f)" Height = 255 Left = 3840 TabIndex = 27 Top = 960 Width = 1695 End Begin VB.Label Label18 AutoSize = -1 'True Caption = "m" Height = 195 Left = 6360 TabIndex = 24 Top = 480 Width = 120 End Begin VB.Label Label17 AutoSize = -1 'True Caption = "Maximale diepte sloot:" Height = 195 Left = 3840 TabIndex = 22 Top = 480 Width = 1560 End Begin VB.Label Label9 AutoSize = -1 'True Caption = "m" Height = 195 Left = 2880 TabIndex = 19 Top = 960 Width = 120 End Begin VB.Label Label8 AutoSize = -1 'True Caption = "m" Height = 195 Left = 2880 TabIndex = 18 Top = 480 Width = 120 End Begin VB.Label Label7 AutoSize = -1 'True Caption = "Polderpeil (t.o.v. NAP):" Height = 195 Left = 120 TabIndex = 16 Top = 960 Width = 1605 End Begin VB.Label Label6 AutoSize = -1 'True Caption = "Boezempeil (t.o.v. NAP):" Height = 195 Left = 120 TabIndex = 14 Top = 480 Width = 1725 End End Begin VB.Frame Frame3 Caption = "Legenda" Height = 2220 Left = 15360 TabIndex = 12 Top = 8160 Width = 2655 Begin VB.CommandButton cmdUpdate Caption = "Update peilen" Height = 495 Left = 120 TabIndex = 26 Top = 1560 Width = 2415 End Begin VB.CommandButton cdmPuntCodes Caption = "Toon puntcodes (kleuren)" Height = 495 Left = 120 TabIndex = 25 Top = 360 Width = 2415 End Begin VB.Line Line3 BorderColor = &H00FF00FF& BorderStyle = 3 'Dot X1 = 240 X2 = 960 Y1 = 1080 Y2 = 1080 End Begin VB.Label Label12 AutoSize = -1 'True Caption = "= Polderpeil" Height = 195 Left = 1080 TabIndex = 21 Top = 960 Width = 825 End Begin VB.Label Label10 AutoSize = -1 'True Caption = "= Boezempeil" Height = 195 Left = 1080 TabIndex = 20 Top = 1200 Width = 945 End Begin VB.Line Line2 BorderColor = &H00FF0000& BorderStyle = 3 'Dot X1 = 240 X2 = 960 Y1 = 1320 Y2 = 1320 End End Begin VB.CommandButton cmdOK Caption = "OK >>" Height = 495 Left = 6120 TabIndex = 3 Top = 9240 Width = 1935 End Begin VB.CommandButton cmdVorrige Caption = "<< Vorige" Height = 495 Left = 3960 TabIndex = 1 Top = 8280 Width = 2055 End Begin VB.CommandButton cmdVolgende Caption = "Volgende >>" Height = 495 Left = 6120 TabIndex = 2 Top = 8280 Width = 1935 End Begin VB.Frame Frame2 Caption = "Bestandsinformatie" Height = 1095 Left = 360 TabIndex = 7 Top = 6960 Width = 12135 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 = 495 Left = 3960 TabIndex = 4 Top = 9240 Width = 2055 End Begin VB.PictureBox picDwarsprofiel AutoRedraw = -1 'True BackColor = &H00FFFFFF& ForeColor = &H00C00000& Height = 6495 Left = 480 MousePointer = 2 'Cross ScaleHeight = 6435 ScaleWidth = 17475 TabIndex = 0 Top = 120 Width = 17535 Begin VB.Line lineDeleted2 BorderColor = &H000000FF& BorderWidth = 10 Visible = 0 'False X1 = 0 X2 = 17520 Y1 = 6480 Y2 = 0 End Begin VB.Line lineDeleted1 BorderColor = &H000000FF& BorderWidth = 10 Visible = 0 'False X1 = 0 X2 = 17520 Y1 = 0 Y2 = 6480 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 Label2 AutoSize = -1 'True Caption = "Opmerkingen voor in het logboek:" Height = 195 Left = 3960 TabIndex = 33 Top = 10680 Width = 2400 End Begin VB.Line Line1 X1 = 3960 X2 = 8040 Y1 = 9000 Y2 = 9000 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 = 17610 End End Attribute VB_Name = "frmPL" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit 'Declareer module variabele 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 xSlootrandLinks, xSlootrandRechts 'X-Coördinaten slootrand Public ySlootrandLinks, ySlootrandRechts 'Y-Coördinaten slootrand Public zSlootrandLinks, zSlootrandRechts 'z-Coördinaten slootrand Public tellerSlootkantLinks As Long 'Positie van de slootkant links in de 2D array Public tellerSlootkantRechts As Long 'Positie van de slootkant rechts in de 2D array 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 & "\ditch.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 ditch.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 genereerBoezembodem(profielNummer As Long) Dim tellerEen, tellerDrie, tellerVijf, tellerZes As Long Dim tellerBoezemTaludRechts As Long Dim geselecteerdProfiel As Long Dim xBoezemTaludRechts, yBoezemTaludRechts, zBoezemTaludRechts As Double Dim tellerPuntcodesRechts As Long Dim boezembodemligging, taludhellingRechts As Double Dim kaarthoek As Double Dim dX, dY, x2D, z2D As Double Dim tijdelijkeArray() Dim lengteTijdelijkeArray As Long Dim tijdelijkeArrayPuntCodes() Dim lengteTijdelijkeArrayPuntCodes As Long Dim xCodeLinks, yCodeLinks, zCodeLinks As Double 'Coordinaten van de boezembodem aan de linkerkant Dim xCodeRechts, yCodeRechts, zCodeRechts As Double 'Coordinaten van de boezembodem aan de rechterkant Dim breedteRechterTalud As Double Dim tempVar As String Const breedteBoezembodem = 10 Const kantWaterBZM = 70 Const kantWaterBZMcorrected = 73 'Punt 73 wordt aangemaakt om te corrigeren voor onnauwkeurigheden in AHN2 Const kantWaterBZMisDamwand = 71 Const dijklijn = 9 'Set initialisatie waardem tellerBoezemTaludRechts = 2 xBoezemTaludRechts = -1 yBoezemTaludRechts = -1 zBoezemTaludRechts = -1 geselecteerdProfiel = profielNummer 'Zoek de boezem op in het profiel, en dan kantWaterBZMcorrected For tellerEen = 2 To totaalAantalKolommenPuntCodes 'If (arrayPuntCode(profielNummer, tellerEen) = 50) Or (arrayPuntCode(profielNummer, tellerEen + 1) = 50) Or (arrayPuntCode(profielNummer, tellerEen) = 51) Or (arrayPuntCode(profielNummer, tellerEen + 1) = 51) Then If (arrayPuntCode(profielNummer, tellerEen) = kantWaterBZMcorrected) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterBZMcorrected) Then xBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts) yBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts + 1) zBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts + 2) tellerPuntcodesRechts = tellerEen arrayProcessLog(profielNummer, 6) = "TRUE" Exit For ElseIf (arrayPuntCode(profielNummer, tellerEen) = dijklijn) Or (arrayPuntCode(profielNummer, tellerEen + 1) = dijklijn) Then Exit For End If tellerEen = tellerEen + 1 tellerBoezemTaludRechts = tellerBoezemTaludRechts + 3 Next tellerEen 'Verlaat de procedure als er geen boezem is gedefinieerd If (xBoezemTaludRechts = -1) And (yBoezemTaludRechts = -1) And (zBoezemTaludRechts = -1) Then tellerBoezemTaludRechts = 2 'Zoek de sloot op in het profiel, als er geen sloot is dan profiel niet aanmaken For tellerEen = 2 To totaalAantalKolommenPuntCodes 'If (arrayPuntCode(profielNummer, tellerEen) = 50) Or (arrayPuntCode(profielNummer, tellerEen + 1) = 50) Or (arrayPuntCode(profielNummer, tellerEen) = 51) Or (arrayPuntCode(profielNummer, tellerEen + 1) = 51) Then If (arrayPuntCode(profielNummer, tellerEen) = kantWaterBZM) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterBZM) Or (arrayPuntCode(profielNummer, tellerEen) = kantWaterBZMisDamwand) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterBZMisDamwand) Then xBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts) yBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts + 1) zBoezemTaludRechts = arrayProfielen(profielNummer, tellerBoezemTaludRechts + 2) tellerPuntcodesRechts = tellerEen arrayProcessLog(profielNummer, 6) = "TRUE" Exit For End If tellerEen = tellerEen + 1 tellerBoezemTaludRechts = tellerBoezemTaludRechts + 3 Next tellerEen End If 'Verlaat de procedure als er geen boezem is gedefinieerd If (xBoezemTaludRechts = -1) And (yBoezemTaludRechts = -1) And (zBoezemTaludRechts = -1) Then arrayProcessLog(profielNummer, 6) = "FALSE" arrayProcessLog(profielNummer, 7) = "FALSE" Exit Sub End If 'Lees de slootparameters in boezembodemligging = arrayProfielenSloot(profielNummer, 5) 'aLs er een damwand is dan taludhelling aanpassen If (arrayPuntCode(profielNummer, tellerEen) = kantWaterBZMisDamwand) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterBZMisDamwand) Then taludhellingRechts = 0.01 arrayProcessLog(profielNummer, 7) = "TRUE" Else taludhellingRechts = arrayProfielenSloot(profielNummer, 7) arrayProcessLog(profielNummer, 7) = "FALSE" End If 'Bereken dX en dY dX = xBoezemTaludRechts - arrayProfielen(profielNummer, 2) dY = yBoezemTaludRechts - arrayProfielen(profielNummer, 3) If (dX = 0) And (dY = 0) Then dX = arrayProfielen(profielNummer, 5) - arrayProfielen(profielNummer, 2) dY = arrayProfielen(profielNummer, 6) - arrayProfielen(profielNummer, 3) End If '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 'Definiëer tijdelijke array lengteTijdelijkeArray = totaalAantalKolommen - tellerBoezemTaludRechts + 1 lengteTijdelijkeArrayPuntCodes = totaalAantalKolommenPuntCodes - tellerPuntcodesRechts + 1 ReDim tijdelijkeArray(1, (lengteTijdelijkeArray)) ReDim tijdelijkeArrayPuntCodes(1, lengteTijdelijkeArrayPuntCodes) 'Lees data vanaf de locatie waar de sloot rechts eindigd For tellerVijf = 1 To lengteTijdelijkeArray tijdelijkeArray(1, tellerVijf) = arrayProfielen(geselecteerdProfiel, (tellerBoezemTaludRechts) + tellerVijf - 1) Next tellerVijf 'Lees data vanaf de locatie waar de sloot rechts eindigd en waar het nieuwe punt moet komen in een tijdelijke array For tellerVijf = 1 To lengteTijdelijkeArrayPuntCodes tijdelijkeArrayPuntCodes(1, tellerVijf) = arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesRechts) + tellerVijf - 1) 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 'Controleer daarbij wel op het feit dat punten t.p.v. het slootprofiel wegvallen If (tellerDrie - (tellerBoezemTaludRechts - 1)) >= totaalAantalKolommen Then 'Reserveer een extra ruimte voor de inpassing van de boezembodem 2*(x, y, z) in de array totaalAantalKolommen = totaalAantalKolommen + 6 totaalAantalKolommenPuntCodes = totaalAantalKolommenPuntCodes + 4 '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 breedteRechterTalud = taludhellingRechts * (zBoezemTaludRechts - boezembodemligging) 'Bereken coördinaten van de boezembodem aan de linkerkant xCodeLinks = Round((xBoezemTaludRechts - (breedteBoezembodem + breedteRechterTalud) * Sin(kaarthoek)), 3) yCodeLinks = Round((yBoezemTaludRechts - (breedteBoezembodem + breedteRechterTalud) * Cos(kaarthoek)), 3) zCodeLinks = boezembodemligging 'Bereken coördinaten van de slootbodem aan de rechterkant xCodeRechts = Round((xBoezemTaludRechts - breedteRechterTalud * Sin(kaarthoek)), 3) yCodeRechts = Round((yBoezemTaludRechts - breedteRechterTalud * Cos(kaarthoek)), 3) zCodeRechts = boezembodemligging 'Voeg de nieuwe punten (boezembodem) toe in de array's arrayProfielen(geselecteerdProfiel, 2) = xCodeLinks arrayProfielen(geselecteerdProfiel, 3) = yCodeLinks arrayProfielen(geselecteerdProfiel, 4) = zCodeLinks arrayPuntCode(geselecteerdProfiel, 2) = 16 arrayPuntCode(geselecteerdProfiel, 3) = 16 arrayProfielen(geselecteerdProfiel, 5) = xCodeRechts arrayProfielen(geselecteerdProfiel, 6) = yCodeRechts arrayProfielen(geselecteerdProfiel, 7) = zCodeRechts arrayPuntCode(geselecteerdProfiel, 4) = 15 arrayPuntCode(geselecteerdProfiel, 5) = 15 'kopieër de data uit de tijdelijke array terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArray 'Controleer of de teller niet groter wordt dan de breedte van de array If (7 + tellerZes) > totaalAantalKolommen Then Exit For End If arrayProfielen(geselecteerdProfiel, (7 + tellerZes)) = tijdelijkeArray(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (7 + tellerZes) < totaalAantalKolommen Then For tellerVijf = (7 + tellerZes) To totaalAantalKolommen arrayProfielen(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If 'kopieër de data uit de tijdelijke puntCodeArray terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArrayPuntCodes 'Controleer of de teller niet groter wordt dan de breedte van de array If (5 + tellerZes) > totaalAantalKolommenPuntCodes Then Exit For End If arrayPuntCode(geselecteerdProfiel, (5 + tellerZes)) = tijdelijkeArrayPuntCodes(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (5 + tellerZes) < totaalAantalKolommenPuntCodes Then For tellerVijf = (5 + tellerZes) To totaalAantalKolommenPuntCodes arrayPuntCode(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If End Sub Private Sub genereerSlootbodem(profielNummer As Long) '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 xCodeLinks, yCodeLinks, zCodeLinks As Double 'Coordinaten van de slootbodem aan de linkerkant Dim xCodeRechts, yCodeRechts, zCodeRechts As Double 'Coordinaten van de slootbodem aan de rechterkant Dim teller, tellerEen, tellerTwee, tellerDrie, tellerVijf, tellerZes As Long Dim caseSelect Dim breedteSloot As Double 'Breedte van de sloot Dim maxDiepteSloot As Double 'De maximale diepte van de sloot Dim diepteFactor As Double 'De vermenigvuldigingsfactor om de diepte van de sloot te bepalen Dim kaarthoek As Double Dim dX, dY, x2D, z2D As Double Dim xSlootbodemRechts, zSlootBodemRechts As Double 'Coördinaten van de slootbodem rechts Dim xSlootbodemLinks, zSlootBodemLinks As Double 'Coördinaten van de slootbodem rechts 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 breedteLinkerTalud, breedteRechterTalud Dim tempVar Dim tijdelijkeArray() Dim lengteTijdelijkeArray As Long Dim tellerPuntcodesLinks, tellerPuntcodesRechts As Long Dim tijdelijkeArrayPuntCodes() Dim lengteTijdelijkeArrayPuntCodes As Long Dim taludhellingLinks, taludhellingRechts, slootbodemligging As Double Dim tempTellerSlootkantLinks, tempTellerSlootkantRechts As Long Dim i As Integer Const insteeksslootPolderzijde = 2 Const insteeksslootPolderzijde2 = 102 Const insteekSlootdijkzijde = 5 Const insteekSlootdijkzijdeIsDamwand = 105 'Wordt hiermee (****taludhelling) rekening gehouden in script HHNK Const kantWaterDKSpolderzijde = 50 Const kantWaterDKSpolderzijdeIsDamwand = 51 Const kantWaterDKSdijkzijde = 60 Const kantWaterDKSdijkzijdeIsDamwand = 61 'Set trap 'on error GoTo errorHandler 'Set initialisatie waardem tellerSlootkantLinks = 2 xSlootrandLinks = -1 ySlootrandLinks = -1 zSlootrandLinks = -1 xSlootrandRechts = -1 ySlootrandRechts = -1 zSlootrandRechts = -1 tempTellerSlootkantLinks = -1 geselecteerdProfiel = profielNummer 'Zoek de sloot op in het profiel, als er geen sloot is dan profiel niet aanmaken For tellerEen = 2 To totaalAantalKolommenPuntCodes If (arrayPuntCode(profielNummer, tellerEen) = insteekSlootdijkzijde) Or (arrayPuntCode(profielNummer, tellerEen + 1) = insteekSlootdijkzijde) Or (arrayPuntCode(profielNummer, tellerEen) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerEen) = kantWaterDKSdijkzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerEen + 1) = kantWaterDKSdijkzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerEen) = insteekSlootdijkzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerEen + 1) = insteekSlootdijkzijdeIsDamwand) Then xSlootrandLinks = arrayProfielen(profielNummer, tellerSlootkantLinks) ySlootrandLinks = arrayProfielen(profielNummer, tellerSlootkantLinks + 1) zSlootrandLinks = arrayProfielen(profielNummer, tellerSlootkantLinks + 2) tellerPuntcodesLinks = tellerEen tellerSlootkantRechts = tellerSlootkantLinks + 3 arrayProcessLog(profielNummer, 2) = "TRUE" tempTellerSlootkantLinks = tellerSlootkantLinks + 3 For tellerTwee = (tellerEen + 2) To (totaalAantalKolommenPuntCodes - 1) 'Als code 60 gevonden wordt (snijpunt talud met water) dan deze nemen ipv de insteek van de sloot) If (arrayPuntCode(profielNummer, tellerTwee) = insteeksslootPolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = insteeksslootPolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = insteeksslootPolderzijde2) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = insteeksslootPolderzijde2) _ Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSpolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSpolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSpolderzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSpolderzijdeIsDamwand) Then 'Als het gevonden punt de waterkant is, zoek dan door of er ook een insteek bekend is. Als dit het geval is, dan de insteek nemen 'en niet de waterrand. Dit omdat dezelijnen niet altijd even goed gedefinieerd zijn If (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSpolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSpolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSpolderzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSpolderzijdeIsDamwand) Then tempTellerSlootkantRechts = tellerSlootkantRechts '+3 For tellerDrie = tellerTwee To (totaalAantalKolommenPuntCodes - 1) If (Val(arrayPuntCode(profielNummer, tellerDrie)) = insteeksslootPolderzijde) Or (Val(arrayPuntCode(profielNummer, tellerDrie + 1)) = insteeksslootPolderzijde) Or (Val(arrayPuntCode(profielNummer, tellerDrie)) = insteeksslootPolderzijde2) Or (Val(arrayPuntCode(profielNummer, tellerDrie + 1)) = insteeksslootPolderzijde2) _ Or (Val(arrayPuntCode(profielNummer, tellerDrie)) = insteekSlootdijkzijde) Or (Val(arrayPuntCode(profielNummer, tellerDrie + 1)) = insteekSlootdijkzijde) Then '****Deze laatste regel toegvoegd omdat het script van HHNK niet helemaal goed is. Kan later weg tellerSlootkantRechts = tempTellerSlootkantRechts xSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts) ySlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 1) zSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 2) tellerPuntcodesRechts = tellerDrie arrayProcessLog(profielNummer, 3) = 2 tellerTwee = tellerDrie Exit For End If tellerDrie = tellerDrie + 1 tempTellerSlootkantRechts = tempTellerSlootkantRechts + 3 Next tellerDrie End If If (xSlootrandRechts = -1) And (ySlootrandRechts = -1) And (zSlootrandRechts = -1) Then xSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts) ySlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 1) zSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 2) tellerPuntcodesRechts = tellerTwee arrayProcessLog(profielNummer, 3) = 2 Exit For End If ' Else ' xSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts) ' ySlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 1) ' zSlootrandRechts = arrayProfielen(profielNummer, tellerSlootkantRechts + 2) ' ' tellerPuntcodesRechts = tellerTwee ' ' arrayProcessLog(profielNummer, 3) = 2 ' ' Exit For ' End If Exit For End If tellerTwee = tellerTwee + 1 tellerSlootkantRechts = tellerSlootkantRechts + 3 If tempTellerSlootkantLinks <> -1 Then tempTellerSlootkantLinks = tempTellerSlootkantLinks + 3 End If Next tellerTwee 'Als er geen einde wordt gevonden van de sloot dan de sub verlaten If (tellerTwee >= totaalAantalKolommenPuntCodes) And (tellerPuntcodesRechts <> tellerTwee) Then 'i = MsgBox("In profiel " & arrayProfielen(profielNummer, 1) & " is geen eindpunt van de sloot gevonden." & Chr(13) & "De sloot wordt niet aangemaakt.", vbCritical, "Fout in slootgeneratie") arrayProcessLog(profielNummer, 3) = 1 arrayProcessLog(profielNummer, 5) = "FALSE" Exit Sub End If Exit For End If tellerEen = tellerEen + 1 tellerSlootkantLinks = tellerSlootkantLinks + 3 Next tellerEen 'Verlaat de procedure als er geen sloot is If (xSlootrandLinks = -1) And (ySlootrandLinks = -1) And (zSlootrandLinks = -1) Then arrayProcessLog(profielNummer, 3) = 0 arrayProcessLog(profielNummer, 2) = "FALSE" arrayProcessLog(profielNummer, 5) = "FALSE" 'Controleer of niet het eindpunt van de sloot is opgegeven For tellerTwee = 1 To (totaalAantalKolommenPuntCodes - 1) If (arrayPuntCode(profielNummer, tellerTwee) = insteeksslootPolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = insteeksslootPolderzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = insteeksslootPolderzijde2) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = insteeksslootPolderzijde2) Then arrayProcessLog(profielNummer, 3) = 1 arrayProcessLog(profielNummer, 2) = "TRUE" arrayProcessLog(profielNummer, 5) = "FALSE" Exit For End If Next tellerTwee Exit Sub Else 'Lees de slootparameters in slootbodemligging = Val(arrayProfielenSloot(profielNummer, 2)) taludhellingLinks = Val(arrayProfielenSloot(profielNummer, 3)) taludhellingRechts = Val(arrayProfielenSloot(profielNummer, 4)) 'Bereken dX en dY dX = xSlootrandRechts - xSlootrandLinks dY = ySlootrandRechts - ySlootrandLinks '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 de breedte van de sloot breedteSloot = Sqr((xSlootrandRechts - xSlootrandLinks) ^ 2 + (ySlootrandRechts - ySlootrandLinks) ^ 2) If (zSlootrandLinks <= slootbodemligging) Then 'Toon waarschuwing i = MsgBox("de slootbodem (dijkzijde) ligt hoger dan de insteek van de sloot in profiel " & arrayProfielenSloot(profielNummer, 1), vbCritical, "Fout!") arrayProcessLog(profielNummer, 5) = "FALSE" Exit Sub Else If taludhellingLinks = "" Then i = MsgBox("Sloot talludhelling links is niet bekend bij profiel" & arrayProfielenSloot(profielNummer, 1) & "/" & arrayProfielen(profielNummer, 1), vbCritical, "Fout!") Else breedteLinkerTalud = (zSlootrandLinks - slootbodemligging) * taludhellingLinks End If End If If (zSlootrandRechts <= slootbodemligging) Then 'Toon waarschuwing 'i = MsgBox("de slootbodem (polderzijde) ligt hoger dan de insteek van de sloot in profiel " & arrayProfielenSloot(profielNummer, 1), vbCritical, "Fout!") arrayProcessLog(profielNummer, 5) = "FALSE" Exit Sub Else breedteRechterTalud = (zSlootrandRechts - slootbodemligging) * taludhellingRechts End If 'Geef een waarschuwing als de taluds breeder zijn dan de sloot If breedteSloot < (breedteLinkerTalud + breedteRechterTalud) Then 'i = MsgBox("In profiel " & arrayProfielen(profielNummer, 1) & " levert de combinatie van taludhellingen en slootbodem een foutief profiel op." & Chr(13) & "De sloot wordt niet aangemaakt.", vbCritical, "Fout in slootgeneratie") breedteLinkerTalud = (1 / 3) * breedteSloot breedteRechterTalud = breedteLinkerTalud slootbodemligging = ((zSlootrandRechts + zSlootrandLinks) / 2) - 0.2 * breedteSloot '********** Voor Friesland aangepast, zodat altijd de diepte van de sloot gebruikt wordt. '********** Kan altijd aangepast worden als het niet goed past. ' 'Controleer of de slootbodem niet dieper wordt dan de opgegeven maximale diepte ' 'Als dit het geval is, dan de maximale slootdiepte gebruiken ' If (((zSlootrandLinks + zSlootrandRechts) / 2) - slootbodemligging) > 1.5 Then ' slootbodemligging = ((zSlootrandLinks + zSlootrandRechts) / 2) - 0.2 ' ' End If End If 'Bereken coördinaten van de slootbodem aan de linkerkant xCodeLinks = Round((xSlootrandLinks + breedteLinkerTalud * Sin(kaarthoek)), 3) yCodeLinks = Round((ySlootrandLinks + breedteLinkerTalud * Cos(kaarthoek)), 3) zCodeLinks = slootbodemligging 'Bereken coördinaten van de slootbodem aan de rechterkant xCodeRechts = Round((xSlootrandLinks + (breedteSloot - breedteRechterTalud) * Sin(kaarthoek)), 3) yCodeRechts = Round((ySlootrandLinks + (breedteSloot - breedteRechterTalud) * Cos(kaarthoek)), 3) zCodeRechts = slootbodemligging 'Om de slootbodem in te voegen moeten eventuele punten tussengevoegd worden en punten 'verwijderd worden als deze overschreven worden door het slootprofiel 'Definiëer tijdelijke array lengteTijdelijkeArray = totaalAantalKolommen - tellerSlootkantRechts + 1 lengteTijdelijkeArrayPuntCodes = totaalAantalKolommenPuntCodes - tellerPuntcodesRechts + 1 ReDim tijdelijkeArray(1, (lengteTijdelijkeArray)) ReDim tijdelijkeArrayPuntCodes(1, lengteTijdelijkeArrayPuntCodes) 'Lees data vanaf de locatie waar de sloot rechts eindigd For tellerVijf = 1 To lengteTijdelijkeArray tijdelijkeArray(1, tellerVijf) = arrayProfielen(geselecteerdProfiel, (tellerSlootkantRechts) + tellerVijf - 1) Next tellerVijf 'Lees data vanaf de locatie waar de sloot rechts eindigd en waar het nieuwe punt moet komen in een tijdelijke array For tellerVijf = 1 To lengteTijdelijkeArrayPuntCodes tijdelijkeArrayPuntCodes(1, tellerVijf) = arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesRechts) + tellerVijf - 1) 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 'Controleer daarbij wel op het feit dat punten t.p.v. het slootprofiel wegvallen If (tellerDrie - (tellerSlootkantRechts - tellerSlootkantLinks - 1)) >= totaalAantalKolommen Then 'Reserveer een extra ruimte voor de inpassing van de slootbodem 2*(x, y, z) in de array totaalAantalKolommen = totaalAantalKolommen + 6 totaalAantalKolommenPuntCodes = totaalAantalKolommenPuntCodes + 4 '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 de nieuwe punten (slootbodem) toe in de array's arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 3)) = xCodeLinks arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 4)) = yCodeLinks arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 5)) = zCodeLinks arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesLinks + 2)) = 4 arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesLinks + 3)) = 4 arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 6)) = xCodeRechts arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 7)) = yCodeRechts arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 8)) = zCodeRechts arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesLinks + 4)) = 3 arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesLinks + 5)) = 3 'kopieër de data uit de tijdelijke array terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArray 'Controleer of de teller niet groter wordt dan de breedte van de array If (tellerSlootkantLinks + 8 + tellerZes) > totaalAantalKolommen Then Exit For End If arrayProfielen(geselecteerdProfiel, (tellerSlootkantLinks + 8 + tellerZes)) = tijdelijkeArray(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (tellerSlootkantLinks + 8 + tellerZes) < totaalAantalKolommen Then For tellerVijf = (tellerSlootkantLinks + 8 + tellerZes) To totaalAantalKolommen arrayProfielen(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If 'kopieër de data uit de tijdelijke puntCodeArray terug in de nieuwe array For tellerZes = 1 To lengteTijdelijkeArrayPuntCodes 'Controleer of de teller niet groter wordt dan de breedte van de array If (tellerPuntcodesLinks + 5 + tellerZes) > totaalAantalKolommenPuntCodes Then Exit For End If arrayPuntCode(geselecteerdProfiel, (tellerPuntcodesLinks + 5 + tellerZes)) = tijdelijkeArrayPuntCodes(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (tellerPuntcodesLinks + 5 + tellerZes) < totaalAantalKolommenPuntCodes Then For tellerVijf = (tellerPuntcodesLinks + 5 + tellerZes) To totaalAantalKolommenPuntCodes arrayPuntCode(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If End If arrayProcessLog(profielNummer, 5) = "TRUE" 'voorkom dat de routine onnodig wordt uitgevoerd Exit Sub errorHandler: 'Toon waarschuwing i = MsgBox("Fout in de invoerbestanden", vbCritical, "Fout!") 'Set Knooppuntnummer knooppuntNummer = 1 'Teken het profiel opnieuw Call tekenProfielen(geselecteerdProfiel) 'Zet de knoppen volgende en vorrige aan cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True End Sub Private Sub cdmPuntCodes_Click() 'Toon het schema met de puntcodes frmPuntCodes.Show 1 End Sub Private Sub cmdJump_Click() Dim i As Integer On Error GoTo errorHandler 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdJump.Enabled = False '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, 10) = txtLogboek.Text geselecteerdProfiel = txtJumpTo.Text 'Verminder het nummer van het geselecteerde profiel If geselecteerdProfiel > aantalProfielen Then geselecteerdProfiel = aantalProfielen ElseIf geselecteerdProfiel < 1 Then geselecteerdProfiel = geselecteerdProfiel - 1 End If 'Geef aan welk punt geselecteerd moet worden lblSelect.Caption = "Rechter punt voor interpolatie" 'Set Knooppuntnummer knooppuntNummer = 2 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) If arrayProcessLog(geselecteerdProfiel, 8) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False End If 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 10) txtLogboek.SetFocus 'De Blokkeer de command knoppen cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True 'voorkom dat de error handler onnodig uitgevoerd wordt Exit Sub errorHandler: txtJumpTo = 1 cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True 'Toon waarschuwing i = MsgBox("Ongeldig profielnummer", vbCritical, "Fout!") End Sub Private Sub cmdOk_Click() 'Declareer locale variabelen Dim i i = MsgBox("Weet u zeker dat u naar het volgende scherm wilt?", vbYesNo, "Let op!") If i = vbYes Then 'Sluit het huidige scherm en open het scherm opslaan Unload frmPL frmOpslaan.Show 1 End If 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 Else lineBoezempeil.Visible = True linePolderpeil.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, 8) = "FALSE" cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True arrayProcessLog(geselecteerdProfiel, 8) = "TRUE" cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False End If End Sub Private Sub cmdVolgende_Click() 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdJump.Enabled = False '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, 10) = 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 = "Rechter punt voor interpolatie" 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) If arrayProcessLog(geselecteerdProfiel, 8) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False End If 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 10) 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 cmdJump.Enabled = True End Sub Private Sub cmdVorrige_Click() 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdJump.Enabled = False '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, 10) = 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 = "Rechter punt voor interpolatie" 'Set Knooppuntnummer knooppuntNummer = 2 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) If arrayProcessLog(geselecteerdProfiel, 8) = "FALSE" Then lineDeleted1.Visible = False lineDeleted2.Visible = False cmdVerwijder.Caption = "Verwijder profiel bij opslaan" picDwarsprofiel.Enabled = True Else lineDeleted1.Visible = True lineDeleted2.Visible = True cmdVerwijder.Caption = "Maak verwijderen ongedaan" picDwarsprofiel.Enabled = False End If 'Toon de opmerkingen in de logfile Array txtLogboek.Text = arrayProcessLog(geselecteerdProfiel, 10) txtLogboek.SetFocus 'De Blokkeer de command knoppen cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True End Sub Private Sub Command1_Click() End Sub Private Sub Form_Load() 'Declareer lokale variabelen Dim tellerEen As Long 'Declareer lokale constanten Const defaultBoezempeil = -0.4 Const defaultPolderpeil = -2 Const defaultMaxSlootdiepte = 1.5 Const defaultDieptefactor = 0.2 'Toon de default waarden in de tekstvakken txtLiggingBoezempeil.Text = defaultBoezempeil txtLiggingPolderpeil.Text = defaultPolderpeil txtMaxDiepteSloot.Text = defaultMaxSlootdiepte txtDieptefactor.Text = defaultDieptefactor 'Toon de bestandsnaam in het form caption frmPL.Caption = "Edit en controleer dwarsprofiel: " + inputBestand 'Toon het aantal ingelezen profielen lblAantalProfielen.Caption = aantalProfielen For tellerEen = 1 To aantalProfielen Call genereerBoezembodem(tellerEen) Call genereerSlootbodem(tellerEen) Next tellerEen ' Lees het ini bestand met daarin de logboek items Call leesDitchIni 'Teken het eerste profiel Call tekenProfielen(1) 'Geef de waarde 1 mee met het 1e profiel geselecteerdProfiel = 1 'Set Rand_sloot 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 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 = -(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) = lengteProfiel 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 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, 2) = oldX arrayKnooppunten(tellerEen, 3) = oldY arrayKnooppunten(tellerEen, 4) = oldZ 'Definieer de knooppunten MV_boezem arrayKnooppunten(tellerEen, 35) = startX arrayKnooppunten(tellerEen, 36) = startY arrayKnooppunten(tellerEen, 37) = startZ 'Wis listbox 'list1.Clear 'Teken de knooppunten For tellerVier = 2 To 35 '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 Polder" '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") '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 picDwarsprofiel.Circle (knooppuntL, arrayKnooppunten(tellerEen, tellerVier + 2)), schaal / 100, QBColor(8) Case 5 'list1.AddItem "Teen Sloot" '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" Case 8 'list1.AddItem "Teen Polder" '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" Case 11 'list1.AddItem "Berm 1" '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" Case 14 'list1.AddItem "Berm 2" '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" Case 17 'list1.AddItem "Kruin Polder" '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" Case 20 'list1.AddItem "Rand Polder verkeersbelasting" '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" Case 23 'list1.AddItem "Rand boezem verkeersbelasting" '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" Case 26 'list1.AddItem "Kruin 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") '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" Case 29 'list1.AddItem "Beschoeiing" '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" Case 32 'list1.AddItem "Teen 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") '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" Case 35 '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") '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 picDwarsprofiel.Circle (knooppuntL, arrayKnooppunten(tellerEen, tellerVier + 2)), schaal / 100, QBColor(8) End Select End If 'Keer terug op een X-Coördinaat in de array tellerVier = tellerVier + 2 Next tellerVier Call tekenPeilen(picDwarsprofiel.ScaleWidth) 'Toon de maximale en minimale Z waarde lblMaxZ.Caption = Round(maxZ, 2) & " m" lblMinZ.Caption = Round(minZ, 2) & " m" lblDZ.Caption = Round((maxZ - minZ), 2) & " m" lblLengte.Caption = Round(lengteProfiel, 2) aantallijnen = (Fix(kruisdraadVerticaal.Y1 - kruisdraadVerticaal.Y2)) * 2 'Teken referentielijnen For tellerEen = 1 To aantallijnen 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) Dim liggingBoezempeil, liggingPolderpeil As Double Dim i As Integer 'Set trap On Error GoTo errorHandler 'Lees de peilen liggingBoezempeil = txtLiggingBoezempeil.Text liggingPolderpeil = txtLiggingPolderpeil.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 'voorkom dat de routine onnodig wordt uitgevoerd Exit Sub errorHandler: liggingBoezempeil = 0.6 liggingPolderpeil = -2 '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 '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 xCodeLinks, yCodeLinks, zCodeLinks As Double 'Coordinaten van de slootbodem aan de linkerkant Dim xCodeRechts, yCodeRechts, zCodeRechts As Double 'Coordinaten van de slootbodem aan de rechterkant Dim teller, tellerTwee, tellerDrie, tellerVijf, tellerZes As Long Dim caseSelect Dim breedteSloot As Double 'Breedte van de sloot Dim maxDiepteSloot As Double 'De maximale diepte van de sloot Dim diepteFactor As Double 'De vermenigvuldigingsfactor om de diepte van de sloot te bepalen Dim kaarthoek As Double Dim dX, dY, x2D, z2D As Double Dim xSlootbodemRechts, zSlootBodemRechts As Double 'Coördinaten van de slootbodem rechts Dim xSlootbodemLinks, zSlootBodemLinks As Double 'Coördinaten van de slootbodem rechts 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 Dim deltaZ2, deltaL2 As Double Dim i As Integer ' 'Set trap On Error GoTo errorHandler 'Zet de knoppen volgende en vorrige uit cmdVolgende.Enabled = False cmdVorrige.Enabled = False cmdJump.Enabled = False '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 picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) '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 picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) '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 picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) Else teller = teller - 1 'Voorkom dat het eerste punt gekozen wordt If teller = 1 Then teller = 2 End If picDwarsprofiel.Circle (tempArray2DProfiel(teller, 1), tempArray2DProfiel(teller, 2)), schaal / 100, QBColor(8) 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 = MV_polder '2 = Waterlijn_sloot rechts '3 = Waterlijn_sloot links '12 = MV_boezem caseSelect = knooppuntNummer 'Bepaal welk punt aangeklikt wordt en bewaar het punt Select Case caseSelect Case 2 xSlootrandRechts = xCode ySlootrandRechts = yCode zSlootrandRechts = zCode 'list1.AddItem "Sloot rechts" lblSelect.Caption = "Linker punt voor interpolatie" 'Bewaar de locatie van de slootkant rechts in de 2D array tellerSlootkantRechts = teller Case 3 xSlootrandLinks = xCode ySlootrandLinks = yCode zSlootrandLinks = zCode 'list1.AddItem "Sloot links" lblSelect.Caption = "Rechter punt voor interpolatie" 'Bewaar de locatie van de slootkant links in de 2D array tellerSlootkantLinks = teller 'Bereken de breedte van de sloot breedteSloot = Sqr((xSlootrandLinks - xSlootrandRechts) ^ 2 + (ySlootrandLinks - ySlootrandRechts) ^ 2) 'Lees de maximale slootdiepte in maxDiepteSloot = txtMaxDiepteSloot.Text 'Lees de dieptefactor in diepteFactor = txtDieptefactor.Text 'Bereken 2D coördinaten van het slootprofiel aan de linkerzijde xSlootbodemLinks = tempArray2DProfiel(teller, 1) + 1 / 3 * breedteSloot zSlootBodemLinks = zSlootrandLinks + (zSlootrandRechts - zSlootrandLinks) * (1 / 3) 'Controleer of de slootbodem niet dieper wordt dan de opgegeven maximale diepte 'Als dit het geval is, dan de maximale slootdiepte gebruiken 'If (((zSlootrandLinks + zSlootrandRechts) / 2) - zSlootBodemLinks) > maxDiepteSloot Then ' zSlootBodemLinks = ((zSlootrandLinks + zSlootrandRechts) / 2) - maxDiepteSloot 'End If 'De diepte van de slootbodem is links en rechts gelijk zSlootBodemRechts = zSlootrandLinks + (zSlootrandRechts - zSlootrandLinks) * (2 / 3) 'Bereken 2D coördinaten van het slootprofiel aan de Rechterzijde xSlootbodemRechts = tempArray2DProfiel(teller, 1) + 2 / 3 * breedteSloot 'Toon de waarden van de ligging van de slootbodem 'list1.AddItem "Slootbodem links = NAP " & zSlootBodemLinks & " m" 'list1.AddItem "Slootbodem rechts = NAP " & zSlootBodemRechts & " m" 'list1.AddItem "Breedte sloot = " & Format(breedteSloot, "###0.00") & " m" 'Toon het aangemaakte slootprofiel 'picDwarsprofiel.Circle (xSlootbodemRechts, zSlootBodemRechts), schaal / 50, QBColor(8) 'picDwarsprofiel.Circle (xSlootbodemLinks, zSlootBodemLinks), schaal / 50, QBColor(8) picDwarsprofiel.Line (tempArray2DProfiel(teller, 1), zSlootrandLinks)-(xSlootbodemLinks, zSlootBodemLinks) picDwarsprofiel.Line (xSlootbodemLinks, zSlootBodemLinks)-(xSlootbodemRechts, zSlootBodemRechts) picDwarsprofiel.Line (xSlootbodemRechts, zSlootBodemRechts)-(tempArray2DProfiel(teller, 1) + breedteSloot, zSlootrandRechts) 'Vraag de gebruiker of het profiel aangemaakt moet worden i = MsgBox("Voorstel slootprofiel verwerken in profiel?", vbOKCancel, "Profiel updaten?") If i = 1 Then 'Profiel geaccepteerd. Update de puntenarray's 'Houd bij dat het profiel aangepast is arrayProcessLog(geselecteerdProfiel, 9) = "TRUE" 'Bereken dX en dY dX = xSlootrandRechts - xSlootrandLinks dY = ySlootrandRechts - ySlootrandLinks '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 deltaL2 = Sqr((xSlootrandLinks - xSlootrandRechts) ^ 2 + (ySlootrandLinks - ySlootrandRechts) ^ 2) deltaZ2 = zSlootrandRechts - zSlootrandLinks 'Bereken coördinaten van de slootbodem aan de rechterkant xCodeRechts = Round((xSlootrandLinks + 2 / 3 * breedteSloot * Sin(kaarthoek)), 3) yCodeRechts = Round((ySlootrandLinks + 2 / 3 * breedteSloot * Cos(kaarthoek)), 3) zCodeRechts = zSlootrandLinks + (deltaZ2) * (2 / 3) 'Bereken coördinaten van de slootbodem aan de linkerkant xCodeLinks = Round((xSlootrandLinks + 1 / 3 * breedteSloot * Sin(kaarthoek)), 3) yCodeLinks = Round((ySlootrandLinks + 1 / 3 * breedteSloot * Cos(kaarthoek)), 3) zCodeLinks = zSlootrandLinks + (deltaZ2) * (1 / 3) 'Om de slootbodem in te voegen moeten eventuele punten tussengevoegd worden en punten 'verwijderd worden als deze overschreven worden door het slootprofiel 'Definiëer tijdelijke array lengteTijdelijkeArray = totaalAantalKolommen - (1 + (tellerSlootkantRechts - 1) * 3) lengteTijdelijkeArrayPuntCodes = totaalAantalKolommenPuntCodes - (1 + (tellerSlootkantRechts - 1) * 2) ReDim tijdelijkeArray(1, (lengteTijdelijkeArray)) ReDim tijdelijkeArrayPuntCodes(1, lengteTijdelijkeArrayPuntCodes) 'Lees data vanaf de locatie waar de sloot rechts eindigd For tellerVijf = 1 To lengteTijdelijkeArray tijdelijkeArray(1, tellerVijf) = arrayProfielen(geselecteerdProfiel, ((1 + (tellerSlootkantRechts - 1) * 3) + tellerVijf)) Next tellerVijf 'Lees data vanaf de locatie waar de sloot rechts eindigd en waar het nieuwe punt moet komen in een tijdelijke array For tellerVijf = 1 To lengteTijdelijkeArrayPuntCodes tijdelijkeArrayPuntCodes(1, tellerVijf) = arrayPuntCode(geselecteerdProfiel, ((1 + (tellerSlootkantRechts - 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 'Controleer daarbij wel op het feit dat punten t.p.v. het slootprofiel wegvallen If (tellerDrie - (tellerSlootkantRechts - tellerSlootkantLinks - 1)) >= totaalAantalKolommen Then 'Reserveer een extra ruimte voor de inpassing van de slootbodem 2*(x, y, z) in de array totaalAantalKolommen = totaalAantalKolommen + 6 totaalAantalKolommenPuntCodes = totaalAantalKolommenPuntCodes + 4 '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 de nieuwe punten (slootbodem) toe in de array's arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 1) * 3 - 2)) = xCodeLinks arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 1) * 3 - 1)) = yCodeLinks arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 1) * 3)) = zCodeLinks arrayPuntCode(geselecteerdProfiel, ((tellerSlootkantLinks + 1) * 2)) = 99 arrayPuntCode(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 1) * 2)) = 999 arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 3 - 2)) = xCodeRechts arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 3 - 1)) = yCodeRechts arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 3)) = zCodeRechts arrayPuntCode(geselecteerdProfiel, ((tellerSlootkantLinks + 2) * 2)) = 99 arrayPuntCode(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 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 + (tellerSlootkantLinks + 2) * 3 + tellerZes) > totaalAantalKolommen Then Exit For End If arrayProfielen(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 3 + tellerZes)) = tijdelijkeArray(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (1 + (tellerSlootkantLinks + 2) * 3 + tellerZes) < totaalAantalKolommen Then For tellerVijf = (1 + (tellerSlootkantLinks + 2) * 3 + tellerZes) To totaalAantalKolommen arrayProfielen(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If '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 + (tellerSlootkantLinks + 2) * 2 + tellerZes) > totaalAantalKolommenPuntCodes Then Exit For End If arrayPuntCode(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 2 + tellerZes)) = tijdelijkeArrayPuntCodes(1, tellerZes) Next tellerZes 'Controleer of er nog data na het ingevoegde stuk van het profiel kan staan in de oude array 'Als dit zo is, wis dan de achterliggende cellen. If (1 + (tellerSlootkantLinks + 2) * 2 + tellerZes) < totaalAantalKolommenPuntCodes Then For tellerVijf = (1 + (tellerSlootkantLinks + 2) * 2 + tellerZes) To totaalAantalKolommenPuntCodes arrayPuntCode(geselecteerdProfiel, tellerVijf) = "" Next tellerVijf End If 'Teken het profiel opnieuw Call tekenProfielen(geselecteerdProfiel) 'Set Knooppuntnummer knooppuntNummer = 1 'Zet de knoppen volgende en vorrige aan cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True Else 'Als voorstel niet geaccepteerd wordt 'Teken het profiel opnieuw Call tekenProfielen(geselecteerdProfiel) 'Set Knooppuntnummer knooppuntNummer = 1 'Zet de knoppen volgende en vorrige aan cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True End If 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 ingevoerde parameters zijn geen getal", vbCritical, "Fout!") 'Set Knooppuntnummer knooppuntNummer = 1 'Teken het profiel opnieuw Call tekenProfielen(geselecteerdProfiel) 'Zet de knoppen volgende en vorrige aan cmdVolgende.Enabled = True cmdVorrige.Enabled = True cmdJump.Enabled = True 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