'H9HUKDUGLQJV'HWDLO*HQHUDWRU. vervaardiging van een AutoCAD-tool

'H9HUKDUGLQJV'HWDLO*HQHUDWRU vervaardiging van een AutoCAD-tool

Auteur: Marcel Pennings Begeleidende docent: Ronald Boeklagen HBO-deeltijdopleiding AutoCAD system engineer (ACE) TEC; Twente engineering Consultancy bv, CAD College te Nijmegen mei 2003

9RRUZRRUG Mijn naam is Marcel Pennings. Ik ben gehuwd met Mireille en heb twee zonen. Sjoerd van vijf en Jeroen van twee. Ik ben werkzaam bij de afdeling specialisme en ondersteuning van Rijkswaterstaat Directie Noord-Brabant te ’s-Hertogenbosch. Ik ben daar werkzaam als beheerder automatisering CAD-systemen sinds mei 2001. Daarvoor was ik negen jaar actief op de ontwerpafdeling als technisch medewerker. In het kader van mijn opleidingstraject kwam ik in aanraking met het HBO-traject AutoCAD System Engineer. Omdat dit traject een mooi vervolg is op mijn reeds doorlopen opleidingen ben ik dit gaan volgen. Vandaar dat er nu een scriptie voor u ligt van mijn hand. Één van de eisen van mijn leidinggevende was dat de afstudeeropdracht zou resulteren in een nuttig hulpmiddel voor de afdeling wegontwerp. De ontwikkelde tool zal dan ook daadwerkelijk gebruikt gaan worden op deze afdeling. Het onderwerp voor de opdracht heb ik gekozen in samenspraak met David Siahaya. Dhr. Siahaya is adviseur automatisering wegontwerp binnen dezelfde afdeling en mijn direct leidinggevende. Verder heeft hij mij op diverse vlakken voorzien van adviezen. Andere collega’s die mij geholpen hebben zijn de materiaaldeskundigen Ad v.d. Berk en Ron v.d. Aa. Zij hebben alle relevante gegevens aangereikt om de opdracht de juiste technische invulling te kunnen geven op het gebied van de materialen en de eisen die daaraan gesteld worden. Graag wil ik de drie heren vanaf deze plaats bedanken voor hun inzet, adviezen en hulp. Zonder hen had ik deze opdracht niet kunnen voltooien. Vanuit het opleidingsinstituut TEC ben ik begeleid door Ronald Boeklagen. Hij heeft mij tijdens het afstuderen vooral bijgestaan met adviezen en tips op het gebied van programmeren, het schrijven van de scriptie en het maken van de presentatie. Ook hem wil ik hiervoor hartelijk danken. Verder wil ik Ben Mooren (onderafdelingshoofd van de afdeling specialisme en ondersteuning) bedanken omdat hij mij de mogelijkheid heeft geboden deze opleiding te kunnen volgen.

Student: Marcel Pennings

Blz.2

,QKRXGVRSJDYH 9RRUZRRUG

2UJDQLVDWLH 1.1.

Rijkswaterstaat landelijk.................................................................................................. 4

1.1.1. 1.2.

Organogram............................................................................................................. 4

Rijkswaterstaat Directie Noord-Brabant.......................................................................... 5

1.2.1.

Kerntaken ................................................................................................................ 5

1.2.2.

Beheergebied .......................................................................................................... 5

1.2.3.

Organogram............................................................................................................. 6

1.3.

Ontwerpafdeling IVA ....................................................................................................... 6

1.4.

Automatisering ................................................................................................................ 7

1.4.1.

Applicaties ............................................................................................................... 7

2SGUDFKW 2.1.

Aanleiding ....................................................................................................................... 8

2.2.

Probleemstelling ............................................................................................................. 8

2.3.

Mogelijke oplossingen..................................................................................................... 8

2.4.

Onderzoek ...................................................................................................................... 9

2.4.1.

Verhardingsmaterialen ............................................................................................ 9

2.4.2.

Verhardingsdetails ................................................................................................... 9

3URJUDPPD 3.1.

Stroomschema.............................................................................................................. 11

3.2.

Werking......................................................................................................................... 11

3.2.1.

Dialoogbox............................................................................................................. 12

3.2.2.

Resultaat................................................................................................................ 15

3.2.3.

Ini-file ..................................................................................................................... 16

3.2.4.

RTW....................................................................................................................... 16

3.2.5.

Foutenafhandeling ................................................................................................. 17

3.3.

Gebruikershandleiding .................................................................................................. 18

3.4.

Installatie ....................................................................................................................... 18

3.5.

Programmacode ........................................................................................................... 18

/LWHUDWXXUOLMVW /LMVWPHWILJXUHQ %LMODJH,

+DQGOHLGLQJ9HUKDUGLQJV'HWDLO*HQHUDWRU

%LMODJH,,

,QVWDOODWLHKDQGOHLGLQJ

%LMODJH,,,

3URJUDPPDFRGH


Blz. 3

2UJDQLVDWLH

5LMNVZDWHUVWDDWODQGHOLMN

Rijkswaterstaat telt ruim 10.000 medewerkers verspreid over grofweg 160 standplaatsen in ons land. De organisatie is opgebouwd uit tien regionale directies, zes specialistische diensten en een hoofdkantoor. De tien regionale directies vormen de ruggengraat van Rijkswaterstaat. Zij zijn verantwoordelijk voor het toezicht op de waterstaat, voorbereiding, uitvoering en beheer van projecten, onderhoud en verbetering van waterwerken en infrastructuur. Ook het overleg met betrekking tot de vervoers- en verkeersproblematiek vindt in de regio plaats. Zes specialistische diensten verzorgen de technische en wetenschappelijke kennis en ondersteuning voor de beleidsvoorbereiding voor de uitvoering van de RWS-taken en de beleidsvoorbereiding van het ministerie van Verkeer en Waterstaat.

2UJDQRJUDP Organogram Directoraat-Generaal Rijkswaterstaat van het Ministerie van Verkeer en Waterstaat Minister Staatssecretaris

Secretaris-Generaal plv. Secretaris-Generaal

DG Rijkswaterstaat

10 Regionale Directies

6 Specialistische Diensten

Directie Noord-Nederland

Directie Noord-Brabant

Adviesdienst Verkeer en Vervoer

Meetkundige Dienst

Directie Oost-Nederland

Directie Noord-Holland

Bouwdienst Rijkswaterstaat

Rijksinstituut voor Kust en Zee

Directie Limburg

Directie Noordzee

Dienst Wegen Waterbouwkunde

Rijksinst. Integraal Zoetwaterbeheer....(RIZA)

Directie Utrecht

Directie IJsselmeergebied

Directie Zeeland

Directie Zuid-Holland

Figuur 1: Organogram Rijkswaterstaat landelijk


Blz. 4

5LMNVZDWHUVWDDW'LUHFWLH1RRUG%UDEDQW

.HUQWDNHQ Bij Rijkswaterstaat in Noord-Brabant dragen dagelijks 700 medewerkers direct of indirect bij aan de “kerntaken” van de organisatie: •

beheer en aanleg van rijkswegen en –wateren;

•

zorg voor veilig verkeer;

•

zorg voor voldoende en schoon water;

•

beschermen tegen overstromingen.

%HKHHUJHELHG Het beheergebied van Rijkswaterstaat directie Noord-Brabant komt overeen met de provincie Noord-Brabant. In totaal gaat het om 600 km wegen en 150 km vaarwegen. Op onderstaande kaart ziet u het beheergebied. Het blauwe gedeelte op de kaart is in beheer bij de Dienstkring Autosnelwegen Breda. Het roze gedeelte bij Dienstkring Autosnelwegen Den Bosch en het groene gedeelte bij Dienstkring Autosnelwegen Eindhoven.

Figuur 2: Beheergebied


Blz. 5

Het hoofdkantoor van de directie is gevestigd aan de Zuidwal te ’s-Hertogenbosch. De afdelingen wegontwerp (IVA) en grondaankoop (IVG) zijn gestationeerd in het gebouw aan de Schubertsingel te ’s-Hertogenbosch.

Figuur 3: Kantoor Schubertsingel te ’s-Hertogenbosch

2UJDQRJUDP

Figuur 4: Organogram Directie Noord-Brabant

2QWZHUSDIGHOLQJ,9$

IVA staat voor Infrastructuur Verkeer en vervoer afdeling Aanleg. Deze afdeling bestaat uit een tweetal onderafdelingen. IVAP is de onderafdeling waar projecten worden uitgevoerd op het ontwerpvlak. IVAS is de adviserende en ondersteunende afdeling. IVAS is ondergebracht bij de afdeling IVA, maar biedt advies en ondersteuning voor de gehele directie Noord-Brabant.


Blz. 6

Binnen IVAS zijn twee soorten functies te vinden: adviseurs en beheerders. Adviseurs voor de onderwerpen kostenmanagement, planologie, milieutechniek, verkeerstechniek, automatisering wegontwerp en GIS. De beheerders zijn werkzaam op de vlakken gegevens, automatisering wegontwerp en automatisering CAD-systemen. Dit laatste is nu de functie die ik vervul binnen deze organisatie.

Mijn taken bestaan o.a. uit: •

het technisch en functioneel beheer van een aantal applicaties waaronder AutoCAD;

•

het beheren van de CAD-pc’s/werkstations en randapparatuur;

•

het verlenen van ondersteuning bij gebruik van de CAD-apparatuur en applicaties;

•

het ondersteunen van de adviseur automatisering wegontwerp.

$XWRPDWLVHULQJ

De automatisering van de directie Noord-Brabant is verdeeld over een tweetal afdelingen. De afdeling FXA houdt zich bezig met kantoorautomatisering, netwerk, intranet, e-mail en alles wat daar mee samen hangt. De afdeling waar ik voor werk (IVAS) houdt zich bezig met het automatiseren van het wegontwerp met alle bijkomende zaken.

$SSOLFDWLHV De applicaties waarmee binnen de directie wordt gewerkt in het kader van wegontwerp zijn: •

AutoCAD MAP 2000i

•

WOCAD

•

MX

Voor AutoCAD en WOCAD geldt dat binnen de directie Noord-Brabant een 50-tal licenties in gebruik zijn. Voor het wegontwerppakket MX zijn 22 licenties aanwezig. Licentiebeheer van AutoCAD MAP 2000i verloopt via een drietal redundantlicentieservers die licenties verdelen over een twaalftal locaties verspreid door de gehele directie Noord-Brabant. Voor eind 2003 stapt de organisatie over op versie MAP6 waarvoor een contract is afgesloten met AutoDesk zonder dat licentiebeheer daar nog een rol in speelt. Verspreiding van de AutoCAD-installatie gebeurt via image-beheer. FXA en IVAS maken samen een image met nieuwe software of updates, testen dit en vervolgens wordt dit image verspreid over de diverse afdelingen.


Blz. 7

2SGUDFKW

$DQOHLGLQJ

Als onderwerp voor de afstudeeropdracht in het kader van de HBO-deeltijdopleiding AutoCAD system engineer (ACE) heb ik gezocht naar een oplossing voor het vereenvoudigen van één van de vele taken van de tekenaar van de wegontwerpafdeling.

Één van die voorkomende taken is het tekenen van details van de verhardingsconstructie. Een verhardingsconstructie van een weg is opgebouwd uit diverse lagen van diverse materialen, waarvan de soort en dikte en de combinatie van soorten kan verschillen per regio, per project, per weg of zelfs per wegvak.

3UREOHHPVWHOOLQJ

Het tekenen van een dergelijk detail is een arbeidsintensieve taak. Alle voorkomende constructies worden elk in een detail getekend aan de hand van gegevens uit een verhardingsadvies. Het aantal details kan binnen een gemiddeld project gemakkelijk oplopen tot twintig. In de ontwerpfase van een weg komt het daarnaast nogal eens voor dat de eerder ontworpen constructies door allerlei omstandigheden wijzigen. Dit betekent dat ook de getekende details moeten worden aangepast. Ook dit gebeurt geheel ‘handmatig’.

0RJHOLMNHRSORVVLQJHQ

Het probleem kan opgelost worden door een programma te schrijven dat een verhardingsconstructiedetail tekent aan de hand van een aantal gegevens die de gebruiker in geeft. De details worden dan geautomatiseerd getekend. Tijdrovende aanpassingen zijn dan niet nodig. Bij wijzigingen worden de oude details verwijderd en vervangen door nieuwe geautomatiseerd getekende details.

Het schrijven van dergelijk programma kan in diverse programmeertalen. AutoCAD kan namelijk omgaan met VBA, lisp, VB, C++ en meer. Aangezien de opleiding gericht was op VBA en ik zelf géén kennis heb van de overige programmeertalen was er voor mij geen ander alternatief.

