VERSION 5.00 Begin VB.Form frmPL AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 11595 ClientLeft = 45 ClientTop = 330 ClientWidth = 21525 ControlBox = 0 'False Icon = "frmPL.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 11595 ScaleWidth = 21525 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame1 Height = 4455 Left = 14520 TabIndex = 29 Top = 6960 Width = 6855 Begin VB.PictureBox Picture1 BackColor = &H00FFFFFF& Height = 2775 Left = 120 Picture = "frmPL.frx":1272 ScaleHeight = 2715 ScaleWidth = 6555 TabIndex = 30 Top = 240 Width = 6615 End Begin VB.Line Line4 Visible = 0 'False X1 = 120 X2 = 6720 Y1 = 3360 Y2 = 3360 End Begin VB.Label lblSelect Alignment = 2 'Center BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = "Selecteer slootkant rechts" BeginProperty Font Name = "MS Sans Serif" Size = 24 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 120 TabIndex = 31 Top = 3600 Width = 6615 End End Begin VB.Frame Frame4 Caption = "Hulplijnen peilen" Height = 1480 Left = 360 TabIndex = 13 Top = 9960 Width = 6855 Begin VB.TextBox txtDieptefactor Alignment = 1 'Right Justify Height = 285 Left = 5520 TabIndex = 28 Text = "0.2" Top = 960 Width = 735 End Begin VB.TextBox txtMaxDiepteSloot Alignment = 1 'Right Justify 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 = 3300 Left = 11760 TabIndex = 12 Top = 8160 Width = 2655 Begin VB.CommandButton cmdUpdate Caption = "Update peilen" Height = 495 Left = 120 TabIndex = 26 Top = 2400 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 = 120 X2 = 840 Y1 = 1320 Y2 = 1320 End Begin VB.Label Label12 AutoSize = -1 'True Caption = "= Polderpeil" Height = 195 Left = 960 TabIndex = 21 Top = 1200 Width = 825 End Begin VB.Label Label10 AutoSize = -1 'True Caption = "= Boezempeil" Height = 195 Left = 960 TabIndex = 20 Top = 1680 Width = 945 End Begin VB.Line Line2 BorderColor = &H00FF0000& BorderStyle = 3 'Dot X1 = 120 X2 = 840 Y1 = 1800 Y2 = 1800 End End Begin VB.CommandButton cmdOK Caption = "OK >>" Height = 495 Left = 2520 TabIndex = 3 Top = 9240 Width = 1935 End Begin VB.CommandButton cmdVorrige Caption = "<< Vorige" Height = 495 Left = 360 TabIndex = 1 Top = 8280 Width = 2055 End Begin VB.CommandButton cmdVolgende Caption = "Volgende >>" Height = 495 Left = 2520 TabIndex = 2 Top = 8280 Width = 1935 End Begin VB.Frame Frame2 Caption = "Bestandsinformatie" Height = 1095 Left = 360 TabIndex = 7 Top = 6960 Width = 14055 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 = 360 TabIndex = 4 Top = 9240 Width = 1935 End Begin VB.PictureBox picDwarsprofiel AutoRedraw = -1 'True BackColor = &H00FFFFFF& ForeColor = &H00C00000& Height = 6495 Left = 480 MousePointer = 2 'Cross ScaleHeight = 6435 ScaleWidth = 20835 TabIndex = 0 Top = 120 Width = 20895 Begin VB.Line linePolderpeil BorderColor = &H00C000C0& BorderStyle = 3 'Dot X1 = 360 X2 = 1560 Y1 = 1680 Y2 = 1680 End Begin VB.Line lineBoezempeil BorderColor = &H00FF0000& BorderStyle = 3 'Dot 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.Line Line1 X1 = 360 X2 = 4440 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 = 21090 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 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 kantWaterBZMisDamwand = 71 'Set initialisatie waardem tellerBoezemTaludRechts = 2 xBoezemTaludRechts = -1 yBoezemTaludRechts = -1 zBoezemTaludRechts = -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) = 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 '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 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 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 arrayProcessLog(profielNummer, 2) = "TRUE" '*****Klopt dit?????? If (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSdijkzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijdeIsDamwand) Then tempTellerSlootkantLinks = -1 Else tempTellerSlootkantLinks = tellerSlootkantLinks + 3 End If 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) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSdijkzijdeIsDamwand) Or _ (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijdeIsDamwand) 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 If (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijde) Or (arrayPuntCode(profielNummer, tellerTwee) = kantWaterDKSdijkzijdeIsDamwand) Or (arrayPuntCode(profielNummer, tellerTwee + 1) = kantWaterDKSdijkzijdeIsDamwand) Then If tempTellerSlootkantLinks <> -1 Then xSlootrandLinks = arrayProfielen(profielNummer, tempTellerSlootkantLinks) ySlootrandLinks = arrayProfielen(profielNummer, tempTellerSlootkantLinks + 1) zSlootrandLinks = arrayProfielen(profielNummer, tempTellerSlootkantLinks + 2) tellerPuntcodesLinks = tellerTwee tellerSlootkantLinks = tempTellerSlootkantLinks tempTellerSlootkantLinks = -1 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 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 = arrayProfielenSloot(profielNummer, 2) taludhellingLinks = arrayProfielenSloot(profielNummer, 3) taludhellingRechts = 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 breedteLinkerTalud = (zSlootrandLinks - slootbodemligging) * taludhellingLinks 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") '********* opnemen 1/3 regel Exit Sub 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 End Sub Private Sub cdmPuntCodes_Click() 'Toon het schema met de puntcodes frmPuntCodes.Show 1 End Sub Private Sub cmdOk_Click() 'Sluit het huidige scherm en open het scherm opslaan Unload frmPL frmOpslaan.Show 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() 'Teken de peilen in Call tekenPeilen(picDwarsprofiel.ScaleWidth) End Sub Private Sub cmdVolgende_Click() 'Blokkeer de command knoppen cmdVolgende.Enabled = False cmdVorrige.Enabled = False 'Deblokeer het editvenster picDwarsprofiel.Enabled = True 'Toon de kruisdraden kruisdraadHorizontaal.Visible = True kruisdraadVerticaal.Visible = True 'Set de laatste X laatsteX = 0 '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 slootkant rechts" 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) '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 'Deblokeer het editvenster picDwarsprofiel.Enabled = True 'Toon de kruisdraden kruisdraadHorizontaal.Visible = True kruisdraadVerticaal.Visible = True 'Set de laatste X laatsteX = 0 '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 slootkant rechts" 'Set Knooppuntnummer knooppuntNummer = 2 'Teken het nieuwe profiel Call tekenProfielen(geselecteerdProfiel) 'De Blokkeer de command knoppen cmdVolgende.Enabled = True cmdVorrige.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 = "Invoegen slootprofiel: " + inputBestand 'Toon het aantal ingelezen profielen lblAantalProfielen.Caption = aantalProfielen For tellerEen = 1 To aantalProfielen Call genereerBoezembodem(tellerEen) Call genereerSlootbodem(tellerEen) Next tellerEen '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 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) = 72 Or arrayPuntCode(tellerEen, tellerCode + 1) = 72 Then 'Asfalt picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(9) ElseIf arrayPuntCode(tellerEen, tellerCode) = 18 Or arrayPuntCode(tellerEen, tellerCode + 1) = 18 Then 'Buitenkruinlijn , wordt weergegeven als referentie lijn picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(4) ElseIf arrayPuntCode(tellerEen, tellerCode) = 3 Or arrayPuntCode(tellerEen, tellerCode + 1) = 3 Then 'Buitenteenlijn , wordt weergegeven als referentie lijn picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(3) ElseIf arrayPuntCode(tellerEen, tellerCode) = 4 Or arrayPuntCode(tellerEen, tellerCode + 1) = 4 Then 'Binnenkruinlijn picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(5) ElseIf arrayPuntCode(tellerEen, tellerCode) = 5 Or arrayPuntCode(tellerEen, tellerCode + 1) = 5 Then 'Begin en einde insteek teensloot dijk picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(4) ElseIf arrayPuntCode(tellerEen, tellerCode) = 5 Or arrayPuntCode(tellerEen, tellerCode + 1) = 105 Then 'Begin en einde insteek teensloot dijk picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(4) ElseIf arrayPuntCode(tellerEen, tellerCode) = 60 Or arrayPuntCode(tellerEen, tellerCode + 1) = 60 Then 'Kant water sloot dijkzijde picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(12) ElseIf arrayPuntCode(tellerEen, tellerCode) = 61 Or arrayPuntCode(tellerEen, tellerCode + 1) = 61 Then 'Kant water sloot dijkzijde picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(12) ElseIf arrayPuntCode(tellerEen, tellerCode) = 70 Or arrayPuntCode(tellerEen, tellerCode + 1) = 70 Then 'Boezem water snijpunt picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(10) ElseIf arrayPuntCode(tellerEen, tellerCode) = 71 Or arrayPuntCode(tellerEen, tellerCode + 1) = 71 Then 'Boezem water snijpunt damwand picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(10) ElseIf arrayPuntCode(tellerEen, tellerCode) = 2 Or arrayPuntCode(tellerEen, tellerCode + 1) = 2 Then 'Begin en einde insteek teensloot polder picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(2) ElseIf arrayPuntCode(tellerEen, tellerCode) = 2 Or arrayPuntCode(tellerEen, tellerCode + 1) = 102 Then 'Begin en einde insteek teensloot polder picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(2) ElseIf arrayPuntCode(tellerEen, tellerCode) = 8 Or arrayPuntCode(tellerEen, tellerCode + 1) = 8 Then 'Beschoeiing picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(1) ElseIf arrayPuntCode(tellerEen, tellerCode) = 50 Or arrayPuntCode(tellerEen, tellerCode + 1) = 50 Then 'Snijpunt met water polderzijde picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(13) ElseIf arrayPuntCode(tellerEen, tellerCode) = 51 Or arrayPuntCode(tellerEen, tellerCode + 1) = 51 Then 'Snijpunt met water polderzijde picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(13) Else 'Code niet bekend picDwarsprofiel.Circle (lengteProfiel, newZ), schaal / 250, QBColor(9) 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) 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 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 i As Integer ' 'Set trap On Error GoTo errorHandler 'Zet de knoppen volgende en vorrige uit cmdVolgende.Enabled = False cmdVorrige.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 = "Selecteer slootkant links" '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 = "Selecteer slootkant rechts" '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) / 2) - diepteFactor * breedteSloot '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 = zSlootBodemLinks '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 / 100, QBColor(8) picDwarsprofiel.Circle (xSlootbodemLinks, zSlootBodemLinks), schaal / 100, 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 '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 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 = zSlootBodemRechts '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 = zSlootBodemLinks '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)) = 2 arrayPuntCode(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 1) * 2)) = 2 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)) = 2 arrayPuntCode(geselecteerdProfiel, (1 + (tellerSlootkantLinks + 2) * 2)) = 2 '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 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 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 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