Tijdens het programmeren werd al snel duidelijk dat het programma uit twee delen zou moeten bestaan: •

het programma zelf (de VBA-code)

•

en een aantal gegevens die in het programma gebruikt worden op basis waarvan de gebruiker keuzes kan maken.


Blz. 8

Het voordeel om deze gegevens in een apart bestand op te slaan is dat bij veranderingen van de voorschriften voor het maken van verhardingsconstructies niet opnieuw het hele programma herschreven moet worden. Tevens zullen de wijzigingen gemakkelijker en sneller verlopen als de gegevens in een apart bestand staan. Aangezien het hier alleen gaat om het lezen van gegevens en niet het wegschrijven ervan zijn er een drietal mogelijkheden voor het opslaan van deze gegevens: •

de gegevens in een Excel-werkblad plaatsen.

•

de gegevens in het register plaatsen.

•

de gegevens in een ini-bestand plaatsen.

De koppeling met Excel is een niet zo voor de hand liggende omdat het inlezen van gegevens vanuit een Excel-werkblad niet erg snel werkt. Gegevens inlezen vanuit het register is wel een snelle oplossing. Dit heeft echter als nadeel dat de gegevens niet op het netwerk geplaatst kunnen worden. De koppeling met een ini-bestand is ook een snelle, met als voordeel dat je dit bestand op een plek op het netwerk zou kunnen plaatsen zodat een ieder met exact dezelfde gegevens werkt. En ook wijzigingen hierin kunnen snel en eenduidig verwerkt worden. Al deze voor- en nadelen beschouwd hebbende heb ik de keuze laten vallen op een koppeling met een ini-bestand.

2QGHU]RHN

9HUKDUGLQJVPDWHULDOHQ Om een juiste invulling te kunnen geven aan de tool op het gebied van materiaalsoorten en bijbehorende laagdikten heb ik informatie ingewonnen bij de twee materiaaldeskundigen die werkzaam zijn bij Rijkswaterstaat directie Noord-Brabant, Ad v.d. Berk en Ron v.d. Aa. In een aantal gesprekken is het gelukt om de juiste gegevens bij elkaar te sprokkelen. Twee publicaties die daarbij geraadpleegd zijn: •

Leidraad Bouwstoffen Rijkswaterstaat deel I

•

Handleiding Wegenbouw – Ontwerp Verhardingen, uitgave december 1998, Rijkswaterstaat Dienst Weg- en Waterbouwkunde

9HUKDUGLQJVGHWDLOV Om de tool een verhardingsdetail te laten tekenen dat voldoet aan de eisen van de richtlijnen, maar ook aan de wensen van de tekenaars en hun projectleiders, heb ik een aantal tekenaars en hun projectleiders geïnterviewd. Ook heb ik bestaande tekeningen met verhardingsdetails geraadpleegd. Student: Marcel Pennings

Blz. 9

Hieruit blijkt dat: -

elk project een eigen presentatiemethode hanteert voor het weergeven van verhardingsdetails op tekening;

-

het maximum aantal verhardingslagen zeven is;

-

de geinterviewden eigenlijk een uniforme werkwijze willen in het kader van de Richtlijnen Tekeningenverkeer Waterstaat (RTW).

Als uitgangscriteria voor de tool heb ik daarom gekozen voor: -

de Richtlijnen Tekeningverkeer Waterstaat (RTW);

-

aangevuld met de wensen van de tekenaars.

Naar verwachting wordt RTW eind van het jaar 2003 geïmplementeerd in de directie. Samen met deze implementatie zou de door mij ontwikkelde tool ingevoerd kunnen worden ten behoeve van het efficiënt, effectief en eenduidig tekenen van verhardingsdetails bij Rijkswaterstaat Directie Noord-Brabant.


Blz. 10

3URJUDPPD

6WURRPVFKHPD

aanroepen tool in menu openen userform1, muisklik, sluiten userform1, openen userform2

selecteren aantal lagen

zichtbaar maken tekstboxen

materiaalkeuze maken

materiaalkeuze

Materiaalsoort Minimum laagdikte Maximum laagdikte Standaard laagdikte Laagnaam verharding Laagnaam arcering Naam arcering Arceringschaal Arceringrotatie Laagnaam tekst Verkeersklasse ja/nee

zichtbaar ja of nee

verkeersklasse

aanvullende info

waarde invullen

waarde invullen

minimum

standaard dikte

maximum

waarde invullen

LQLILOH

genereren verhardingsdetail userform2 wordt gesloten

kies insertion-punt

kies voor RTW-schaal 1:10

RTW-commando “RTW_schaal” wordt aangeroepen voor het juist instellen van de dimensionstyle

detail wordt getekend

lagen herstellen

RTW-commando “RTW_lay_sys” wordt aangeroepen voor het juist toekennen van kleur, linetype en lineweight aan de RTW-lagen.

Figuur 5: Stroomschema

:HUNLQJ

Het programma wordt aangeroepen in een pulldownmenu genaamd iva-menu. Dit is een verzamelmenu voor diverse tools die binnen Rijkswaterstaat Noord-Brabant worden gebruikt. Hierin is de optie VerhardingsDetail Generator opgenomen. Na het aanroepen van de tool verschijnt een opstartschermpje. Door hierop te klikken verschijnt userform2. Dit is het enige userform binnen de tool. In deze dialoogbox wordt alles geregeld om een verhardingsdetail te kunnen tekenen.


Blz. 11

'LDORRJER[

Als eerste dient men het aantal verhardingslagen (maximaal zeven) op te geven. Het is alleen mogelijk om opeenvolgende lagen aan te vinken. Hierdoor wordt voorkomen dat bijvoorbeeld laag 5 ontbreekt tussen laag 6 en laag 4. Na het aanvinken van een bepaalde laag kunnen de Figuur 6: Dialoogbox (laagnr)

bovenliggende lagen niet worden uitgevinkt.

Per aangevinkte laag verschijnt in het vak materiaalsoort 2 of 3 nieuwe textboxen. Eerste box is de materiaalkeuze. Hier kies je het toe te

Figuur 7: Dialoogbox (materiaalsoort)

passen verhardingsmateriaal. Het betreft hier een combobox. Vanuit een ini-file worden hier de diverse materialen ingelezen. Afhankelijk van het gekozen materiaal verschijnt er onder het kopje VK een textbox. Deze is bedoeld voor het aangeven van de verkeersklasse van een bepaald materiaal. Dit is van toepassing op een aantal asfaltsoorten. De derde box is een textbox waarin aanvullende informatie kan worden gemeld die in het te tekenen detail wordt geplaatst. Student: Marcel Pennings

Blz. 12

Het derde vak van de middensectie is het vak laagdikte. Hierin zijn een drietal kolommen opgenomen: Minimum dikte, te tekenen dikte met daarin getoond de aanbevolen dikte en de maximum dikte. De textboxen minimum en maximum

Figuur 8: Dialoogbox (laagdikte)

worden ingevuld vanuit het ini-file afhankelijk van de gekozen materiaalsoort. Om van de aanbevolen dikte af te wijken is niet meer nodig dan de waarde in dit veld handmatig te wijzigen.

Figuur 9: Dialoogbox (oppervlaktebehandeling)

Op bepaalde verhardingsconstructies

Door bovengetoonde checkbox aan te

wordt bovenop nog een extra oppervlakte-

vinken plaatst de tool de tekst “Detail

behandeling toegepast. Deze wordt aange-

verhardingsconstructie schaal 1:10” onder

geven door een horizontale onderbroken

het detail.

streep boven de getekende constructie. Door deze checkbox aan te vinken wordt deze lijn in het detail getekend.


Blz. 13

Figuur 10: Dialoogbox (trapbreedte per laag)

In de derde sectie kan er een keuze gemaakt worden tussen de theoretische of de praktische methode om een verhardingsdetail te tekenen. De verhardingslaag die onder een andere laag ligt heeft volgens de vigerende richtlijnen de breedte van de bovenliggende laag met daarbij aan weerskanten opgeteld de dikte van de laag. Voorbeeld: de toplaag is 4 cm dik en 12,00 m breed. De direct daaronder liggende laag is 6 cm dik. Dit betekent dat de breedte van deze laag 12,12 m moet zijn.

Figuur 11: Voorbeeld trapbreedte

In de praktijk wordt vaak een trapbreedte van 10 cm gehanteerd en wordt deze methode ook steeds vaker gebruikt op de tekeningen. Vandaar dat deze keuzemogelijkheid is gecreëerd in deze tool.

Figuur 12: Dialoogbox (commandbuttons)

Rechtsonder in de dialoogbox staan een tweetal commandbuttons. De eerste , met vermelding van de term “Cancel”, beëindigt de tool zonder het verhardingsdetail te tekenen. De tweede button met de tekst “Genereer” zorgt ervoor dat de ingevoerde gegevens worden omgezet tot het uiteindelijke eindresultaat. Student: Marcel Pennings

Blz. 14

5HVXOWDDW Na het invoeren van alle benodigde gegevens en het aanklikken van de genereerknop wordt door het programma het uiteindelijke resultaat gecreëerd, een verhardingsconstructiedetail. Per verhardingslaag wordt een polylijn getekend. Dit vlak wordt voorzien van een arcering zoals is aangegeven in het vdg.ini bestand. Tevens worden bemating en teksten geplaatst. Al deze objecten worden in de juiste AutoCAD-lagen geplaatst. Het detail wordt 1:1 getekend. De bematingen en teksten worden in een dusdanige grootte geplaatst dat bij een weergave in de schaal 1:10 deze objecten de juiste grootte hebben. Verhardingsdetails worden binnen onze organisatie altijd in de schaal 1:10 op tekeningen gebruikt.

Figuur 13: Eindresultaat verhardingsdetail


Blz. 15

,QLILOH Op diverse plaatsen binnen het programma worden gegevens ingelezen vanuit het bijbehorende ini-file. Dit bestand, genaamd vdg.ini, bestaat uit twee delen. Het eerste deel is een opsomming van alle binnen Rijkswaterstaat toegepaste verhardingsmaterialen. Vanuit dit deel wordt de combobox gevuld in de dialoogbox waar de materiaalkeuze wordt gemaakt. Het tweede deel van het bestand bestaat per materiaalsoort uit een groepje gegevens. In onderstaand figuur is een degelijk groepje weergegeven inclusief de verklarende tekst. ; opbouw per laag: ; [naam materiaal] ; naam = naam materiaal ; min = minimum laagdikte volgens handleiding wegenbouw - ontwerp verhardingen van DWW ; max = maximum laagdikte ; standaard = aanbevolen laagdikte ; tekenlaag = laag waarop verharding getekend wordt (volgens RTW 2.1) ; aceringslaag = laag waarop de arcering wordt geplaatst (volgens RTW 2.1) ; arceringsnaam = naam van de arcering die bij materiaal hoort (volgens RTW 2.1) ; arceringsschaal = verschaling van arcering zodat deze voldoet aan RTW 2.1 ; arceringsrotatie = rotatie van arcering zodat deze voldoet aan RTW 2.1 ; tekstlaag = laag waarop de tekst wordt geplaatst (volgens RTW 2.1) ; vk = ja of nee geeft aan of veld VK (Verkeersklasse) wel of niet zichtbaar is in dialoogbox bij betreffende materiaal [GAB 0/16 type 1] naam = GAB 0/16 type 1 min = 25 max = 60 standaard = 40 tekenlaag = dp-nw-verharding arceringslaag = dp-nw-arcering_10 arceringsnaam = vd-gab arceringsschaal = 10 arceringsrotatie = 2,356 tekstlaag = dp-nw-t25_10 vk = ja

Figuur 14: Fragment vdg.ini

57: In de ontwikkelde tool worden alle objecten getekend volgens de Richtlijnen Tekeningenverkeer Waterstaat (RTW). RTW is opgesteld om eenduidig en uniform tekeningen op het gebied van wegontwerp te kunnen maken. Deze richtlijnen gaan vergezeld van een toolbox die het hanteren van de regels voor de tekenaar eenvoudiger maakt. Deze toolbox is door derden ontwikkeld en was tijdens het schrijven van mijn programma nog niet geheel gereed. Hierdoor liep ik tegen het Student: Marcel Pennings

Blz. 16

probleem aan dat ik voor een aantal zaken afhankelijk was van de tools van een ander, die helaas niet in VBA zijn geschreven. Dit resulteert in het aanroepen van een tweetal tools waar van mij niet de exacte werking bekend is, maar wel welk eindresultaat zij geven. De RTW is ook de basis geweest voor de opbouw van het verhardingsdetail. Voor vele objecten die worden toegepast schrijft de richtlijn namelijk het volgende voor: •

welke AutoCAD-laag gebruikt moet worden (met bijbehorende kleur, laagdikte en lijn type),

•

welk type arcering moet worden gebruikt (met bijbehorende schaal en rotatiehoek),

•

hoe moet de bemating zijn opgebouwd (grootte, type en locatie van tekst en lijnen)

)RXWHQDIKDQGHOLQJ Foutmeldingen die leiden tot vastlopen of geheel afbreken van de tool zou in een goed programma niet mogen voorkomen. Ik heb getracht zoveel als mogelijk deze foutmeldingen te voorkomen. Bij het invullen van de vrije tekstvelden in de dialoogbox zit echter een probleem: -

de dikte van de verhardingslaag wordt door de gebruiker handmatig ingetikt in een textbox.;

-

tegelijkertijd wordt hier ook de aanbevolen dikte door het programma aangegeven .

Om te voorkomen dat de gebruiker met behulp van het programma foutieve laagdikten genereert in verhardingsdetails, is de volgende controle ingebouwd. Na het invullen van de laagdikte en het aanklikken van de “genereer”-button wordt eerst op een viertal feiten gecontroleerd alvorens het programma gaat berekenen en tekenen. 9HOGOHHJ"

ja

nee

melding en aangeven welke waarde fout

*HWDO"

ja

nee


LQGLHQPLQHQPD[RQJHOLMNDDQQYW

Z DDUGHPLQRI!PD[

ja

nee


ZDDUGH

ja

nee


WHNHQHQGHWDLO

EHUHNHQHQHQ

Figuur 15: Schema foutafhandeling laagdikte


Blz. 17

*HEUXLNHUVKDQGOHLGLQJ

Om de integratie van de VerhardingsDetail Generator binnen de organisatie zo soepel mogelijk te laten verlopen heb ik een gebruikershandleiding opgesteld. Deze handleiding is terug te vinden als bijlage I.

,QVWDOODWLH

De VerhardingsDetail Generator is afhankelijk van het aanwezig zijn van een geïnstalleerde RTW-toolbox. Verder moet er nog een extra menu worden geladen genaamd “iva-menu”. Dit is een menu waarin een aantal veel gebruikte tools binnen de organisatie zijn opgenomen. Vanuit dit menu wordt ook de VerhardingsDetail Generator opgestart. De installatie van dit alles is beschreven en terug te vinden in de installatiehandleiding (bijlage II).

3URJUDPPDFRGH

De programmacode is opgedeeld in een tweetal bestanden: -

HBO_traject.dvb

-

Algemeen_iva.dvb

In het HBO_traject.dvb is de code van de daadwerkelijk applicatie opgenomen. Binnen deze code wordt voor routinematige zaken verwezen naar diverse routines in een tweetal modules in het bestand algemeen-iva.dvb. Het betreft hier een aantal routines die daadwerkelijk een object aanmaken in een tekening, zoals het tekenen van een lijn, cirkel etc., of het plaatsen van een tekst of bemating. Verder is er een wat uitgebreider routine opgenomen die de koppeling verzorgt tussen VBA en de ini-file (zie 3.2.3). Een complete uitdraai van al deze code is te vinden als bijlage III.


Blz. 18

/LWHUDWXXUOLMVW Algemene informatie organisatie Rijkswaterstaat Intranetsite Rijkswaterstaat Directie Noord-Brabant K.F. Duzijn, B.C. Neeleman, J. Labordus, Leidraad Bouwstoffen Rijkswaterstaat, Praktische informatie over bouwstoffen en materiaalkeuze voor wegen- en natte waterbouw, P-DWW-99-055, Dienst Weg- en Waterbouwkunde Handleiding Wegenbouw – Ontwerp Verhardingen Rijkswaterstaat, Dienst Weg- en Waterbouwkunde Uitgave december 1998


Blz. 19

/LMVWPHWILJXUHQ Figuur 1: Organogram Rijkswaterstaat landelijk ........................................................................... 4 Figuur 2: Beheergebied................................................................................................................. 5 Figuur 3: Kantoor Schubertsingel te ’s-Hertogenbosch ................................................................ 6 Figuur 4: Organogram Directie Noord-Brabant ............................................................................. 6 Figuur 5: Stroomschema ............................................................................................................. 11 Figuur 6: Dialoogbox (laagnr.) ………………………………………………………………………...12 Figuur 7: Dialoogbox (materiaalsoort) ………………………………………………………………..12 Figuur 8: Dialoogbox (laagdikte) ……………………………………………………………………...13 Figuur 9: Dialoogbox (oppervlaktebehandeling) …………………………………………………….13 Figuur 10: Dialoogbox (trapbreedte per laag) …………………………………………… …………14 Figuur 11: Voorbeeld trapbreedte ............................................................................................... 14 Figuur 12: Dialoogbox (commandbuttons) .................................................................................. 14 Figuur 13: Eindresultaat verhardingsdetail.................................................................................. 15 Figuur 14: Fragment vdg.ini ........................................................................................................ 16 Figuur 15: Schema foutafhandeling laagdikte............................................................................. 17


Blz. 20

Bijlage I

Gebruikershandleiding VerhardingsDetail Generator 1.0 mei 2003

Inhoudsopgave .......................................................................... Inhoudsopgave.............................................................................................................................. 2 Figurenlijst ..................................................................................................................................... 2 1.

Inleiding .............................................................................................................................. 3

2.

Werkwijze ........................................................................................................................... 3 2.1.

Opstarten ........................................................................................................................ 3

2.2.

Invulscherm .................................................................................................................... 4

Figurenlijst .......................................................................... Figuur 1: menu .............................................................................................................................. 3 Figuur 2: openingsscherm............................................................................................................. 3 Figuur 3: gegevensscherm............................................................................................................ 4 Figuur 4: oppervlaktebehandeling................................................................................................. 4 Figuur 5: onderschrift .................................................................................................................... 4 Figuur 6: materiaalkeuze............................................................................................................... 5 Figuur 7: aanvullende informatie................................................................................................... 5 Figuur 8: laagdikte......................................................................................................................... 6 Figuur 9: trapbreedte per laag ...................................................................................................... 6 Figuur 10: voorbeeld theoretische oplossing trapbreedte............................................................. 6 Figuur 11: voorbeeld praktische oplossing ................................................................................... 7

Handleiding verhardingsdetail generator 1.0

pag. 2

1. Inleiding ..........................................................................

De VerhardingsDetail Generator is een AutoCAD-tool waarmee op eenvoudige wijze details getekend kunnen worden van een verhardingsconstructie. De tool is geschreven door Marcel Pennings van de afdeling IVAS-automatisering, met medewerking van David Siahaya, Ron v.d. Aa, Ad van de Berk en Ronald Boeklagen. De tool is in eerste instantie geschreven in het kader van de HBO-deeltijdopleiding AutoCAD systemengineer.

2. Werkwijze .......................................................................... 2.1. Opstarten De tool is ondergebracht in het iva-menu dat als pulldown-menu te vinden is in de menuregel in het AutoCAD-scherm.

Figuur 1: menu

Na het klikken op verhardingsdetail generator verschijnt het volgende openingsscherm:

Figuur 2: openingsscherm

2.2. Invulscherm Vervolgens klik je op dit scherm en kom je in het gegevensscherm van de tool. Dit ziet er als volgt uit:

Figuur 3: gegevensscherm

In dit scherm moeten allerlei gegevens worden ingevoerd die uiteindelijk leiden tot het tekenen van het juiste detail. Het eerste veld dat we linksboven tegenkomen is het veld oppervlaktebehandeling. Hier kun je d.m.v. het aanvinken van het keuzevakje aangeven dat er op de verhardingsconstructie een oppervlaktebehandeling wordt toegepast.

Figuur 4: oppervlaktebehandeling

Dit houdt in dat schematisch d.m.v. een onderbroken lijn wordt aangegeven dat er een oppervlaktebehandeling bovenop de constructie wordt toegepast. Het volgende veld (rechtsboven) is het veld plaatsen onderschrift.

Figuur 5: onderschrift


pag. 4

Als het keuzevakje wordt aangevinkt wordt er onder het detail de volgende tekst toegevoegd: DETAIL VERHARDINGSCONSTRUCTIE SCHAAL 1:10

Het derde veld is het veld laagnummer. Hierin geef je aan d.m.v. een vinkje te plaatsen in het keuzevakje uit hoeveel lagen de constructie is opgebouwd. De volgende laag wordt pas beschikbaar als de daarboven liggende laag geselecteerd is. Aangezien een verhardingsconstructie uit minimaal één laag moet bestaan is het onmogelijk laag 1 uit te zetten. De tool laat maximaal 7 lagen toe. De volgorde van de lagen is tevens de volgorde van de lagen in de verhardingsconstructie van bovenaf gezien. Het veld laagnummer is gekoppeld met de vakken materiaalsoort en laagdikte. Op het moment dat een laagnummer aangevinkt wordt, verschijnt in het vak materiaalsoort een drietal velden, nl materiaalkeuze, VK en aanvullende info. Bij materiaalkeuze kan het type verharding worden gekozen.

Figuur 6: materiaalkeuze

In de keuzelijst vind je alle voorkomende soorten asfalt en fundering die binnen de Rijkswaterstaat directie Noord-Brabant worden gebruikt. Mocht hier een asfalttype gekozen worden waarbij de keuze van een verkeersklasse (VK) noodzakelijk is dan verschijnt vanzelf het invulveld VK.

Figuur 7: aanvullende informatie

Een ander veld dat bij elke materiaalsoort aanwezig is, is het veld aanvullende info. Hier kun je elke willekeurige opmerking plaatsen, die vervolgens in het detail achter de materiaalsoort getoond zal worden. Als de materiaalsoort gekozen is zullen, afhankelijk van de keuze, waarden verschijnen in het veld laagdikte.


pag. 5

Figuur 8: laagdikte

De minimum- en maximumwaarde worden door de tool ingevuld (indien deze waarden worden voorgeschreven in een normblad o.i.d.). Het middelste vakje geeft de aanbevolen laagdikte aan. Deze kun je zelf wijzigen.

Als alle lagen dan zijn gekozen en volledig zijn ingevuld volgt onderaan het veld trapbreedte per laag. Hier kun je door één van de vakje aan te vinken een keuze maken uit 2 manieren waarop een dergelijk detail kan worden getekend.

Figuur 9: trapbreedte per laag

De theoretische oplossing houdt in dat de trapbreedte van een laag gelijk is aan de laagdikte. Door voor de praktische oplossing te kiezen geef je aan dat de trapbreedte van elke laag 10 centimeter breed word gemaakt. Om het verschil nog eens duidelijk te maken vind je hieronder voorbeelden van de twee oplossingen.

Figuur 10: voorbeeld theoretische oplossing trapbreedte


pag. 6

Figuur 11: voorbeeld praktische oplossing


pag. 7

Bijlage II

Installatie handleiding VerhardingsDetail Generator 1.0 mei 2003

Inhoudsopgave .......................................................................... Inhoudsopgave.............................................................................................................................. 2 1.

Inleiding .............................................................................................................................. 3

2.

Installatie ............................................................................................................................ 3 2.1.

AutoCAD ......................................................................................................................... 3

2.2.

RTW................................................................................................................................ 3

2.3.

VerhardingsDetail Generator.......................................................................................... 3


pag. 2

1. Inleiding ..........................................................................

De VerhardingsDetail Generator is een AutoCAD-tool waarmee op eenvoudige wijze details getekend kunnen worden van een verhardingsconstructie. De tool is geschreven door Marcel Pennings van de afdeling IVAS-automatisering, met medewerking van David Siahaya, Ron v.d. Aa, Ad van de Berk en Ronald Boeklagen. De tool is in eerste instantie geschreven in het kader van de HBO-deeltijdopleiding AutoCAD systemengineer.

2. Installatie .......................................................................... 2.1. AutoCAD De tool is geschreven om te werken in combinatie met AutoCAD 2002. In deze handleiding wordt uitgegaan van een standaardinstallatie van AutoCAD in de directory C:\Program Files\ AutoCAD 2002.

2.2. RTW • Kopieer vanaf de CD de map “RTWtools21” naar C:\Program Files\”. • Start AutoCAD en kies in de pulldownmenus voor “Tools” en daarna “Options..”. • Klik op het tabblad “Files”. • Ga naar “Support File Search Path” en voeg de volgende paden toe: o

C:\Program Files\RTWtools21

o

C:\Program Files\RTWtools21\Buttons_blue

o

C:\Program Files\RTWtools21\Data-files

o

C:\Program Files\RTWtools21\Support

o

C:\Program Files\RTWtools21\Symbol

• Accepteer deze wijziging met “Apply”. • Ga naar het tabblad “Profiles” en druk op “Set Current”. • Typ op de command-line “(load “RTW.lsp”)” gevolgd door “Enter”. 2.3. VerhardingsDetail Generator • Kopieer de mappen “VDG-dvb” en “iva-tools” naar “C:\Program Files\”. • Start AutoCAD en kies in de pulldownmenus voor “Tools” en daarna “Options..”. • Klik op het tabblad “Files”.


pag. 3

• Ga naar “Support File Search Path” en voeg de volgende paden toe: o

C:\Program Files\VDG-dvb

o

C:\Program Files\iva-tools

• Klik op “OK”. • Kies in de pulldownmenus voor “Tools” en daarna “Customize” en “menus..”. • Klik op “Browse..”. • Selecteer het bestand “c:\Program Files\iva-tools\iva-menu.mnu”. • Klik op “Open”. • Daarna op “Load” en vervolgens “Ja”. • Kies nu het tabblad “menu bar” , selecteer de menugroup “iva-menu”. • Selecteer vervolgens onder Menu Bar de keuze “RTWmenu”. • Klik dan op “Insert>>” en daarna op “Close”. • Het iva-menu is nu compleet geladen en zichtbaar in de menubalk. • Kies in de pulldownmenus voor “Tools” en daarna “Load application..”. • Klik bij het onderdeel “Startup Suite” op de knop “Contents”.

• Vervolgens kies je voor “Add..” • Selecteer nu het bestand “C:\Program Files\VDG-dvb\HBO_project.dvb”. • Klik vervolgens op “Add”, en twee maal op “Close”. De Verhardingsdetail Generator is nu gereed voor gebruik. De tool wordt aangeroepen in het pulldownmenu “iva-menu”.


pag. 4

Bijlage III

Programmacode voor VerhardingsDetail Generator v 1.0 Programmacode HBO_traject.dvb.Userform2 Dim bloknaam(0 To 25) As String Private Sub CheckBox10_Click() If Me.CheckBox10.Value = True Then Me.CheckBox11.Value = False Else Me.CheckBox11.Value = True End If End Sub Private Sub CheckBox11_Click() If Me.CheckBox11.Value = True Then Me.CheckBox10.Value = False Else Me.CheckBox10.Value = True End If End Sub Private Sub CommandButton1_Click() Dim d1 As Long Dim d2 As Long Dim d3 As Long Dim d4 As Long Dim d5 As Long Dim d6 As Long Dim d7 As Long 'melding = foutmelding bij niet voldoen aan min of max Dim melding As String 'melding2 = foutmelding indien invoer géén getal is Dim melding2 As String 'melding3 = foutmelding als ingevoerde waarde 0 is Dim melding3 As String 'melding4 = foutmelding als invoerveld leeg is Dim melding4 As String 'in geval van eerdere foutmelding achtergrondkleur terugbrengen naar beginsituatie Me.TextBox1.BackColor = vbWhite Me.TextBox2.BackColor = vbWhite Me.TextBox3.BackColor = vbWhite Me.TextBox4.BackColor = vbWhite Me.TextBox5.BackColor = vbWhite Me.TextBox6.BackColor = vbWhite Me.TextBox7.BackColor = vbWhite 'foutafhandeling: controleren van diktes, waarde ingevuld? voldoet aan min en max? If Me.TextBox1.Visible = True Then If Me.TextBox1.Value <> "" Then On Error Resume Next d1 = Me.TextBox1.Value If Err Then Err.Clear melding2 = melding2 & " 1," Me.TextBox1.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox8.Value <> "nvt" Or Me.TextBox15.Value <> "nvt" Then If d1 < Me.TextBox8.Value Or d1 > Me.TextBox15.Value Then melding = melding & " 1," Me.TextBox1.BackColor = vbYel low End If Else If d1 <= 0 Then melding3 = melding3 & " 1," Me.TextBox1.BackColor = vbYellow End If End If Else melding4 = melding4 & " 1," Me.TextBox1.BackColor = vbYellow End If End If If Me.TextBox2.Visible = True Then If Me.TextBox2.Value <> "" Then On Error Resume Next d2 = Me.TextBox2.Value If Err Then Err.Clear melding2 = melding2 & " 2," Me.TextBox2.BackColor = vbYellow

Bijlage III

Pag.1

End If On Error GoTo 0 If Me.TextBox9.Value <> "nvt" Or Me.TextBox16.Value <> "nvt" Then If d2 < Me.TextBox9.Value Or d2 > Me.TextBox16.Value Then melding = melding & " 2," Me.TextBox2.BackColor = vbYellow End If Else If d2 <= 0 Then melding3 = melding3 & " 2," Me.TextBox2.BackColor = vbYellow End If End If Else melding4 = melding4 & " 2," Me.TextBox2.BackColor = vbYellow End If End If If Me.TextBox3.Visible = True Then If Me.TextBox3.Value <> "" Then On Error Resume Next d3 = Me.TextBox3.Value If Err Then Err.Clear melding2 = melding2 & " 3," Me.TextBox3.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox10.Value <> "nvt" Or Me.TextBox17.Value <> "nvt" Then If d3 < Me.TextBox10.Value Or d3 > Me.TextBox17.Value Then melding = melding & " 3," Me.TextBox3.BackColor = vbYellow End If Else If d3 <= 0 Then melding3 = melding3 & " 3," Me.TextBox3.BackColor = vbYellow End If End If Else melding4 = melding4 & " 3," Me.TextBox3.BackColor = vbYellow End If End If If Me.TextBox4.Visible = True Then If Me.TextBox4.Value <> "" Then On Error Resume Next d4 = Me.TextBox4.Value If Err Then Err.Clear melding2 = melding2 & " 4," Me.TextBox4.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox11.Value <> "nvt" Or Me.TextBox18.Value <> "nvt" Then If d4 < Me.TextBox11.Value Or d4 > Me.TextBox18.Value Then melding = melding & " 4," Me.TextBox4.BackColor = vbYellow End If Else If d4 <= 0 Then melding3 = melding3 & " 4," Me.TextBox4.BackColor = vbYellow End If End If Else melding4 = melding4 & " 4," Me.TextBox4.BackColor = vbYellow End If End If If Me.TextBox5.Visible = True Then If Me.TextBox5.Value <> "" Then On Error Resume Next d5 = Me.TextBox5.Value If Err Then Err.Clear melding2 = melding2 & " 5," Me.TextBox5.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox12.Value <> "nvt" Or Me.TextBox19.Value <> "nvt" Then If d5 < Me.TextBox12.Value Or d5 > Me.TextBox19.Value Then

Bijlage III

Pag.2

melding = melding & " 5," Me.TextBox5.BackColor = vbYellow End If Else If d5 <= 0 Then melding3 = melding3 & " 5," Me.TextBox5.BackColor = vbYellow End If End If Else melding4 = melding4 & " 5," Me.TextBox5.BackColor = vbYellow End If End If If Me.TextBox6.Visible = True Then If Me.TextBox6.Value <> "" Then On Error Resume Next d6 = Me.TextBox6.Value If Err Then Err.Clear melding2 = melding2 & " 6," Me.TextBox6.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox13.Value <> "nvt" Or Me.TextBox20.Value <> "nvt" Then If d6 < Me.TextBox13.Value Or d6 > Me.TextBox20.Value Then melding = melding & " 6," Me.TextBox6.BackColor = vbYellow End If Else If d6 <= 0 Then melding3 = melding3 & " 6," Me.TextBox6.BackColor = vbYellow End If End If Else melding4 = melding4 & " 6," Me.TextBox6.BackColor = vbYellow End If End If If Me.TextBox7.Visible = True Then If Me.TextBox7.Value <> "" Then On Error Resume Next d7 = Me.TextBox7.Value If Err Then Err.Clear melding2 = melding2 & " 7," Me.TextBox7.BackColor = vbYellow End If On Error GoTo 0 If Me.TextBox14.Value <> "nvt" Or Me.TextBox21.Value <> "nvt" Then If d7 < Me.TextBox14.Value Or d7 > Me.TextBox21.Value Then melding = melding & " 7," Me.TextBox7.BackColor = vbYellow End If Else If d7 <= 0 Then melding3 = melding3 & " 7," Me.TextBox7.BackColor = vbYellow End If End If Else melding4 = melding4 & " 7," Me.TextBox7.BackColor = vbYellow End If End If If melding2 <> "" Then MsgBox ("ingegeven waarde in de kolom laagdikte is geen getal bij de volgende la(a)g(en):" & vbCr & "laag " & melding2) Exit Sub End If If melding <> "" Then MsgBox ("dikte(s) van de volgende la(a)g(en) voldoen niet aan het aangegeven minimum of maximum:" & vbCr & "laag " & melding) Exit Sub End If If melding3 <> "" Then MsgBox ("waarde in kolom laagdikte moet groter zijn dan 0 in één van de volgende la(a)g(en): " & vbCr & "laag " & melding3) Exit Sub End If If melding4 <> "" Then

Bijlage III

Pag.3

MsgBox ("géén waarde ingevoerd bij de dikte van één van de volgende la(a)g(en): " & vbCr & "laag " & melding4) Exit Sub End If 'tekenen van het detail Me.Hide Dim x10 As Double: Dim y10 As Double Dim x20 As Double: Dim y20 As Double Dim x30 As Double: Dim y30 As Double Dim x40 As Double: Dim y40 As Double Dim x50 As Double: Dim y50 As Double Dim x60 As Double: Dim y60 As Double Dim x70 As Double: Dim y70 As Double Dim aktief As AcadLayer 'omrekenen diktes van mm naar meters If Me.CheckBox10.Value = True Then x10 = d1 / 1000 x20 = d2 / 1000 x30 = d3 / 1000 x40 = d4 / 1000 x50 = d5 / 1000 x60 = d6 / 1000 x70 = d7 / 1000 Else x10 = 100 / 1000 x20 = 100 / 1000 x30 = 100 / 1000 x40 = 100 / 1000 x50 = 100 / 1000 x60 = 100 / 1000 x70 = 100 / 1000 End If y10 = d1 / 1000 y20 = d2 / 1000 y30 = d3 / 1000 y40 = d4 / 1000 y50 = d5 / 1000 y60 = d6 / 1000 y70 = d7 / 1000 'uitlezen aktieve laag Set aktief = ThisDrawing.ActiveLayer 'modelspace aktief maken If ThisDrawing.ActiveSpace = acPaperSpace Then ThisDrawing.ActiveSpace = acModelSpace End If 'tekststijl opvragen in ini-bestand en aktief maken OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", "tekststijl", "tekststijl", "S", 0, tekststijl) Set TS = ThisDrawing.TextStyles.Add(tekststijl) ThisDrawing.ActiveTextStyle = TS ThisDrawing.ActiveTextStyle.fontFile = "C:/app s/RTWtools21/data-files/Iso-rtw.shx" 'opvragen insertionpunt punt = algemeen.ThisDrawing.Utility.GetPoint(, "geef punt : ") x = punt(0) y = punt(1) '-----------------------------------------------------------------------------------------'tekenen laag 1 als lwpolyline OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT Dim ln(0 To 9) As Double ln(0) = x: ln(1) = y ln(2) = x - 0.4: ln(3) = y ln(4) = x - 0.4: ln(5) = y - y10 ln(6) = x: ln(7) = y - y10 ln(8) = x: ln(9) = y Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering Dim HT As AcadHatch Dim outerLoop(0 To 0) As AcadEntity OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "arceri ngsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop)

Bijlage III

Pag.4

OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 1 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox29.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox1.Value & " " & "vk " & Me.TextBox29.Value & " " & Me.TextBox22.Value, x + 0.05, y - 0.5 * y10, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox1.Value & " " & Me.TextBox22.Value, x + 0.05, y - 0.5 * y10, 0.025) End If 'plaatsen maatvoering laag 1 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles.Item("RTW -LGO-10") If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y y10, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y, x - 0.5 - x10 - x20 - x30 - x40 x50 - x60 - x70, y - y10 / 2) '-----------------------------------------------------------------------------------------'tekenen laag 2 indien aktief If Me.CheckBox2.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 ln(2) = x - 0.4 - x20: ln(3) = y - y10 ln(4) = x - 0.4 - x20: ln(5) = y - y10 - y20 ln(6) = x: ln(7) = y - y10 - y20 ln(8) = x: ln(9) = y - y10 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "arceringsnaam" , "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 2 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox30.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox2.Value & " " & "vk " & Me.TextBox30.Value & " " & Me.TextBox23.Value, x + 0.05, y - y10 - 0.5 * y20, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.Co mboBox2.Value & " " & Me.TextBox23.Value, x + 0.05, y - y10 - 0.5 * y20, 0.025) End If 'plaatsen maatvoering laag 2 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles.Item("RTW -LGO-10")

Bijlage III

Pag.5

If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10, x - 0.5 - x10 - x20 x30 - x40 - x50 - x60 - x70, y - y10 - y20 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4, y, x - 0.4 - x20, y, x - 0.4 - x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen laag 3 indien aktief If Me.CheckBox3.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 - y20 ln(2) = x - 0.4 - x20 - x30: ln(3) = y - y10 - y20 ln(4) = x - 0.4 - x20 - x30: ln(5) = y - y10 - y20 - y30 ln(6) = x: ln(7) = y - y10 - y20 - y30 ln(8) = x: ln(9) = y - y10 - y20 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "arceringsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 3 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox31.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox3.Value & " " & "vk " & Me.TextBox31.Value & " " & Me.TextBox24.Value, x + 0.05, y - y10 - y20 - 0.5 * y30, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox3.Value & " " & Me.TextBox24.Value, x + 0.05, y - y10 - y20 - 0.5 * y30, 0.025) End If 'plaatsen maatvoering laag 3 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles.Item("RTW -LGO-10") If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20, x - 0.5 x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x20, y, x - 0.4 - x20 - x30, y, x - 0.4 x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen laag 4 indien aktief If Me.CheckBox4.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 - y20 - y30 ln(2) = x - 0.4 - x20 - x30 - x40: ln(3) = y - y10 - y20 - y30 ln(4) = x - 0.4 - x20 - x30 - x40: ln(5) = y - y10 - y20 - y30 - y40 ln(6) = x: ln(7) = y - y10 - y20 - y30 - y40

Bijlage III

Pag.6

ln(8) = x: ln(9) = y - y10 - y20 - y30 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "arceringslaa g", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "arceringsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 4 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox32.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox4.Value & " " & "vk " & Me.TextBox32.Value & " " & Me.TextBox25.Value, x + 0.05, y - y10 - y20 - y30 - 0.5 * y40, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox4.Value & " " & Me.TextBox25.Value, x + 0.05, y - y10 - y20 - y30 - 0.5 * y40, 0.025) End If 'plaatsen maatvoering laag 4 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles. Item("RTW-LGO-10") If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 y30, x - 0.5 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x20 - x30, y, x - 0.4 - x20 - x30 - x40, y, x - 0.4 - x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen laag 5 indien aktief If Me.CheckBox5.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 - y20 - y30 - y40 ln(2) = x - 0.4 - x20 - x30 - x40 - x50: ln(3) = y - y10 - y20 - y30 - y40 ln(4) = x - 0.4 - x20 - x30 - x40 - x50: ln(5) = y - y10 - y20 - y30 - y40 - y50 ln(6) = x: ln(7) = y - y10 - y20 - y30 - y40 - y50 ln(8) = x: ln(9) = y - y10 - y20 - y30 - y40 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "arceringsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True

Bijlage III

Pag.7

'plaatsen tekst laag 5 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox33.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox5.Value & " " & "vk " & Me.TextBox33.Value & " " & Me.TextBox26.Value, x + 0.05, y - y10 - y20 - y30 - y40 - 0.5 * y50, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox5.Value & " " & Me.TextBox26.Value, x + 0.05, y - y10 - y20 - y30 - y40 - 0.5 * y50, 0.025) End If 'plaatsen maatvoering laag 5 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.D imStyles.Item("RTW-LGO-10") If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 y20 - y30 - y40, x - 0.5 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x20 - x30 - x40, y, x - 0.4 - x20 - x30 x40 - x50, y, x - 0.4 - x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen laag 6 indien aktief If Me.CheckBox6.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 - y20 - y30 - y40 - y50 ln(2) = x - 0.4 - x20 - x30 - x40 - x50 - x60: ln(3) = y - y10 - y20 - y30 - y40 - y50 ln(4) = x - 0.4 - x20 - x30 - x40 - x50 - x60: ln(5) = y - y10 - y20 - y30 - y40 - y50 y60 ln(6) = x: ln(7) = y - y10 - y20 - y30 - y40 - y50 y60 ln(8) = x: ln(9) = y - y10 - y20 - y30 - y40 - y50 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "arceringsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 6 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox34.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox6.Value & " " & "vk " & Me.TextBox34.Value & " " & Me.TextBox27.Value, x + 0.05, y - y10 - y20 - y30 - y40 - y50 - 0.5 * y60, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox6.Value & " " & Me.TextBox27.Value, x + 0.05, y - y10 - y20 - y30 - y40 - y50 - 0.5 * y60, 0.025) End If 'plaatsen maatvoering laag 6 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles.Item("RTW -LGO-10")

Bijlage III

Pag.8

If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50 - y60, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y y10 - y20 - y30 - y40 - y50, x - 0.5 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50 - y60 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x20 - x30 - x40 - x50, y, x - 0.4 - x20 x30 - x40 - x50 - x60, y, x - 0.4 - x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen laag 7 indien aktief If Me.CheckBox7.Value = True Then OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT ln(0) = x: ln(1) = y - y10 - y20 - y30 - y40 y50 - y60 ln(2) = x - 0.4 - x20 - x30 - x40 - x50 - x60 - x70: ln(3) = y - y10 - y20 - y30 - y40 y50 - y60 ln(4) = x - 0.4 - x20 - x30 - x40 - x50 - x60 - x70: ln(5) = y - y10 - y20 - y30 - y40 y50 - y60 - y70 ln(6) = x: ln(7) = y - y10 - y20 - y30 - y40 y50 - y60 - y70 ln(8) = x: ln(9) = y - y10 - y20 - y30 - y40 y50 - y60 Set LW = ThisDrawing.ModelSpace.AddLightWeightPolyline(ln) LW.Update 'plaatsen arcering OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "arceringslaag", "S", 0, arceringslaag) Set LT = ThisDrawing.Layers.Add(arceringslaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "arceringsnaam", "S", 0, arceringsnaam) Set HT = ThisDrawing.ModelSpace.AddHatch(2, arceringsnaam, True) Set outerLoop(0) = LW HT.AppendOuterLoop (outerLoop) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "arceringsschaal", "S", 0, arceringsschaal) OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "arceringsrotatie", "S", 0, arceringsrotatie) HT.PatternSpace = HT.PatternSpace / arceringsschaal HT.PatternAngle = HT.PatternAngle + arceringsrotatie HT.Evaluate ThisDrawing.Regen True 'plaatsen tekst laag 7 OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT If Me.TextBox35.Visible = True Then Call algemeen.ThisDrawing.tekstml(Me.ComboBox7.Value & " " & "vk " & Me.TextBox35.Value & " " & Me.TextBox28.Value, x + 0.05, y - y10 - y20 - y30 - y40 - y50 - y60 - 0.5 * y70, 0.025) Else Call algemeen.ThisDrawing.tekstml(Me.ComboBox7.Value & " " & Me.TextBox28.Value, x + 0.05, y - y10 - y20 - y30 - y40 - y50 - y60 - 0.5 * y70, 0.025) End If 'plaatsen maatvoering laag 7 Set LT = ThisDrawing.Layers.Add("dp -nw-bm_10") ThisDrawing.ActiveLayer = LT On Error Resume Next ThisDrawing.ActiveDimStyle = ThisDrawing.DimStyles.Item("RTW -LGO-10") If Err Then ThisDrawing.SendCommand ("(C:RTW_schaal) ") ThisDrawing.SendCommand ("(C:RTW_dim ""L"" ""DEF"" ""REDRAW"") ") End If On Error GoTo 0 Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50 - y60 - y70, x - 0.4 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y - y10 - y20 - y30 - y40 - y50 - y60, x - 0.5 - x10 - x20 - x30 - x40 - x50 - x60 - x70, y y10 - y20 - y30 - y40 - y50 - y60 - y70 / 2) Call algemeen.ThisDrawing.maatvoering(x - 0.4 - x20 - x30 - x40 - x50 - x60, y, x - 0.4 x20 - x30 - x40 - x50 - x60 - x70, y, x - 0.4 - x10 / 2, y + 0.1) End If '-----------------------------------------------------------------------------------------'tekenen oppervlaktebehandeling indien aktief If Me.CheckBox8.Value = True Then

Bijlage III

Pag.9

OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", "oppervlaktebehandeling", "tekenlaag", "S", 0, tekenlaag) Set LT = ThisDrawing.Layers.Add(tekenlaag) ThisDrawing.ActiveLayer = LT OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", "oppervlaktebehandeling", "lijntype", "S", 0, lijntype) Set oud = ThisDrawing.ActiveLinetype On Error Resume Next ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(lijntype) If Err Then ThisDrawing.Linetypes.Load lijntype, "acadiso.lin" ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(lijntype) End If On Error GoTo 0 Call algemeen.ThisDrawing.lijn(x, y + 0.01, x - 0.4, y + 0.01) algemeen.ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).LinetypeScale = 0.005 algemeen.ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).Update ThisDrawing.ActiveLinetype = oud 'plaatsen tekst oppervlaktebehandeling OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", "oppervlaktebehandeling", "tekstlaag", "S", 0, tekstlaag) Set LT = ThisDrawing.Layers.Add(tekstlaag) ThisDrawing.ActiveLayer = LT Call algemeen.ThisDrawing.tekst("oppervlaktebehandeling", x + 0.05, y + 0.01, 0.025) End If 'plaatsen onderschrift If Me.CheckBox9.Value = True Then Set LT = ThisDrawing.Layers.Add("dp -nw-t50_10") ThisDrawing.ActiveLayer = LT Call algemeen.ThisDrawing.tekst("DETAIL VERHARDINGSCONSTRUCTIE", x - 0.75, y - y10 - y20 y30 - y40 - y50 - y60 - y70 - 0.15, 0.05) Set LT = ThisDrawing.Layers.Add("dp -nw-t25_10") ThisDrawing.ActiveLayer = LT Call algemeen.ThisDrawing.tekst("SCHAAL 1:10", x - 0.75, y - y10 - y20 - y30 - y40 - y50 y60 - y70 - 0.2, 0.025) End If 'RTW-commando herstel lagen ThisDrawing.SendCommand ("(C:RTW_Lay_SYS) ") 'oorspronkelijke aktieve laag weer aktief maken ThisDrawing.ActiveLayer = aktief ThisDrawing.Regen (acActiveViewport) End Sub Private Sub Label7_Click() End Sub Private Sub UserForm_Initialize() Dim i As Long 'inibestand = "d:\HBO-traject\vdg.ini" 'vullen bloknamen comboboxen met materialen uit rij 1 OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", "lagen", "aantal", "S", 10, aantal) For i = 1 To aantal OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", "lagen", "laag" & i, "S", 10, naam) Call Me.ComboBox1.AddItem(naam) Call Me.ComboBox2.AddItem(naam) Call Me.ComboBox3.AddItem(naam) Call Me.ComboBox4.AddItem(naam) Call Me.ComboBox5.AddItem(naam) Call Me.ComboBox6.AddItem(naam) Call Me.ComboBox7.AddItem(naam) Next i Me.ComboBox1.ListIndex = 0 Me.ComboBox2.ListIndex = 0 Me.ComboBox3.ListIndex = 0 Me.ComboBox4.ListIndex = 0 Me.ComboBox5.ListIndex = 0 Me.ComboBox6.ListIndex = 0 Me.ComboBox7.ListIndex = 0 End Sub Private Sub CheckBox2_Change() If Me.CheckBox2.Value = True Then Me.CheckBox3.Enabled = True Me.ComboBox2.Visible = True Me.TextBox2.Visible = True Me.TextBox9.Visible = True Me.TextBox16.Visible = True

Bijlage III

Pag.10

Me.TextBox23.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", 0, vk) If vk = "ja" Then Me.TextBox30.Visible = True End If Else Me.CheckBox3.Enabled = False Me.ComboBox2.Visible = False Me.TextBox2.Visible = False Me.TextBox9.Visible = False Me.TextBox16.Visible = False Me.TextBox23.Visible = False Me.TextBox30.Visible = False End If End Sub Private Sub CheckBox3_Change() If Me.CheckBox3.Value = True Then Me.CheckBox2.Enabled = False Me.CheckBox4.Enabled = True Me.ComboBox3.Visible = True Me.TextBox3.Visible = True Me.TextBox10.Visible = True Me.TextBox17.Visible = True Me.TextBox24.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", 0, vk) If vk = "ja" Then Me.TextBox31.Visible = True End If Else Me.CheckBox2.Enabled = True Me.CheckBox4.Enabled = False Me.ComboBox3.Visible = False Me.TextBox3.Visible = False Me.TextBox10.Visible = False Me.TextBox17.Visible = False Me.TextBox24.Visible = False Me.TextBox31.Visible = False End If End Sub Private Sub CheckBox4_Change() If Me.CheckBox4.Value = True Then Me.CheckBox3.Enabled = False Me.CheckBox5.Enabled = True Me.ComboBox4.Visible = True Me.TextBox4.Visible = True Me.TextBox11.Visible = True Me.TextBox18.Visible = True Me.TextBox25.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", 0, vk) If vk = "ja" Then Me.TextBox32.Visible = True End If Else Me.CheckBox3.Enabled = True Me.CheckBox5.Enabled = False Me.ComboBox4.Visible = False Me.TextBox4.Visible = False Me.TextBox11.Visible = False Me.TextBox18.Visible = False Me.TextBox25.Visible = False Me.TextBox32.Visible = False End If End Sub Private Sub CheckBox5_Change() If Me.CheckBox5.Value = True Then Me.CheckBox4.Enabled = False Me.CheckBox6.Enabled = True Me.ComboBox5.Visible = True Me.TextBox5.Visible = True Me.TextBox12.Visible = True Me.TextBox19.Visible = True Me.TextBox26.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", 0, vk) If vk = "ja" Then Me.TextBox33.Visible = True End If Else Me.CheckBox4.Enabled = True

Bijlage III

Me.ComboBox2.Value, "vk", "S",




Pag.11

Me.CheckBox6.Enabled = False Me.ComboBox5.Visible = False Me.TextBox5.Visible = False Me.TextBox12.Visible = False Me.TextBox19.Visible = False Me.TextBox26.Visible = False Me.TextBox33.Visible = False End If End Sub Private Sub CheckBox6_Change() If Me.CheckBox6.Value = True Then Me.CheckBox5.Enabled = False Me.CheckBox7.Enabled = True Me.ComboBox6.Visible = True Me.TextBox6.Visible = True Me.TextBox13.Visible = True Me.TextBox20.Visible = True Me.TextBox27.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox6.Value, "vk", "S", 0, vk) If vk = "ja" Then Me.TextBox34.Visible = True End If Else Me.CheckBox5.Enabled = True Me.CheckBox7.Enabled = False Me.ComboBox6.Visible = False Me.TextBox6.Visible = False Me.TextBox13.Visible = False Me.TextBox20.Visible = False Me.TextBox27.Visible = False Me.TextBox34.Visible = False End If End Sub Private Sub CheckBox7_Change() If Me.CheckBox7.Value = True Then Me.CheckBox6.Enabled = False Me.ComboBox7.Visible = True Me.TextBox7.Visible = True Me.TextBox14.Visible = True Me.TextBox21.Visible = True Me.TextBox28.Visible = True OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox7.Value, "vk", "S", 0, vk) If vk = "ja" Then Me.TextBox35.Visible = True End If Else Me.CheckBox6.Enabled = True Me.ComboBox7.Visible = False Me.TextBox7.Visible = False Me.TextBox14.Visible = False Me.TextBox21.Visible = False Me.TextBox28.Visible = False Me.TextBox35.Visible = False End If End Sub Private Sub ComboBox1_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "min", "S", 0, min) Me.TextBox8.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "max", "S", 0, max) Me.TextBox15.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox1.Value, "standaard", "S", 0, standaard) Me.TextBox1.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox1.Value, "vk", "S", 0, vk) If vk = "ja" Then Me.TextBox29.Visible = True Else Me.TextBox29.Visible = False End If End Sub Private Sub ComboBox2_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "min", "S", 0, min) Me.TextBox9.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "max", "S", 0, max) Me.TextBox16.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox2.Value, "standaard", "S", 0, standaard) Me.TextBox2.Value = standaard If Me.CheckBox2.Value = True Then

Bijlage III

Pag.12

OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox2.Value, "vk", "S", "nee", vk) If vk = "ja" Then Me.TextBox30.Visible = True Else Me.TextBox30.Visible = False End If End If End Sub Private Sub ComboBox3_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "min", "S", 0, min) Me.TextBox10.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "max", "S", 0, max) Me.TextBox17.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox3.Value, "standaard", "S", 0, standaard) Me.TextBox3.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox3.Value, "vk", "S", 0, vk) If Me.CheckBox3.Value = True Then If vk = "ja" Then Me.TextBox31.Visible = True Else Me.TextBox31.Visible = False End If End If End Sub Private Sub ComboBox4_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "min", "S", 0, min) Me.TextBox11.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "max", "S", 0, max) Me.TextBox18.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox4.Value, "standaard", "S", 0, standaard) Me.TextBox4.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox4.Value, "vk", "S", 0, vk) If Me.CheckBox4.Value = True Then If vk = "ja" Then Me.TextBox32.Visible = True Else Me.TextBox32.Visible = False End If End If End Sub Private Sub ComboBox5_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "min", "S", 0, min) Me.TextBox12.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "max", "S", 0, max) Me.TextBox19.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox5.Value, "standaard", "S", 0, standaard) Me.TextBox5.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox5.Value, "vk", "S", 0, vk) If Me.CheckBox5.Value = True Then If vk = "ja" Then Me.TextBox33.Visible = True Else Me.TextBox33.Visible = False End If End If End Sub Private Sub ComboBox6_Change() OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "min", "S", 0, min) Me.TextBox13.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "max", "S", 0, max) Me.TextBox20.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox6.Value, "standaard", "S", 0, standaard) Me.TextBox6.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox6.Value, "vk", "S", 0, vk) If Me.CheckBox6.Value = True Then If vk = "ja" Then Me.TextBox34.Visible = True Else Me.TextBox34.Visible = False End If End If End Sub Private Sub ComboBox7_Change()

Bijlage III

Pag.13

OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "min", "S", 0, min) Me.TextBox14.Value = min OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "max", "S", 0, max) Me.TextBox21.Value = max OK = Module1.fReadValue("D:\HBO-traject\vdg.ini", Me.ComboBox7.Value, "standaard", "S", 0, standaard) Me.TextBox7.Value = standaard OK = algemeen.Module1.fReadValue("D: \HBO-traject\vdg.ini", Me.ComboBox7.Value, "vk", "S", 0, vk) If Me.CheckBox7.Value = True Then If vk = "ja" Then Me.TextBox35.Visible = True Else Me.TextBox35.Visible = False End If End If End Sub Private Sub CommandButton2_Click() Me.Hide End Sub

Programmacode algemeen-iva.dvb.thisdrawing Public EX As Excel.Application Sub lijn(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double) ' declareren variabelen Dim beginpnt(0 To 2) As Double Dim eindpnt(0 To 2) As Double Dim lijnobject As AcadLine ' aanmaken punten beginpnt(0) = x1: eindpnt(0) = x2 beginpnt(1) = y1: eindpnt(1) = y2 beginpnt(2) = 0: eindpnt(2) = 0 ' tekenen lijn Set lijnobject = ThisDrawing.ModelSpace.AddLine(beginpnt, eindpnt) ' updaten object lijnobject.Update End Sub 'einde lijn Sub cirkel(ByVal x As Double, ByVal y As Double, ByVal r As Double) ' declareren variabelen Dim middelpunt(0 To 2) As Double Dim cirkelobject As AcadCircle ' aanmaken punt middelpunt(0) = x middelpunt(1) = y middelpunt(2) = 0 ' tekenen cirkel indien straal > 0 If r <= 0 Then MsgBox "ingevoerde straal = 0" & vbCr & "er wordt geen cirkel getekend" Else Set cirkelobject = ThisDrawing.ModelSpace.AddCircle(middelpunt, r) ' updaten object cirkelobject.Update End If End Sub 'einde cirkel Sub boog(ByVal x As Double, ByVal y As Double, ByVal r As Double, ByVal h1 As Double, ByVal h2 As Double) ' declareren variabelen Dim middelpunt(0 To 2) As Double Dim boogobject As AcadArc ' aanmaken punt middelpunt(0) = x middelpunt(1) = y middelpunt(2) = 0 ' omrekenen van graden naar radialen pi = 4 * Atn(1) h1 = (h1 / 180) * pi h2 = (h2 / 180) * pi ' tekenen boog indien straal > 0 If r > 0 And h1 <> h2 Then Set boogobject = ThisDrawing.ModelSpace.AddArc(middelpunt, r, h1, h2) Else MsgBox "ingevoerde straal = 0" & vbCr & "er wordt geen boog getekend" ' updaten object boogobject.Update End If End Sub 'einde boog Sub tekstML(ByVal regel As String, ByVal x As Double, ByVal y As Double, ByVal h As Double) ' declareren variabelen Dim punt(0 To 2) As Double

Bijlage III

Pag.14

Dim tekstobject As AcadText ' aanmaken punt punt(0) = x punt(1) = y punt(2) = 0 ' plaatsen tekst Set tekstobject = ThisDrawing.ModelSpace.AddText(regel, punt, h) ' updaten object tekstobject.Alignment = acAlignmentMiddleLeft tekstobject.TextAlignmentPoint = punt tekstobject.Update End Sub 'einde tekst Sub tekst(ByVal regel As String, ByVal x As Double, ByVal y As Double, ByVal h As Double) ' declareren variabelen Dim punt(0 To 2) As Double Dim tekstobject As AcadText ' aanmaken punt punt(0) = x punt(1) = y punt(2) = 0 ' plaatsen tekst Set tekstobject = ThisDrawing.ModelSpace.AddText(regel, punt, h) ' updaten object tekstobject.Update End Sub 'einde tekst Sub blok(ByVal naam As String, ByVal x As Double, ByVal y As Double, ByVal schaal As Double, ByVal h As Double) ' declareren variabelen Dim punt(0 To 2) As Double Dim blokobject As AcadBlockReference ' aanmaken punt punt(0) = x punt(1) = y punt(2) = 0 On Error Resume Next ' plaatsen blok Set blokobject = ThisDrawing.ModelSpace.InsertBlock(punt, naam, schaal, schaal, 1, h) If Err Then Set blokobject = ThisDrawing.ModelSpace.InsertBlock(punt, naam & ".dwg", schaal, schaal, 1, h) Err.Clear End If ' updaten object blokobject.Update End Sub 'einde blok Sub maatvoering(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As Double) 'deze subroutine creeert een aligned dimension in modelspace 'declareren variabelen Dim punt1(0 To 2) As Double Dim punt2(0 To 2) As Double Dim punt3(0 To 2) As Double Dim maatobject As AcadDimAligned 'aanmaken punten punt1(0) = x1: punt1(1) = y1: punt1(2) = 0 punt2(0) = x2: punt2(1) = y2: punt2(2) = 0 punt3(0) = x3: punt3(1) = y3: punt3(2) = 0 'plaatsen aligned maatvoering in modelspace Set maatobject = ThisDrawing.ModelSpace.AddDimAligned(punt1, punt2, punt3) waarde = maatobject.Measurement If waarde < 0.039 Then maatobject.TextGap = 0.04 Else maatobject.TextGap = 0.007 End If maatobject.TextInside = True maatobject.LinearScaleFactor = 1000 maatobject.SuppressTrailingZeros = True 'updaten object maatobject.Update End Sub Function kies() As AcadSelectionSet On Error Resume Next Set kies = ThisDrawing.SelectionSets.Item("kies") If Err Then Set kies = ThisDrawing.SelectionSets.Add("kies") Err.Clear Else kies.Clear End If kies.SelectOnScreen End Function

Bijlage III

Pag.15

Function alles() As AcadModelSpace Set alles = ThisDrawing.ModelSpace End Function Sub verschalen(welke, ByVal x As Double, ByVal y As Double, ByVal s As Double) Dim element As AcadEntity Dim punt(1 To 3) As Double punt(1) = x punt(2) = y For Each element In welke Call element.ScaleEntity(punt, s) element.Update Next element End Sub Sub verplaatsen(welke, x1, y1, x2, y2, kopie) Dim element As AcadEntity Dim nieuwelement As AcadEntity Dim punt1(1 To 3) As Double Dim punt2(1 To 3) As Double punt1(1) = x1: punt1(2) = y1 punt2(1) = x2: punt2(2) = y2 For Each element In welke If kopie Then Set nieuwelement = element.Copy End If Call element.Move(punt1, punt2) element.Update Next element End Sub Sub ExcelKoppelen() On Error Resume Next Set EX = GetObject(, "Excel.Application") If Err Then Err.Clear Set EX = CreateObject("Excel.Application") End If 'EX.Visible = True On Error GoTo 0 End Sub Sub ExcelStoppen() EX.Quit Set EX = Nothing End Sub Function EXveld(ExcelBestand, tabblad, Rij, Kolom) As String Dim blad As Worksheet Set blad = ExcelBestand.Worksheets(tabblad) EXveld = blad.Cells(Rij, Kolom).Value End Function

Programmacode algemeen-iva.dvb.module1 Option Explicit Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Boolean End Type Public Const MAX_SIZE = 2048 Public Const MAX_INISIZE = 8192 Rem Constants for Registry top-level keys Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_DYN_DATA = &H80000006 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CLASSES_ROOT = &H80000000 Rem Return Public Const Public Const Public Const Public Const

values ERROR_SUCCESS = 0& ERROR_FILE_NOT_FOUND = 2& ERROR_MORE_DATA = 234 ERROR_NO_MORE_ITEMS = 259&

Rem RegCreateKeyEx options Public Const REG_OPTION_NON_VOLATILE = 0 Rem

RegCreateKeyEx Disposition

Bijlage III

Pag.16

Public Const REG_CREATED_NEW_KEY = &H1 Public Const REG_OPENED_EXISTING_KEY = &H2 Rem Registry data types Public Const REG_NONE = 0 Public Const REG_SZ = 1 Public Const REG_BINARY = 3 Public Const REG_DWORD = 4 Rem Registry security attributes Public Const KEY_QUERY_VALUE = &H1 Public Const KEY_SET_VALUE = &H2 Public Const KEY_CREATE_SUB_KEY = &H4 Public Const KEY_ENUMERATE_SUB_KEYS = &H8 Declare Function RegEnumValue Lib "advapi32.dll" _ Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _ ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, _ lpType As Long, lpData As Any, lpcbData As Long) As Long Declare Function RegDeleteValue Lib "advapi32.dll" _ Alias "RegDeleteValueA" _ (ByVal hKey As Long, ByVal lpVal ueName As String) _ As Long Declare Function RegDeleteKey Lib "advapi32.dll" _ Alias "RegDeleteKeyA" _ (ByVal hKey As Long, ByVal lpSubKey As String) As Long Declare Function RegOpenKeyEx Lib "advapi32.dll" _ Alias "RegOpenKeyExA" _ (ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal ulOptions As Long, ByVal samDesired As Long, _ phkResult As Long) As Long Declare Function RegCreateKeyEx Lib "advapi32.dll" _ Alias "RegCreateKeyExA" _ (ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal Reserved As Long, ByVal lpClass As String, _ ByVal dwOptions As Long, ByVal samDesired As Long, _ lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _ lpdwDisposition As Long) As Long Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpszValueName As String, _ ByVal lpdwReserved As Long, lpdwType As Long, _ lpData As Any, lpcbData As Long) As Long Declare Function RegSetValueEx Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal Reserved As Long, ByVal dwType As Long, _ lpData As Any, ByVal cbData As Long) As Long Public Declare Function RegEnumKey Lib "advapi32.dll" Alias _ "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, _ ByVal lpName As String, ByVal cbName As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Declare Function GetPrivateProfileSection Lib "kernel32" _ Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, _ ByVal lpReturnedString As String, ByVal nSize As Long, ByVal _ lpFileName As String) As Long Declare Function GetPrivateProfileString Lib "kernel32" _ Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpR eturnedString _ As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Declare Function WritePrivateProfileString Lib "kernel32" _ Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) _ As Long Declare Function GetPrivateProfileInt Lib "kernel32" _ Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As String, By Val nDefault As Long, ByVal lpFileName _ As String) As Long Public Function fDeleteKey(ByVal sTopKey As String, _

Bijlage III

Pag.17

ByVal sSubKey As String, ByVal sKeyName As String) As Long Rem Use this function to: Rem Delete a registry key. Rem Rem sTopKey Rem A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} Rem Rem sSubKey Rem A registry subkey. Rem Rem sKeyName Rem The name of the key to delete. Rem Rem Return Value Rem 0 if successful, non-zero otherwise. Rem Rem Example Rem lResult = fDeleteKey("HKCU", "Software \YourKey\...\YourApp", "KeyToDelete") Rem Call fDeleteKey("HKCU", "Software \YourKey\...\YourApp", "KeyToDelete") Rem Rem NOTE: Rem The key to be deleted cannot be a top -level key Rem and cannot have any sub-keys. Rem Dim lTopKey As Long Dim lHandle As Long Dim lResult As Long On Error GoTo fDeleteKeyError lResult = 99 lTopKey = fTopKey(sTopKey) If lTopKey = 0 Then GoTo fDeleteKeyError lResult = RegOpenKeyEx(lTopKey, sSubKey, 0, KEY_CREATE_SUB_KEY, lHandle) If lResult = ERROR_SUCCESS Then lResult = RegDeleteKey(lHandle, sKeyName) End If If lResult = ERROR_SUCCESS Or lResult = ERROR_FILE_NOT_FOUND Then fDeleteKey = ERROR_SUCCESS Else fDeleteKey = lResult End If Exit Function fDeleteKeyError: fDeleteKey = lResult End Function Public Function fDeleteValue(ByVal sTopKeyOrFile As String, _ ByVal sSubKeyOrSection As String, ByVal sValueName As String) As Long Rem Use this function to: Rem Delete a registry value. Rem Delete an .ini file value. Rem Rem sTopKeyOrIniFile Rem A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or Rem The full path of an .ini file (ex. "C: \Windows\MyFile.ini") Rem Rem sSubKeyOrSection Rem A registry subkey or Rem An .ini file section name Rem Rem sValueName Rem A registry entry or Rem An .ini file entry Rem Rem Return Value Rem 0 if successful, non-zero otherwise. Rem Rem Example 1 Delete a registry value. Rem lResult = fDeleteValue("HKCU", "Software \YourKey\LastKey\YourApp", "EntryToDelete") Rem Rem Example 2 Delete an .ini file value. Rem lResult = fDeleteValue("C:\Windows\Myfile.ini", "SectionName", "EntryToDelete") Rem Dim lTopKey As Long Dim lHandle As Long Dim lResult As Long

Bijlage III

Pag.18

On Error GoTo fDeleteValueError lResult = 99 lTopKey = fTopKey(sTopKeyOrFile) If lTopKey = 0 Then GoTo fDeleteValueError If lTopKey = 1 Then lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, "", sTopKeyOrFile) Else lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_SET_VALUE, lHandle) If lResult = ERROR_SUCCESS Then lResult = RegDeleteValue(lHandle, sValueName) End If If lResult = ERROR_SUCCESS Or lResult = ERROR_FILE_NOT_FOUND Then fDeleteValue = ERROR_SUCCESS Else fDeleteValue = lResult End If End If Exit Function fDeleteValueError: fDeleteValue = lResult End Function Public Function fEnumKey(ByVal sTopKey As String, _ ByVal sSubKey As String, sValues As String) As Long Rem Use this function to: Rem Enumerate the subkeys of a registry key. Rem Rem sTopKey Rem A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} Rem Rem sSubKey Rem A registry subkey Rem Rem sValues Rem A returned string of the form: Rem SubKeyName|SubKeyName|.... SubKeyName|| Rem Rem Where - "|" equals vbNullChar (chr(0)). Rem Rem Return Value Rem 0 if successful, non-zero otherwise. Rem Rem Example 1 Rem lResult = fEnumKey("HKLM", "Software \Microsoft", sValues) Rem Dim bDone As Boolean Dim lTopKey As Long Dim lHandle As Long Dim lResult As Long Dim lIndex As Long Dim sKeyName As String On Error GoTo fEnumKeyError lResult = 99 lTopKey = fTopKey(sTopKey) If lTopKey = 0 Then GoTo fEnumKeyError Rem Rem Open the registry SubKey. Rem lResult = RegOpenKeyEx(lTopKey, sSubKey, 0, KEY_ENUMERATE_SUB_KEYS, lHandle) If lResult <> ERROR_SUCCESS Then GoTo fEnumKeyError Rem Rem Get all subkeys until ERROR_NO_MORE_ITEMS or an error occurs. Rem Do While Not bDone sKeyName = Space$(MAX_SIZE) lResult = RegEnumKey(lHandle, lIndex, sKeyName, MAX_SIZE) If lResult = ERROR_SUCCESS Then sValues = sValues & Trim$(sKeyName) lIndex = lIndex + 1 Else bDone = True End If Loop sValues = sValues & vbNullChar If Len(sValues) = 1 Then sValues = sValues & vbNullChar Rem Rem Close the key.

Bijlage III

Pag.19

Rem fEnumKey = RegCloseKey(lHandle) Exit Function Rem Rem Error processing. Rem fEnumKeyError: fEnumKey = lResult End Function Public Function fEnumValue(ByVal sTopKeyOrIniFile As String, _ ByVal sSubKeyOrSection As String, sValues As String) As Long Rem Use this function to: Rem Enumerate the values of a registry key or Rem Enumerate all entries in a particular section of an .ini file. Rem Rem sTopKeyOrIniFile Rem A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or Rem The full path of an .ini file (ex. "C: \Windows\MyFile.ini") Rem Rem sSubKeyOrSection Rem A registry subkey or Rem An .ini file section name Rem Rem sValues Rem A returned string of the form: Rem EntryName=Value|EntryName=Value|.... EntryName=Value|| Rem Rem Where - Value can be a string or binary value. Rem and - "|" equals vbNullChar (chr(0)). Rem Rem Return Value Rem 0 if successful, non-zero otherwise. Rem Rem Example 1 Rem lResult = fEnumValue("HKCU", "Software \YourKey\LastKey\YourApp", sValues) Rem Rem Example 2 Rem lResult = fEnumValue("C:\Windows\Myfile.ini", "SectionName", sValues) Rem Rem NOTE: Rem When enumerating registry values, only string, dword and binary values Rem with a length under 2 bytes (which allows for true/false values) are returned. Rem Dim lTopKey As Long Dim lHandle As Long Dim lResult As Long Dim lValueLen As Long Dim lIndex As Long Dim lValue As Long Dim lValueType As Long Dim lData As Long Dim lDataLen As Long Dim bDone As Boolean Dim sValueName As String Dim sValue As String On Error GoTo fEnumValueError lResult = 99 lTopKey = fTopKey(sTopKeyOrIniFile) If lTopKey = 0 Then GoTo fEnumValueError If lTopKey = 1 Then Rem Rem Enumerate an .ini file section. Rem sValues = Space$(MAX_INISIZE) lResult = GetPrivateProfileSection(sSub KeyOrSection, sValues, Len(sValues), sTopKeyOrIniFile) Else Rem Rem Open the registry SubKey. Rem lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle) If lResult <> ERROR_SUCCESS Then GoTo fEnumValueError Rem Rem Get all values until ERROR_NO_MORE_ITEMS or an error occurs. Rem Do While Not bDone lDataLen = MAX_SIZE lValueLen = lDataLen

Bijlage III

Pag.20

sValueName = Space$(lDataLen) lResult = RegEnumValue(lHandle, l Index, sValueName, lValueLen, 0, lValueType, ByVal lData, lDataLen) If lResult = ERROR_SUCCESS Then Select Case lValueType Case REG_SZ sValue = Space$(lDataLen) sValueName = Left$(sValueName, lValueLen) lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lDataLen) If lResult = ERROR_SUCCESS Then sValues = sValues & sValueName & "=" & sValue Else GoTo fEnumValueError End If Case REG_DWORD lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_NONE, lValue, lDataLen) If lResult = ERROR_SUCCESS Then sValueName = Left$(sValueName, lValueLen) sValues = sValues & sValueName & "=" & lValue & vbNullChar Else GoTo fEnumValueError End If Case REG_BINARY If lDataLen <= 2 Then lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_NONE, lValue, lDataLen) If lResult = ERROR_SUCCESS Then sValueName = Left$(sValueName, lValueLen) sValues = sValues & sValueName & "=" & lValue & vbNullChar Else GoTo fEnumValueError End If End If Case Else End Select lIndex = lIndex + 1 Else bDone = True End If Loop sValues = sValues & vbNullChar If Len(sValues) = 1 Then sValues = sValues & vbNullChar Rem Rem Close the key. Rem lResult = RegCloseKey(lHandle) fEnumValue = lResult End If Exit Function Rem Rem Error processing. Rem fEnumValueError: fEnumValue = lResult End Function Public Function fReadIniFuzzy(ByVal sIniFile As String, _ sSection As String, ByVal sIniEntry As String, _ ByVal sDefault As String, sValue As String) As Long Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem

Use this function to: Read a string value from an .ini file when you do not know the exact name of the section the value is in. sIniFile The full path of an .ini file (ex. "C: \Windows\MyFile.ini") sSection Any complete part of the .ini file section name. Ex: [ABC DEF GHI JKL] sSection Name can be "ABC" or "DEF" or "GHI" or "JKL" but not a partial value such as "AB" or "HI". NOTE: if sSection is passed as a variable and not as the actual string value, sSection will be populated with the complete section name. sEntry An .ini file entry

Bijlage III

Pag.21

Rem sDefault Rem The default value to return. Rem Rem sValue Rem The string value read. Rem sDefault if unsuccessful. Rem Rem Return Value Rem 0 if sEntry was found, non-zero otherwise. Rem Rem Example 1 Read a string value from an .ini file. Rem Ex: [ABC DEF GHI JKL] Rem AppName="My App" Rem Rem sEntry = "AppName" Rem lResult = fReadIniFuzzy("C: \Windows\Myfile.ini", "DEF", sEntry, sValue) Rem Rem Upon completion: Rem lResult = 0 Rem sSection = "ABC DEF GHI JKL" Rem sValue = "My App" Rem Dim sNextChar As String Dim sLine As String Dim sEntry As String Dim sSectionName As String Dim iLen As Integer Dim iLocOfEq As Integer Dim iFnum As Integer Dim bDone As Boolean Dim bFound As Boolean Dim bNewSection As Boolean On Error GoTo fReadIniFuzzyError fReadIniFuzzy = 99 bDone = False sValue = sDefault sEntry = UCase$(sIniEntry) sSection = UCase$(sSection) iLen = Len(sSection) iFnum = FreeFile Open sIniFile For Input Access Read As iFnum Line Input #iFnum, sLine Do While Not EOF(iFnum) And Not bDone sLine = UCase$(Trim$(sLine)) bNewSection = False Rem Rem See if line is a section heading. Rem If Left$(sLine, 1) = "[" Then Rem Rem See if section heading contains desired value. Rem sSectionName = sLine Dim iPos As Integer iPos = InStr(1, sLine, sSection) If iPos > 0 Then Rem Rem Be sure the value is not part of a larger value. Rem sNextChar = Mid$(sLine, iPos + iLen, 1) If sNextChar = " " Or sNextChar = "]" Then Rem Rem Search this section for the entry. Rem Line Input #iFnum, sLine bFound = False bNewSection = False Do While Not EOF(iFnum) And Not bFound Rem Rem If we hit a new section, stop. Rem sLine = UCase$(Trim$(sLine)) If Left$(sLine, 1) = "[" Then bNewSection = True Exit Do End If Rem Rem Entry must start in column 1 to avoid comment lines. Rem

Bijlage III

Pag.22

If InStr(1, sLine, sEntry) = 1 Then Rem Rem If entry found and line is not incomplete, get value. Rem iLocOfEq = InStr(1, sLine, "=") If iLocOfEq <> 0 Then sValue = Mid$(sLine, iLocOfEq + 1) sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2) bFound = True bDone = True fReadIniFuzzy = 0 End If End If If Not bFound Then Line Input #iFnum, sLine End If Loop If EOF(iFnum) Then bDone = True sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2) End If End If End If If Not bNewSection And Not bDone Then Line Input #iFnum, sLine End If Loop Close iFnum Exit Function fReadIniFuzzyError: fReadIniFuzzy = 99 End Function Public Function fReadValue(ByVal sTopKeyOrFile As String, _ ByVal sSubKeyOrSection As String, ByVal sValueName As String, _ ByVal sValueType As String, ByVal vDefault As V ariant, _ vValue As Variant) As Long Rem Use this function to read a: Rem String, 16-bit binary (True|False), 32-bit integer registry value or Rem String or integer value from an .ini file. Rem Rem sTopKeyOrIniFile Rem A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or Rem The full path of an .ini file (ex. "C: \Windows\MyFile.ini") Rem Rem sSubKeyOrSection Rem A registry subkey or Rem An .ini file section name Rem Rem sValueName Rem A registry entry or Rem An .ini file entry Rem Rem sValueType Rem "S" to read a string value or Rem "B" to read a 16-bit binary value (applies to registry use only) or Rem "D" to read a 32-bit number value (applies to registry use only). Rem Rem vDefault Rem The default value to return. It can be a string or boolean. Rem Rem vValue Rem The value read. It can be a string or boolean. Rem vDefault if unsuccessful (0 when reading an integer from an .ini file) Rem Rem Return Value Rem 0 if successful, non-zero otherwise. Rem Rem Example 1 Read a string value from the registry. Rem lResult = fReadValue("HKCU", "Software \YourKey\LastKey\YourApp", "AppName", "S", "", sValue) Rem Rem Example 2 Read a boolean (True|False) value from the registry. Rem lResult = fReadValue("HKCU", "Software \YourKey\LastKey\YourApp", "AutoHide", "B", False, bValue) Rem Rem Example 3 Read an integer value from the registry. Rem lResult = fReadValue("C:\Windows\Myfile.ini", "SectionName", "NumApps", "D", 12345, lValue) Rem Rem Example 4 Read a string value from an .ini file.

Bijlage III

Pag.23

Rem lResult sValue) Rem Rem Example 5 Rem lResult iValue) Rem Dim lTopKey Dim lHandle Dim lLenData Dim lResult Dim lDefault Dim lValue Dim sValue Dim sSubKeyPath Dim sDefaultStr Dim bValue

= fReadValue("C:\Windows\Myfile.ini", "SectionName", "AppName", "S", "", Read an integer value from an .ini file. = fReadValue("C:\Windows\Myfile.ini", "SectionName", "NumApps", "B", "0", As As As As As As As As As As

Long Long Long Long Long Long String String String Boolean

On Error GoTo fReadValueError lResult = 99 vValue = vDefault lTopKey = fTopKey(sTopKeyOrFile) If lTopKey = 0 Then GoTo fReadValueError If lTopKey = 1 Then Rem Rem Read the .ini file value. Rem If UCase$(sValueType) = "S" Then lLenData = 255 sDefaultStr = vDefault sValue = Space$(lLenData) lResult = GetPrivateProfileString(sSubKeyOrSection, sValueName, sDefaultStr, sValue, lLenData, sTopKeyOrFile) vValue = Left$(sValue, lResult) Else lDefault = 0 lResult = GetPrivateProfileInt(sSubKeyOrSection, sValueName, lDefault, sTopKeyOrFile) End If Else Rem Rem Open the registry SubKey. Rem lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle) If lResult <> ERROR_SUCCESS Then fReadValue = lResult Exit Function End If Rem Rem Get the actual value. Rem Select Case UCase$(sValueType) Case "S" Rem Rem String value. The first query gets the string length. The second Rem gets the string value. Rem lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, "", lLenData) If lResult = ERROR_MORE_DATA Then sValue = Space(lLenData) lResult = RegQueryValueE x(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData) End If If lResult = ERROR_SUCCESS Then ' Remove null character. vValue = Left$(sValue, lLenData - 1) Else GoTo fReadValueError End If Case "B" lLenData = Len(bValue) lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_BINARY, bValue, lLenData) If lResult = ERROR_SUCCESS Then vValue = bValue Else GoTo fReadValueError End If Case "D" lLenData = 32 lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_DWORD, lValue, lLenData) If lResult = ERROR_SUCCESS Then vValue = lValue Else

Bijlage III

Pag.24

GoTo fReadValueError End If End Select Rem Rem Close the key. Rem lResult = RegCloseKey(lHandle) fReadValue = lResult End If Exit Function Rem Rem Error processing. Rem fReadValueError: fReadValue = lResult End Function Private Function fTopKey(ByVal sTopKeyOrFile As String) As Long Dim sDir As String Rem This function returns: Rem the numeric value of a top level registry key or Rem 1 if sTopKey is a valid .ini file or Rem 0 otherwise. Rem On Error GoTo fTopKeyError fTopKey = 0 Select Case UCase$(sTopKeyOrFile) Case "HKCU" fTopKey = HKEY_CURRENT_USER Case "HKLM" fTopKey = HKEY_LOCAL_MACHINE Case "HKU" fTopKey = HKEY_USERS Case "HKDD" fTopKey = HKEY_DYN_DATA Case "HKCC" fTopKey = HKEY_CURRENT_CONFIG Case "HKCR" fTopKey = HKEY_CLASSES_ROOT Case Else On Error Resume Next sDir = Dir$(sTopKeyOrFile) If Err.Number = 0 And sDir <> "" Then fTopKey = 1 End Select Exit Function fTopKeyError: End Function Public Function fWriteValue(ByVal sTopKeyOrFile As String, _ ByVal sSubKeyOrSection As String, ByVal sValueName As String, _ ByVal sValueType As String, ByVal vValue As Variant) As Long Rem Rem Rem Rem Rem Rem or Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem Rem

Use this function to write a: String, 16-bit binary (True|False), 32-bit integer registry value or String value to an .ini file. sTopKeyOrIniFile A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} -

The full path of an .ini file (ex. "C: \Windows\MyFile.ini")

sSubKeyOrSection A registry subkey or An .ini file section name sValueName A registry entry or An .ini file entry sValueType "S" to write a string value or "B" to write a 16-bit binary value (applies to registry use only) or "D" to write a 32-bit number value (applies to registry use only). vValue The value to write. It can be a string, binary or integer. Return Value 0 if successful, non-zero otherwise. Example 1

Bijlage III

-

Write a string value to the registry.

Pag.25

Rem lResult = fWriteValue("HKCU", "Software \YourKey\LastKey\YourApp", "AppName", "S", "MyApp") Rem Rem Example 2 Write a True|False value to the registry. Rem lResult = fWriteValue("HKCU", "Software \YourKey\LastKey\YourApp", "AutoHide", "B", True) Rem Rem Example 3 Write an integer value to the registry. Rem lResult = fWriteValue("HKCU", "Software \YourKey\LastKey\YourApp", "NumOfxxx", "D", 12345) Rem Rem Example 4 Write a string value to an .ini file. Rem lResult = fWriteValue("C:\Windows\Myfile.ini", "SectionName", "AppName", "S", "MyApp") Rem Rem NOTE: Rem This function cannot write a non -string value to an .ini file. Rem Dim hKey As Long Dim lTopKey As Long Dim lOptions As Long Dim lsamDesired As Long Dim lHandle As Long Dim lDisposition As Long Dim lLenData As Long Dim lResult As Long Dim lValue As Long Dim sClass As String Dim sValue As String Dim sSubKeyPath As String Dim bValue As Boolean Dim tSecurityAttributes As SECURITY_ATTRIBUTES On Error GoTo fWriteValueError lResult = 99 lTopKey = fTopKey(sTopKeyOrFile) If lTopKey = 0 Then GoTo fWriteValueError If lTopKey = 1 Then Rem Rem Read the .ini file value. Rem If UCase$(sValueType) = "S" Then sValue = vValue lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, sValue, sTopKeyOrFile) Else GoTo fWriteValueError End If Else sClass = "" lOptions = REG_OPTION_NON_VOLATILE lsamDesired = KEY_CREATE_SUB_KEY Or KEY_SET_VALUE Rem Rem Create the SubKey or open it if it exists. Return its handle. Rem lDisposition will be REG_CREATED_NEW_KEY if the key did not exist. Rem lResult = RegCreateKeyEx(lTopKey, sSubKeyOrSection, 0, sClass, lOptions, _ lsamDesired, tSecurityAttributes, lHandle, lDisposition) If lResult <> ERROR_SUCCESS Then GoTo fWr iteValueError Rem Rem Set the actual value. Rem Select Case UCase$(sValueType) Case "S" sValue = vValue lLenData = Len(sValue) + 1 lResult = RegSetValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData) Case "B" bValue = vValue lLenData = Len(bValue) lResult = RegSetValueEx(lHandle, sValueName, 0, REG_BINARY, bValue, lLenData) Case "D" lValue = CInt(vValue) lLenData = 4 lResult = RegSetValueEx(lHandle, sValueName, 0, REG_DWORD, lValue, lLenData) End Select Rem Rem Close the key. Rem If lResult = ERROR_SUCCESS Then lResult = RegCloseKey(lHandle) fWriteValue = lResult

Bijlage III

Pag.26

Exit Function End If End If Exit Function Rem Rem Error processing. Rem fWriteValueError: fWriteValue = lResult End Function

Bijlage III

Pag.27

'H9HUKDUGLQJV'HWDLO*HQHUDWRU. vervaardiging van een AutoCAD-tool

Recommend Documents