HQ GENERATOR. Afstudeeropdracht in het kader van het HBO-Traject. "ACE System Manager" aan het TEC CadCollege te Nijmegen

HQ GENERATOR Afstudeeropdracht in het kader van het HBO-Traject "ACE System Manager" aan het TEC CadCollege te Nijmegen

opgesteld door:

P.H. Ruijsenberg Haarlemmerweg 253-C 1051 NV Amsterdam 020 48 66 731

werkzaam bij :

Van Rossum Raadgevende Ingenieurs Amsterdam B.V. Hageland 132 1066 SB Amsterdam 020 615 37 11

begeleider TEC:

ir. R. Boeklagen Kerkenbos 1018-B 6546 BA Nijmegen 024 356 56 77

1

Voorwoord Voor u ligt mijn afstudeerverslag. Ik heb gekozen voor een onderwerp wat goed aansluit bij mijn werkzaamheden als constructief tekenaar bij “Van Rossum Raadgevende Ingenieurs Amsterdam BV”. Ik heb inmiddels vele positieve reacties geoogst met deze applicatie zodat er genoeg stimulans is om nog veel meer, speciaal op ons bedrijf toegespitste programma´s te schrijven. Mijn dank gaat uit naar mijn begeleider ir. Ronald Boeklagen die een tipje van de sluier van het programmeren oplichtte, waardoor ik toegang kreeg tot de wereld achter AutoCAD, het programma waar ik dagelijks mee werk. Nog een woord van dank aan mijn werkgever die mij in de gelegenheid stelde deze cursus te volgen. En “last but not least”, Henrike bedankt voor je onvoorwaardelijke steun!

2

Inhoudsopgave

Voorwoord

.

.

.

.

.

.

2

Van Rossum Raadgevende Ingenieurs .

.

.

.

.

4

Aanleiding

.

.

.

.

.

.

.

.

.

.

.

.

5

.

.

.

.

.

.

.

.

6

Geïntegreerde stalen liggers

.

.

.

.

.

.

7

Voordelen op een rijtje

.

.

.

.

.

.

.

8

Toepassing .

.

.

.

.

.

.

.

9

De productie van de HQ profielen.

.

.

.

.

.

9

Tekenaars fout.

.

.

.

.

.

.

.

.

10

De applicatie

.

.

.

.

.

.

.

.

11

Het stroomschema van de applicatie

.

.

.

.

.

12

De installatie

.

.

.

.

.

.

12

De werking van de applicatie

.

.

.

.

.

.

13

Extra opties .

.

.

.

.

.

.

.

.

21

Help .

.

.

.

.

.

.

.

.

25

Info

.

.

.

.

.

.

.

.

.

25

Foutafhandeling

.

.

.

.

.

.

.

.

26

Conclusie

.

.

.

.

.

.

.

.

27

Bronvermelding

.

.

.

.

.

.

.

.

28

Bijlagen

.

.

.

.

.

.

.

.

29

Huidige situatie .

.

.

.

.

.

.

3

Van Rossum Raadgevende Ingenieurs Ir. Berend van Rossum startte 50 jaar geleden zijn buro onder de naam Ingenieursgroep Van Rossum. Inmiddels is het buro gegroeid naar een bedrijf met zo´n 100 medewerkers, verdeeld over 6 bedrijven. Herstructurering was hierdoor noodzakelijk. Alle vestigingen zijn per januari 2001 zelfstandige B.V.´s onder één holding; de Van Rossum Holding B.V. De diverse bedrijven van Van Rossum kunnen zich nu afhankelijk van locatie en/of adviesactiviteit binnen het kader van de totale groep manifesteren, dan wel profileren. Advies over constructies, in de ruimste zin van het woord, wordt uitgevoerd door 3 bedrijven: • Van Rossum raadgevende ingenieurs Amsterdam • Van Rossum raadgevende ingenieurs Almere • Van Rossum raadgevende ingenieurs Beverwijk Infrastructurele werken als bouw- en woonrijp maken van terreinen, saneringen, kunstwerken en dergelijke worden uitgevoerd door: • Van Rossum Infra

Breitnertoren in aanbouw

De bouwkundige facilitaire buro´s verzorgen onder meer bouwkundige tekeningen, bestekken, begrotingen, directievoering en toezicht. • Van Rossum Bouwkunde Amsterdam (met een vestiging in Amsterdam en een vestiging in Almere) • Koppes van Rossum Tussen de drie adviesburo´s van Van Rossum Raadgevende Ingenieurs vindt veelvuldig uitwisseling plaats van kennis en arbeid. Dit geldt ook voor de vestigingen van Van Rossum Bouwkunde en Koppes Van Rossum. Door de samenwerking van de buro´s kunnen bouwwerken, behoudens de architectuur en de installaties, volledig worden geadviseerd. Er treedt dan één persoon coördinerend op voor alle partijen. Ook totaalopdrachten behoren tot de mogelijkheden. Door eenvoudige onderlinge afstemming heeft dit in het totale ontwerpproces, inclusief uitvoering werktekening, grote voordelen, zowel in tijd als arbeid. De efficiënte werkwijze vertaalt zich ook in een economisch prijsadvies. van links (achter) naar rechts: Rembrandt-, Breitner- en Mondriaantoren constructeur: Van Rossum Raadgevende Ingenieurs Amsterdam BV

4

Aanleiding Mijn werkzaamheden bij Van Rossum bestaan uit het tekenen van beton- en staaltekeningen. Kort samengevat bestaan mijn werkzaamheden dus uit het tekenen van alles wat het te bouwen gebouw overeind houdt. Deze tekenwerkzaamheden beginnen in de VO-fase (voorlopig ontwerp). Hierna volgt de DO-fase (definitief ontwerp), waaruit de bestektekeningen volgen. Deze tekeningen gebruikt de aannemer om zijn prijs te bepalen. Na wat wijzigings- en bezuinigingsrondes kan aan de werktekeningen worden begonnen. Ons buro is verantwoordelijk voor de maatvoering van alle in het werk gestorte beton. Prefabbetonelementen worden door ons buro schematisch aangegeven. Het uittekenen gebeurt vaak door in het tekenen van prefabelementen, gespecialiseerde ingenieur buro´s. Dit zijn vaak de leveranciers van de betreffende elementen. Wanneer het project een staalconstructie bevat, levert ons bedrijf de overzichtstekeningen met principedetails. Een staalleverancier werkt dan de staalconstructie uit tot werkplaatstekeningen. De staalleverancier maakt daarbij veelal gebruik van zeer gespecialiseerde 3-D tekenprogramma´s, welke meteen bestellijsten kunnen genereren. Ons buro maakt bij het vervaardigen van het tekenwerk gebruik van AutoCAD 2002 met een applicatie van Technosoft. Zoals zoveel andere applicaties voorziet Technosoft onze tekenaars van de nodige HEA-, HEB-, HEM-, T-, buis-, kokerprofielen en hoeklijnen. Tegenwoordig worden echter ook steeds vaker HQ profielen toegepast. Ik heb tot op heden nog geen applicatie in de vakbladen kunnen vinden die onze tekenaars kan voorzien van kant en klare, digitale HQ profielen.

overzichtstekening Carnisse Veste te Barendrecht, onderdeel stalen brug (brugdek opgebouwd uit HQ profielen en kanaalplaten)

5

Huidige situatie De tekenaar krijgt van de staalconstructeur de toe te passen profielen op. Dit gebeurt vaak door middel van een schets. De tekenaar controleert onder het tekenen of het opgegeven profiel wel bestaat. Deze controle vindt plaats doordat het opgegeven profiel wel of niet aanwezig is in de bibliotheek van de geraadpleegde applicatie. Is het profiel niet aanwezig dan kan een tabellenboek van een leverancier nog uitkomst bieden. Komt het profiel ook in deze lijsten niet voor dan is het profiel waarschijnlijk niet uit voorraad leverbaar. De tekenaar koppelt dit terug naar de constructeur die dan met een alternatief komt. Deze controle van de tekenaar is belangrijk opdat de aannemer in de uitvoeringsfase niet voor het probleem komt te staan dat het opgegeven profiel niet leverbaar is, wat met in achtneming van lange levertijden, een flinke stagnatie in de bouwtijd kan opleveren. Doordat er tot op dit moment nog geen applicatie voorhanden was, bestond de “digitale”controle niet voor de HQ ligger.

HQ-lijsten...

6

Geïntegreerde stalen liggers De bouwwijze met stalen skelet en geïntegreerde stalen liggers leidt tot een (opvallend) efficiënte en lichte constructie. Zo kan er bespaard worden op de grondwerken en de fundering. Het gebouw voldoet aan de zwaarste eisen aangaande brandwerendheid, wanneer de stalen kolommen en liggers van een passende brandwerende bekleding worden voorzien. Aangezien de liggers ingebed liggen in beton, hoeft hierbij uitsluitend de onderflens te worden bekleed. Dat bespaart flink in de kosten. Het gebruik van staal voor kolommen en liggers is relatief gunstig qua integrale milieubelasting. Omdat de liggers noch onder noch boven de vloer uitsteken, is er geen enkel hoogteverlies in het gebouw. De vloer is volledig vlak en vrij indeelbaar. Er zijn dus ook geen belemmeringen bij de aanleg van de technische installaties (luchtbehandeling, water/sanitair, elektriciteit). Zeker bij gebouwen met veel leidingen kanaalwerk een niet te onderschatten voordeel. Geen verloren hoogte in het gebouw, met als gevolg, geringere bruto verdiepingshoogte; met andere woorden, een minimaal bouwvolume of een extra verdieping. Stalen kolommen en liggers worden in de fabriek geprefabriceerd en voor zover nodig van een brandwerende bekleding voorzien. Dat is zeer bevorderlijk voor een snelle voortgang van de bouw, zonder onderbrekingen, zonder haperingen en met een optimale logistiek. Bij de aanvoer van de elementen zorgt een uitgekiend systeem van transporthulpmiddelen ervoor, dat beschadigingen worden vermeden. De montage op de bouwplaats is simpel, zeker wanneer hierbij de speciaal daarvoor ontwikkelde montagehulpmiddelen worden ingeschakeld.

HQ liggers in combinatie met kanaalplaatvloerelementen

7

Voordelen op een rijtje • Een korte bouwtijd, door de liggers compleet in de werkplaats samen te stellen, inclusief voorzieningen ten behoeve van montage op de bouwplaats. • Door de geringe constructiehoogte kan de benodigde verdiepingshoogte sterk afnemen. Dit resulteert in een lagere bouwhoogte of een extra bouwlaag. • De vlakke onderzijde van de vloer maakt het mogelijk leidingen op eenvoudige wijze aan te brengen. • De stalen liggers zijn opgenomen in de betonnen vloer en bezitten daardoor reeds een brandwerendheid van 30 minuten. Bij een hogere eis is het voldoende om enkel de onderzijde van de liggers te beschermen met een brandwerende bekleding of een brandwerende verf. • Door de snelle bouwtijd, een lagere verdiepingshoogte, een vlakke vloer en geringe kosten voor de brandwerende voorzieningen ontstaat een kostprijs die beduidend lager ligt dan voor gebouwen die op traditionele wijze zijn opgetrokken.

mogelijke voorzieningen welke van fabriek af worden geleverd

8

Toepassing Geïntegreerde liggers vinden hun toepassing met name in verdiepingsvloeren van utiliteitsbouw en industriële bouw, maar inmiddels ook steeds vaker in de woningbouw. Het vloersysteem leent zich zowel voor gebouwen met een staalskelet als voor de betonbouw.

De productie van de HQ profielen HQ profielen, ook wel hoedliggers, worden geheel samengelast uit warmgewalste strippen. Twee lijfplaten staan verticaal op de brede onderflens. De bovenflens wordt tussen de lijfplaten gelast. De zo gevormde koker is versterkt met ingelaste dwarsschotten. De lijfkoker is volledig gesloten, vandaar de kenschetsing "gesloten ligger". Voor de middenvelden van een skelet steekt de onderflens van de ligger aan beide zijden buiten het liggerlijf uit. De karakteristieke "hoge hoed"-vorm heeft geleid tot de roepnaam "hoedligger”. Overigens hoeft een hoedligger niet perse symmetrisch te zijn, men kan de uitstekende flenzen ook ongelijk maken, wanneer dit zo uitkomt.

HQ ligger met kopplaat en schetsplaat tbv windverband

9

Aanleiding HQ profielen worden, zoals hiervoor al aangegeven, opgebouwd uit 4 platen met 3 verschillende afmetingen. Een plaat wordt aangegeven als: ”HQ 265x5-25x240-15x450”. Als je goed kijkt zie je dat de 3 verschillende plaatafmetingen worden genoemd. Na dit herkend te hebben zou het betreffende profiel uitgetekend kunnen worden. Het nu volgende voorbeeld is een praktijk voorbeeld, het siert ons als tekenaars niet maar het toont wel het belang van deze nieuwe applicatie. In de volgende schets ziet u de situatie zoals die door ons buro aangegeven was. Het uiteindelijke verschil is minimaal maar wapeningsstaven tbv een trekband konden niet zondermeer gelegd worden. Met de HQ generator was deze fout niet opgetreden. Immers, de afmetingen van de platen afzonderlijk waren goed en de tekstuele aanduiding van het profiel was goed. De tekenaar had waarschijnlijk nog niet al te veel ervaring met dit soort profielen waardoor het profiel toch niet op de juiste wijze was uitgetekend.

-

detail op tekening...

-

detail in praktijk... 10

De applicatie De vraag is dus kort gezegd deze; “een correct digitaal getekend profiel al dan niet met tekstaanduiding” Voor het oplossen van voorgenoemd probleem had ik de keuze uit een aantal mogelijkheden. Ik heb de mogelijkheden hieronder even gesommeerd. • Invoegen als blokreferentie “block”. Een profiel kan ingevoegd worden. Ook hierbij heb je de keuze uit een aantal mogelijkheden. o het daarvoor bestemde invoegcommando “(DD)insert”, met of zonder dialoogbox. o via het pulldown menu o via een image menu Nadeel van deze oplossing zou zijn dat ik alle bekende HQ profielen een voor een uit zou moeten tekenen. • Ik had kunnen kiezen voor het laten schrijven van een lisp-routine. Deze optie had ons buro echter een hoop geld gekost. Buiten de kosten om iemand van “buiten”te laten komen, zal het onderhoud, eventuele aanpassingen en uitbreidingen elke keer een rekening opleveren. Ik laat nu even buiten beschouwing dat het ernaar uitziet dat Lisp een klein beetje achterhaald zal worden door andere programmeertalen.

Ik heb gekozen voor een applicatie in VBA, Visual Basic For Applications. Ook in VBA had ik de keuze uit een aantal mogelijkheden profielen digitaal in mijn tekening in te voegen namelijk: • als block referentie, een van tevoren uitgetekend profiel in mijn tekening invoegen. • parametrisch tekenen. De keuze is gevallen op het parametrisch uittekenen van de profielen. Ik heb hierbij het van tevoren uittekenen van enige honderden profielen in een klap omzeild.

11

Het stroomschema van de applicatie Uitgangspunt van deze applicatie is dat de gebruiker vrij eenvoudig het gewenste profiel in zijn tekening krijgt. Nadat de gebruiker, door op een button op het scherm te klikken, te kennen heeft gegeven gebruik te willen maken van de HQ generator, verschijnt een dialoogbox. Ik laat de gebruiker 6 tekstvelden invoeren waarna hij de keuze heeft om respectievelijk de doorsnede, het bovenaanzicht of vooraanzicht uit te laten tekenen, met of zonder tekstaanduiding bij het profiel. Nadat het profiel, met het door de gebruiker gekozen invoegpunt, in de tekening staat heeft de gebruiker nog de keuze om het profiel te roteren. Dit is in het kort de werking van deze applicatie. gebruiker drukt op icoon HQ generator

script file

toon dialoogbox

keuze ander profiel

nee

juiste profiel ja

toepassen ja

alle invoer velden correct

nee

achtergrondkleur rood

nee

nieuwe invoer gebruiker

nee

bovenaanzicht

nee

vooraanzicht

nee

m e lding foute invoer

ja

doorsnede ja

ja

teken profiel

geef lengte

tekst plaatsen

ja

ja

tekst plaatsen

nee

geef rotatiepunt

invoer gebruiker

nee

ja

geef tweede punt

invoer gebruiker

rotatie profiel

gereed

Stroomschema

De installatie Alvorens met het programma aan de gang te kunnen moeten een drie-tal bestanden op de juiste plekken worden gezet. Om deze applicatie te gebruiken is het noodzakelijk de map “cursus”bevattende het Excel-bestand “HQ-lijst.xls”, het Wordbestand “Help.doc”en de VBA routine “Einde.dvb”meteen onder “C:\”wordt geplaatst. De applicatie kan dan onder andere worden gestart door middel van een button. 12

De werking van de applicatie De applicatie kan worden gestart door op een knop op de toolbar te klikken. Onder deze knop zit het commando: “-vbarun;”met daarna genoemd het VBA commando voor het tonen van de dialoogbox.

De dialoogbox van de HQ generator wordt zichtbaar.

De gebruiker kan meteen voor de knop ”toepassen” kiezen. Wil de gebruiker een ander profiel dan kan dat door de invoervelden numeriek in te vullen.

13

Wanneer hij met de cursor over een invoerveld beweegt, licht de betreffende maatvoering in het plaatje op. Op deze manier is meteen zichtbaar welke maat zal worden aangepast.

Hieronder een stukje code waarin dit “oplichten”van invoerveld tbv van maat “H”en “d”is geregeld. Private Sub TextBoxH_MouseMove(ByVal Button As Integer, ByVal ShIft As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = vbYellow Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub Private Sub TextBoxd_MouseMove(ByVal Button As Integer, ByVal ShIft As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = vbYellow Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub

De gebruiker kan ook kiezen uit een aantal profielen welke reeds zijn ingevoerd in een Microsoft Excel-bestand. Op het moment dat het dialoogvenster zichtbaar wordt, wordt onzichtbaar de applicatie Excel gestart en het betreffende bestand geopend. Private Sub UserForm_Initialize() Dim X As Excel.Application Set X = CreateObject("Excel.application") Rem X.Visible = True Dim doc As Workbook Dim tabblad As Worksheet Dim cel As Range ReDim Preserve a(1 To 7, 1 To 1) .Workbooks.Open("C:\CURSUS\hq-lijst Set doc = X ") Set tabblad = doc.Sheets.Item("hq")

14

De waarden in de cellen worden uitgelezen tbv de listbox in de dialoogbox. Do i = i + 1 ReDim Preserve a(1 To 7, 1 To i) For j = 1 To 7 a(j, i) = tabblad.Cells(i, j) If j = 1 Then naam = a(j, i) Else naam = naam & "-" & a(j, i) End If Next j Me.ComboBoxProfiel.AddItem (naam) naam = "" Loop While tabblad.Cells(i + 1, 1) <> "" Me.ComboBoxProfiel.ListIndex = 0 X.Quit Set X = Nothing

Dit resulteert in een makkelijk uit te breiden profielen lijst in de dialoogbox.

15

De gebruiker bepaalt welk profiel uit de lijst hij wil gebruiken en de waarden van het betreffende profiel verschijnen in de invoervelden.

Private Sub ComboBoxProfiel_Change() On Error Resume Next Me.TextBoxH.Value = a(2, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxd.Value = a(3, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxt1.Value = a(4, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxB1.Value = a(5, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxt2.Value = a(6, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxB2.Value = a(7, Me.ComboBoxProfiel.ListIndex + 1) End Sub

De gebruiker kan ook voor een ander invoegpunt kiezen door ergens op de onderlijn van het profiel in de image te klikken.

Het invoegpunt, aangegeven door het “zonnetje”, zal het invoegpunt in de tekening worden. Hieronder een stukje code die zorgt dat het zonnetje zichtbaar wordt. Private Sub Imagelinksonderzonder_Click() Me.ImageLinksonder.Visible = True Me.Imagemiddenonder.Visible = False Me.Imagerechtsonder.Visible = False Me.Imagelinksonderzonder.Visible = False Me.Imagemiddenonderzonder.Visible = True Me.Imagerechtsonderzonder.Visible = True End Sub Private Sub Imagemiddenonderzonder_Click() Me.ImageLinksonder.Visible = False Me.Imagemiddenonder.Visible = True Me.Imagerechtsonder.Visible = False Me.Imagemiddenonderzonder.Visible = False Me.Imagelinksonderzonder.Visible = True Me.Imagerechtsonderzonder.Visible = True End Sub Private Sub Imagerechtsonderzonder_Click() Me.ImageLinksonder.Visible = False Me.Imagemiddenonder.Visible = False Me.Imagerechtsonder.Visible = True Me.Imagerechtsonderzonder.Visible = False Me.Imagelinksonderzonder.Visible = True Me.Imagemiddenonderzonder.Visible = True End Sub

16

Op dit moment kan door op de knop “toepassen”te drukken, de doorsnede van het profiel getekend worden. De tekstaanduiding van het profiel wordt ook meteen geplaatst. Wil de gebruiker dit niet dan kan hij dit veranderen door het vinkje weg te halen.

Wanneer de checkbox de waarde “True”heeft, wordt een aantal zaken rondom de tekstaanduiding van het profiel opgegeven. If Me.CheckBoxTekstplaatsen.Value = True Then

...er wordt een speciale laag aangemaakt... Rem layertekst Set proftxt = ThisDrawing.Layers.Add("proftxt") proftxt.Color = acYellow ThisDrawing.ActiveLayer = proftxt Dim Dim Dim Dim

textobj As AcadText textstring As String insertionpoint(0 To 2) As Double height As Double

...het invoegpunt wordt bepaald... insertionpoint(0) = (pl4(6) + pl4(9)) / 2 insertionpoint(1) = pl4(10) + (ThisDrawing.GetVariable("Dimscale")) insertionpoint(2) = pl4(2)

... de tekst krijgt een hoogte afhankelijk van de variabele Dimensieschaal. Ik heb hiervoor gekozen omdat de schaal van de tekening vaak vast ligt aan de hand van de gebruikte Dimensieschaal. height = 3.5 * (ThisDrawing.GetVariable("Dimscale")) textstring = "HQ " & Me.LabelH & "x" & Me.Labeld & "-" & Me.Labelt1 & "x" & Me.LabelB1 & "-" & Me.Labelt2 & "x" & Me.LabelB2 Set textobj = ThisDrawing.ModelSpace.AddText(textstring, insertionpoint, height)

... en de tekst-uitlijning... Dim alignmentPoint(0 To 2) As Double alignmentPoint(0) = insertionpoint(0): alignmentPoint(1) = insertionpoint(1): alignmentPoint(2) = insertionpoint(2) textobj.Alignment = acAlignmentBottomCenter

17

De HQ generator is niet alleen opgezet om doorsneden te tekenen. Door een andere optie te kiezen door middel van de optionbutton (ook wel radiobutton) kan de gebruiker kiezen voor het laten tekenen van een boven- en een vooraanzicht (buiten de doorsnede).

Bij de keuze boven- en vooraanzicht wordt ook het invoerveld en de knop “aanwijzen”voor de lengte bruikbaar. Private Sub OptionButtonvooraanzicht_Click() If Me.OptionButtonvooraanzicht.Value = True Then Me.FrameLengte.Enabled = True Me.TextBoxLengte.Enabled = True Me.CommandButtonPick.Enabled = True Me.TextBoxLengte.ForeColor = &H80000008 Me.TextBoxLengte.BackColor = &H80000005 End If End Sub

De achtergrondkleur van de invoervelden verandert ook wanneer er van optionbutton gewisseld wordt. Als de achtergrondkleur van een invoerveld grijs is, wil dit zeggen dat de waarde in het betreffende vakje niet noodzakelijk is voor het tekenen van dit aanzicht. Bij het tekenen van een bovenaanzicht bijvoorbeeld, is de hoogtemaat niet relevant. De vakjes zouden ook leeg kunnen blijven. Let wel op dat de niet ingevulde velden ook in de tekstaanduiding lege plekken zullen opleveren. doorsnede

Private Sub OptionButtondoorsnede_Click() If Me.OptionButtondoorsnede.Value = True Then Me.TextBoxH.BackColor = &H80000005 Me.TextBoxd.BackColor = &H80000005 Me.TextBoxt1.BackColor = &H80000005 Me.TextBoxB1.BackColor = &H80000005 Me.TextBoxt2.BackColor = &H80000005 Me.TextBoxB2.BackColor = &H80000005 End If End Sub

18

bovenaanzicht

Private Sub OptionButtonbovenaanzicht_Click() If Me.OptionButtonbovenaanzicht = True Then Me.TextBoxH.BackColor = &H8000000B Me.TextBoxd.BackColor = &H80000005 Me.TextBoxt1.BackColor = &H8000000B Me.TextBoxB1.BackColor = &H80000005 Me.TextBoxt2.BackColor = &H8000000B Me.TextBoxB2.BackColor = &H80000005 Me.TextBoxLengte.BackColor = &H80000005 End If

vooraanzicht

Private Sub OptionButtonvooraanzicht_Click() If Me.OptionButtonvooraanzicht.Value = True Then Me.TextBoxH.BackColor = &H80000005 Me.TextBoxd.BackColor = &H8000000B Me.TextBoxt1.BackColor = &H80000005 Me.TextBoxB1.BackColor = &H8000000B Me.TextBoxt2.BackColor = &H80000005 Me.TextBoxB2.BackColor = &H8000000B Me.TextBoxLengte.BackColor = &H80000005 End If

Bij het laten tekenen van een boven- of vooraanzicht moet de lengte van het profiel worden opgegeven. Dit kan op twee manieren: • numeriek invullen in het daarvoor bestemde invoerveld. Als standaard is een waarde opgegeven van 1000mm, zodat wanneer de gebruiker op toepassen drukt, altijd een profiel getekend wordt met een lengte van 1000mm.

De in dit invoerveld ingevoerde waarde zal de lengte worden van het te tekenen profiel. If Me.TextBoxLengte.Enabled = True Then lengte = Me.TextBoxLengte.Value End If

• aanwijzen van punten in de tekening.

19

Na het indrukken van deze button verschijnt op de commandoregel:

Wanneer in de tekening een punt, al dan niet met gebruik van “objectSnap”wordt gegeven, wordt de gebruiker gevraagd de lengte op te geven in de vorm van een tweede punt in de tekening. De gebruiker kan er ook voor kiezen de coördinaten numeriek op te geven op de commandolijn.

De volgende code rekent de lengte van het te tekenen profiel uit. startpunt = ThisDrawing.Utility.GetPoint(, "geef het startpunt: ") eindpunt = ThisDrawing.Utility.GetPoint(startpunt, "geef de lengte: ") lengte = Sqr(((eindpunt(0) - startpunt(0)) * (eindpunt(0) - startpunt(0))) + ((eindpunt(1) startpunt(1)) * (eindpunt(1) - startpunt(1))))

20

Extra opties De gebruiker kan het gewenste profiel laten tekenen. Als uitgangspunt heb ik gekozen voor de lagenstructuur zoals die op onze vestiging in Amsterdam gebruikt wordt.

Wil de gebruiker, om welke reden dan ook, afwijken van deze standaard, dan kan dat door middel van de “extra opties”. Wanneer op de knop “extra opties”wordt gedrukt, wordt een extra stukje dialoogbox getoond.

Private Sub CommandButtonoptions_Click() Me.Width = 675 End Sub

21

In deze uitgeklapte dialoogbox kan gekozen worden voor afwijkende lagen die al wel aangemaakt moeten zijn in de tekening.

De code hieronder zorgt ervoor dat de lagen van de tekening zichtbaar worden in de combobox. Set q = ThisDrawing.ActiveLayer Set profdsn = ThisDrawing.Layers.Add(Me.ComboBoxLaagDSN.Value) profdsn.Color = acByLayer ThisDrawing.ActiveLayer = profdsn Dim b() Dim c() For Each laag In ThisDrawing.Layers ReDim Preserve b(0 To 1, 0 To Y) b(0, Y) = laag.Name b(1, Y) = laag.Color Y = Y + 1 Next laag ReDim c(0 To Y - 1, 0 To 1) For j = 0 To Y - 1 c(j, 0) = b(0, j) c(j, 1) = b(1, j) Next j Me.ComboBoxLaagDSN.List = c Me.ComboBoxLaagBA.List = c Me.ComboBoxLaagVB.List = c

22

Nadat de gebruiker het profiel in de gewenste laag heeft laten tekenen, wordt de actieve laag, van voor de sessie, opnieuw actief gemaakt. De gebruiker kan dus verder tekenen in de laag waar hij bezig was. ThisDrawing.ActiveLayer = q

Nadat de gebruiker alle nodige invoer heeft gepleegd, drukt hij op “toepassen”en het profiel wordt getekend. Op de commandoregel verschijnt:

... respectievelijk:

Als “default”wordt “niet roteren”gegeven, als dat de bedoeling is kan de gebruiker dit bevestigen door op “enter”te drukken. Hij kan echter ook een draaipunt opgeven. Invoer kan numeriek of door in de tekening een punt te kiezen.

In deze functie worden de laatste 4 objecten van deze tekening geroteerd. In code ziet dat er als volgt uit: p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 4 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i

23

... gereed!

24

Help Ik maak in dit programma niet alleen een koppeling naar Microsoft Excel, maar ook naar Microsoft Word. Wanneer de gebruiker op de “Help knop”drukt, wordt het Word document geopend en, in tegenstelling tot het Excel-bestand, zichtbaar gemaakt. Omdat het bestand in Word is geschreven kan iedereen, met goedkeuring, dit helpbestand aanvullen. Het onderhoud van dit programma is hierdoor simpel. Private Sub CommandButtonHelp_Click() Dim w As Word.Application Set w = CreateObject("Word.application") w.Visible = True w.Documents.Open ("C:\CURSUS\help.doc") End Sub

Info Zoals bij veel applicaties is ook in de HQ generator een infoknop toegevoegd. Hierin is de versie van de applicatie vastgelegd.

25

Foutafhandeling De gebruiker moet een aantal handelingen uitvoeren om het gewenste profiel in de tekening te krijgen. Hierbij is het natuurlijk mogelijk dat er iets misgaat. Om de gebruiker te attenderen op de foutieve invoer heb ik in dit programma gekozen voor het rood kleuren van de foutief ingevoerde invoervelden. If Me.TextBoxH.Value + 1 <= 0 Then Me.TextBoxH.BackColor = vbRed foutje = True End If

Pas wanneer de gebruiker voor een tweede keer op de knop “toepassen”drukt toont het programma een boodschap (messagebox) waarin de fout wordt aangegeven. Ik heb voor deze wijze gekozen zodat de gebruiker niet telkens op de “OK”knop hoeft te drukken alvorens de foutieve invoer te kunnen corrigeren.

26

Conclusie Bij gebruik van deze applicatie zal de foutkans, bij het tekenen van constructies waar HQ profielen worden voorgeschreven, verkleinen. Daarbij is de tijdwinst die de tekenaar boekt per profiel aanzienlijk, zo´n 83 procent (winst).

Het doel van bijna alle applicaties, en de HQ generator incluis: ...”verkleinen van de foutkans en boeken van tijdwinst”wordt bij gebruik van dit programma behaald.

27

Bronvermelding

AutoCAD 2002 COMPUTER ONDERSTEUND ONTWERPEN ir. R. Boeklagen ISBN 90-72-487-29-X

VBA For AutoCAD 2002 Writing AutoCAD Macro´s Jeffrey E. Clark ISBN 0-13-065201-6

vakbladen: • Bouwen met Staal • Cement • CADMagazine brochures en websites van leveranciers van HQ profielen • Hody BV • Staalmeesters BV • Grünbauer

28

Bijlagen uitvoer van het volledige VBA programma:

HQ Generator

29

Dim a() Dim lengte As Double Private Sub CommandButtonoptions_Click() Me.Width = 675 Me.CommandButtonoptions.Enabled = False End Sub Private Sub TextBoxLengte_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.TextBoxLengte.Enabled = True End Sub Rem breedte dialoogbox bij activering Private Sub UserForm_Activate() Me.Width = 444 Me.CommandButtonoptions.Enabled = True End Sub Rem Lengte bepalen door aanwijzen in scherm Private Sub CommandButtonPick_Click() Me.Hide startpunt = ThisDrawing.Utility.GetPoint(, "geef het startpunt: ") On Error Resume Next eindpunt = ThisDrawing.Utility.GetPoint(startpunt, "geef de lengte: ") lengte = Sqr(((eindpunt(0) - startpunt(0)) * (eindpunt(0) - startpunt(0))) + ((eindpunt(1) - startpunt(1)) * (eindpunt(1) - startpunt(1)))) Me.TextBoxLengte.Value = 1000 Me.TextBoxLengte.Enabled = False Me.Show End Sub Rem waardes Combobox Private Sub ComboBoxProfiel_Change() On Error Resume Next Me.TextBoxH.Value = a(2, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxd.Value = a(3, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxt1.Value = a(4, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxB1.Value = a(5, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxt2.Value = a(6, Me.ComboBoxProfiel.ListIndex + 1) Me.TextBoxB2.Value = a(7, Me.ComboBoxProfiel.ListIndex + 1) End Sub Rem dialoogbox info tonen Private Sub CommandButtonInfo_Click() UserFormInfo.Show End Sub Rem dialoogbox normale afmeting geven Private Sub CommandButtonSluitextra_Click() Me.Width = 444 Me.CommandButtonoptions.Enabled = True End Sub Rem tekenen uitsluitend in modelspace Private Sub CommandButtonToepassen_Click() If ThisDrawing.ActiveSpace <> acModelSpace Then Call MsgBox("het profiel kan alleen in modelspace geplaatst worden", vbCritical) Exit Sub End If Rem foutafhandelingen textboxen If Me.TextBoxH.BackColor = vbRed Then Call MsgBox("invoer 'H' is niet correct", vbCritical) End If If Me.TextBoxd.BackColor = vbRed Then Call MsgBox("invoer 'd' is niet correct", vbCritical) End If If Me.TextBoxt1.BackColor = vbRed Then Call MsgBox("invoer 't1' is niet correct", vbCritical) End If If Me.TextBoxB1.BackColor = vbRed Then Call MsgBox("invoer 'B1' is niet correct", vbCritical) End If

If Me.TextBoxt2.BackColor = vbRed Then Call MsgBox("invoer 't2' is niet correct", vbCritical) End If If Me.TextBoxB2.BackColor = vbRed Then Call MsgBox("invoer 'B2' is niet correct", vbCritical) End If If Me.TextBoxLengte.BackColor = vbRed Then Call MsgBox("invoer 'lengte' is niet correct", vbCritical) End If On Error Resume Next Rem foutafhandeling doorsnede If Me.OptionButtondoorsnede.Value = True Then foutje = False If Me.TextBoxH.Value + 1 <= 0 Then Me.TextBoxH.BackColor = vbRed foutje = True End If If Me.TextBoxd.Value + 1 <= 0 Then Me.TextBoxd.BackColor = vbRed foutje = True End If If Me.TextBoxt1.Value + 1 <= 0 Then Me.TextBoxt1.BackColor = vbRed foutje = True End If If Me.TextBoxB1.Value + 1 <= 0 Then Me.TextBoxB1.BackColor = vbRed foutje = True End If If Me.TextBoxt2.Value + 1 <= 0 Then Me.TextBoxt2.BackColor = vbRed foutje = True End If If Me.TextBoxB2.Value + 1 <= 0 Then Me.TextBoxB2.BackColor = vbRed foutje = True End If If foutje Then Exit Sub End If Rem foutafhandeling bovenaanzicht On Error Resume Next If Me.OptionButtonbovenaanzicht.Value = True Then foutje = False If Me.TextBoxd.Value + 1 <= 0 Then Me.TextBoxd.BackColor = vbRed foutje = True End If If Me.TextBoxB1.Value + 1 <= 0 Then Me.TextBoxB1.BackColor = vbRed foutje = True End If If Me.TextBoxB2.Value + 1 <= 0 Then Me.TextBoxB2.BackColor = vbRed foutje = True End If If Me.TextBoxLengte.Value + 1 <= 0 Then Me.TextBoxLengte.BackColor = vbRed foutje = True End If If foutje Then Exit Sub End If

Rem foutafhandeling vooraanzicht On Error Resume Next If Me.OptionButtonvooraanzicht.Value = True Then foutje = False If Me.TextBoxH.Value + 1 <= 0 Then Me.TextBoxH.BackColor = vbRed foutje = True End If If Me.TextBoxt1.Value + 1 <= 0 Then Me.TextBoxt1.BackColor = vbRed foutje = True End If If Me.TextBoxt2.Value + 1 <= 0 Then Me.TextBoxt2.BackColor = vbRed foutje = True End If

If Me.TextBoxLengte.Value + 1 <= 0 Then Me.TextBoxLengte.BackColor = vbRed foutje = True End If If foutje Then Exit Sub End If Rem layer Dim q As AcadLayer Dim profdsn As AcadLayer Set q = ThisDrawing.ActiveLayer Set profdsn = ThisDrawing.Layers.Add(Me.ComboBoxLaagDSN.Value) profdsn.Color = acByLayer ThisDrawing.ActiveLayer = profdsn H = Me.TextBoxH.Value d = Me.TextBoxd.Value t1 = Me.TextBoxt1.Value B1 = Me.TextBoxB1.Value t2 = Me.TextBoxt2.Value B2 = Me.TextBoxB2.Value Rem tekenen doorsnede If Me.OptionButtondoorsnede = True Then Me.Hide Insert = ThisDrawing.Utility.GetPoint(, "geef invoegpunt: ") If Me.Imagerechtsonder.Visible = True Then Insert(0) = Insert(0) - B2 End If If Me.Imagemiddenonder.Visible = True Then Insert(0) = Insert(0) - (B2 / 2) End If Dim plijn As AcadPolyline Dim Pl1(0 To 14) As Double Rem punt a Pl1(0) = Insert(0) Pl1(1) = Insert(1) Pl1(2) = Insert(2) Rem punt b Pl1(3) = Pl1(0) + B2 Pl1(4) = Pl1(1) Pl1(5) = Pl1(2) Rem punt c Pl1(6) = Pl1(3) Pl1(7) = Pl1(4) + t2 Pl1(8) = Pl1(2)

Rem punt d Pl1(9) = Pl1(0) Pl1(10) = Pl1(1) + t2 Pl1(11) = Pl1(2) Rem punt a Pl1(12) = Pl1(0) Pl1(13) = Pl1(1) Pl1(14) = Pl1(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl1) Dim pl2(0 To 14) As Double Rem punt e pl2(0) = ((Insert(0) + Pl1(3)) / 2) + ((B1) / 2) pl2(1) = Pl1(7) pl2(2) = Pl1(2) Rem punt f pl2(3) = pl2(0) + d pl2(4) = pl2(1) pl2(5) = Pl1(2) Rem punt g pl2(6) = pl2(3) pl2(7) = pl2(4) + H pl2(8) = Pl1(2) Rem punt h pl2(9) = pl2(0) pl2(10) = pl2(1) + H pl2(11) = Pl1(2) Rem punt e pl2(12) = pl2(0) pl2(13) = pl2(1) pl2(14) = pl2(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(pl2) Dim pl3(0 To 14) As Double Rem punt i pl3(0) = pl2(0) - B1 - d pl3(1) = pl2(1) pl3(2) = pl2(1) Rem punt j pl3(3) = pl3(0) + d pl3(4) = pl3(1) pl3(5) = pl3(2) Rem punt k pl3(6) = pl3(3) pl3(7) = pl2(10) pl3(8) = pl3(2) Rem punt l pl3(9) = pl3(0) pl3(10) = pl3(7) pl3(11) = pl3(2) Rem punt i pl3(12) = pl3(0) pl3(13) = pl3(1) pl3(14) = pl3(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(pl3) Dim pl4(0 To 14) As Double Rem punt m pl4(0) = pl3(6) pl4(1) = pl3(7) - t1 pl4(2) = pl3(2) Rem punt n pl4(3) = pl2(9) pl4(4) = pl2(10) - t1 pl4(5) = pl4(2) Rem punt o pl4(6) = pl2(9) pl4(7) = pl2(10) pl4(8) = pl2(11) Rem punt p pl4(9) = pl3(6) pl4(10) = pl3(7) pl4(11) = pl3(8)

Rem punt m pl4(12) = pl4(0) pl4(13) = pl4(1) pl4(14) = pl4(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(pl4) plijn.Update End If Rem tekenen bovenaanzicht If Me.OptionButtonbovenaanzicht.Value = True Then Set prof35 = ThisDrawing.Layers.Add(Me.ComboBoxLaagBA.Value) prof35.Color = acByLayer ThisDrawing.ActiveLayer = prof35 If Me.TextBoxLengte.Enabled = True Then lengte = Me.TextBoxLengte.Value End If Me.Hide Insert = ThisDrawing.Utility.GetPoint(, "geef invoegpunt: ") If Me.ImageLinksonder.Visible = True Then Insert(1) = Insert(1) - B2 End If If Me.Imagemiddenonder.Visible = True Then Insert(1) = Insert(1) - (B2 / 2) End If Dim Pl5(0 To 14) As Double Rem punt a Pl5(0) = Insert(0) Pl5(1) = Insert(1) Pl5(2) = Insert(2) Rem punt b Pl5(3) = Pl5(0) + lengte Pl5(4) = Pl5(1) Pl5(5) = Pl5(2) Rem punt c Pl5(6) = Pl5(3) Pl5(7) = Pl5(4) + B2 Pl5(8) = Pl5(2) Rem punt d Pl5(9) = Pl5(0) Pl5(10) = Pl5(1) + B2 Pl5(11) = Pl5(2) Rem punt a Pl5(12) = Pl5(0) Pl5(13) = Pl5(1) Pl5(14) = Pl5(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl5) Dim Pl6(0 To 14) As Double Rem punt e Pl6(0) = Pl5(0) Pl6(1) = (Pl5(1) + ((B2 / 2) - (B1 / 2)) - d) Pl6(2) = Pl5(2) Rem punt f Pl6(3) = Pl6(0) + lengte Pl6(4) = Pl6(1) Pl6(5) = Pl6(2) Rem punt g Pl6(6) = Pl6(3) Pl6(7) = Pl6(4) + d Pl6(8) = Pl6(5) Rem punt h Pl6(9) = Pl6(0) Pl6(10) = Pl6(1) + d Pl6(11) = Pl6(8)

Rem punt e Pl6(12) = Pl6(0) Pl6(13) = Pl6(1) Pl6(14) = Pl6(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl6) Dim Pl7(0 To Rem punt i Pl7(0) = Pl7(1) = Pl7(2) =

14) As Double Pl6(0) (Pl6(1) + d + B1) Pl6(2)

Rem punt j Pl7(3) = Pl7(0) + lengte Pl7(4) = Pl7(1) Pl7(5) = Pl7(2) Rem punt k Pl7(6) = Pl7(3) Pl7(7) = Pl7(4) + d Pl7(8) = Pl7(5) Rem punt L Pl7(9) = Pl7(0) Pl7(10) = Pl7(1) + d Pl7(11) = Pl7(8) Rem punt i Pl7(12) = Pl7(0) Pl7(13) = Pl7(1) Pl7(14) = Pl7(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl7) End If Rem tekenen vooraanzicht If Me.OptionButtonvooraanzicht.Value = True Then Set prof35 = ThisDrawing.Layers.Add(Me.ComboBoxLaagBA.Value) prof35.Color = acByLayer ThisDrawing.ActiveLayer = prof35 If Me.TextBoxLengte.Enabled = True Then lengte = Me.TextBoxLengte.Value End If Me.Hide Insert = ThisDrawing.Utility.GetPoint(, "geef invoegpunt: ") Dim Pl8(0 To 14) As Double Rem punt a Pl8(0) = Insert(0) Pl8(1) = Insert(1) Pl8(2) = Insert(2) Rem punt b Pl8(3) = Pl8(0) + lengte Pl8(4) = Pl8(1) Pl8(5) = Pl8(2) Rem punt c Pl8(6) = Pl8(3) Pl8(7) = Pl8(4) + t2 Pl8(8) = Pl8(5) Rem punt d Pl8(9) = Pl8(0) Pl8(10) = Pl8(1) + t2 Pl8(11) = Pl8(8)

Rem punt a Pl8(12) = Pl8(0) Pl8(13) = Pl8(1) Pl8(14) = Pl8(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl8) Dim Pl9(0 To 14) As Double Rem punt e Pl9(0) = Pl8(9) Pl9(1) = Pl8(10) Pl9(2) = Pl8(11) Rem punt f Pl9(3) = Pl8(6) Pl9(4) = Pl8(7) Pl9(5) = Pl8(8) Rem punt g Pl9(6) = Pl9(3) Pl9(7) = Pl9(4) + H Pl9(8) = Pl9(5) Rem punt h Pl9(9) = Pl9(0) Pl9(10) = Pl9(1) + H Pl9(11) = Pl9(2) Rem punt e Pl9(12) = Pl9(0) Pl9(13) = Pl9(1) Pl9(14) = Pl9(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl9) Dim profhid As AcadLayer Set profhid = ThisDrawing.Layers.Add(Me.ComboBoxLaagVB.Value) profhid.Color = acByLayer

ThisDrawing.ActiveLayer = profhid Dim Pl10(0 To 14) As Double Rem punt i Pl10(0) = Pl9(9) Pl10(1) = Pl9(10) - t1 Pl10(2) = Pl9(11) Rem punt j Pl10(3) = Pl10(0) + lengte Pl10(4) = Pl10(1) Pl10(5) = Pl10(2) Rem punt k Pl10(6) = Pl10(3) Pl10(7) = Pl10(4) + t1 Pl10(8) = Pl10(5) Rem punt l Pl10(9) = Pl10(0) Pl10(10) = Pl10(1) + t1 Pl10(11) = Pl10(2) Rem punt i Pl10(12) = Pl10(0) Pl10(13) = Pl10(1) Pl10(14) = Pl10(2) Set plijn = ThisDrawing.ModelSpace.AddPolyline(Pl10) End If

Rem tekst Set proftxt = ThisDrawing.Layers.Add("proftxt") proftxt.Color = acYellow ThisDrawing.ActiveLayer = proftxt Dim Dim Dim Dim

textobj As AcadText textstring As String insertionpoint(0 To 2) As Double height As Double

Rem tekst bij doorsnede If Me.OptionButtondoorsnede.Value = True Then If Me.CheckBoxTekstplaatsen.Value = True Then insertionpoint(0) = (pl4(6) + pl4(9)) / 2 insertionpoint(1) = pl4(10) + (ThisDrawing.GetVariable("dimscale")) insertionpoint(2) = pl4(2) height = 3.5 * (ThisDrawing.GetVariable("dimscale")) textstring = "HQ " & Me.LabelH & "x" & Me.Labeld & "-" & Me.Labelt1 & "x" & Me.LabelB1 & "-" & Me.Labelt2 & "x" & Me.LabelB2 Set textobj = ThisDrawing.ModelSpace.AddText(textstring, insertionpoint, height) Dim alignmentPoint(0 To 2) As Double alignmentPoint(0) = insertionpoint(0): alignmentPoint(1) = insertionpoint(1): alignmentPoint(2) = insertionpoint(2) textobj.Alignment = acAlignmentBottomCenter textobj.TextAlignmentPoint = alignmentPoint textobj.Update p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 5 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If Rem geen tekst bij doorsnede If Me.CheckBoxTekstplaatsen.Value = False Then p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 4 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If End If Rem tekst bij bovenaanzicht If Me.OptionButtonbovenaanzicht.Value If Me.CheckBoxTekstplaatsen.Value insertionpoint(0) = (Pl5(6) + insertionpoint(1) = Pl5(10) + insertionpoint(2) = Pl5(2)

= True Then = True Then Pl5(9)) / 2 (ThisDrawing.GetVariable("dimscale"))

height = 3.5 * (ThisDrawing.GetVariable("dimscale")) textstring = "HQ " & Me.LabelH & "x" & Me.Labeld & "-" & Me.Labelt1 & "x" & Me.LabelB1 & "-" & Me.Labelt2 & "x" & Me.LabelB2 Set textobj = ThisDrawing.ModelSpace.AddText(textstring, insertionpoint, height) alignmentPoint(0) = insertionpoint(0): alignmentPoint(1) = insertionpoint(1): alignmentPoint(2) = insertionpoint(2) textobj.Alignment = acAlignmentBottomCenter textobj.TextAlignmentPoint = alignmentPoint textobj.Update p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 4 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If

Rem geen tekst plaatsen bij bovenaanzicht If Me.CheckBoxTekstplaatsen.Value = False Then p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 3 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If End If Rem tekst plaatsen bij vooraanzicht If Me.OptionButtonvooraanzicht.Value = True Then If Me.CheckBoxTekstplaatsen.Value = True Then insertionpoint(0) = (Pl10(6) + Pl10(9)) / 2 insertionpoint(1) = Pl10(10) + (ThisDrawing.GetVariable("dimscale")) insertionpoint(2) = Pl10(2) height = 3.5 * (ThisDrawing.GetVariable("dimscale")) textstring = "HQ " & Me.LabelH & "x" & Me.Labeld & "-" & Me.Labelt1 & "x" & Me.LabelB1 & "-" & Me.Labelt2 & "x" & Me.LabelB2 Set textobj = ThisDrawing.ModelSpace.AddText(textstring, insertionpoint, height) alignmentPoint(0) = insertionpoint(0): alignmentPoint(1) = insertionpoint(1): alignmentPoint(2) = insertionpoint(2) textobj.Alignment = acAlignmentBottomCenter textobj.TextAlignmentPoint = alignmentPoint textobj.Update p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 4 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If Rem geen tekst plaatsen bij vooraanzicht If Me.CheckBoxTekstplaatsen.Value = False Then p1 = ThisDrawing.Utility.GetPoint(, "geef het draaipunt: ") p2 = ThisDrawing.Utility.GetOrientation(p1, "welke richting: ") For i = ThisDrawing.ModelSpace.Count - 3 To ThisDrawing.ModelSpace.Count Call ThisDrawing.ModelSpace.Item(i).Rotate(p1, p2) Next i End If End If foutafhandeling: Call Err.Clear ThisDrawing.ActiveLayer = q Me.TextBoxLengte.Enabled = True End Sub Rem anuleren Private Sub CommandButtonAnnuleren_Click() Me.Hide End Sub Rem koppeling naar word Private Sub CommandButtonHelp_Click() Dim w As Word.Application Set w = CreateObject("Word.application") w.Visible = True w.Documents.Open ("C:\CURSUS\help.doc") End Sub Rem waarden tekstboxen bij gebruik herstel Private Sub CommandButtonHerstel_Click() Me.TextBoxH.Value = "H" Me.TextBoxd.Value = "d" Me.TextBoxt1.Value = "t1" Me.TextBoxB1.Value = "B1" Me.TextBoxt2.Value = "t2" Me.TextBoxB2.Value = "B2" End Sub

Rem invoegpunt linksonder zichtbaar maken door te klikken in image Private Sub Imagelinksonderzonder_Click() Me.ImageLinksonder.Visible = True Me.Imagemiddenonder.Visible = False Me.Imagerechtsonder.Visible = False Me.Imagelinksonderzonder.Visible = False Me.Imagemiddenonderzonder.Visible = True Me.Imagerechtsonderzonder.Visible = True End Sub Rem invoegpunt middenonder zichtbaar maken door te klikken in image Private Sub Imagemiddenonderzonder_Click() Me.ImageLinksonder.Visible = False Me.Imagemiddenonder.Visible = True Me.Imagerechtsonder.Visible = False Me.Imagemiddenonderzonder.Visible = False Me.Imagelinksonderzonder.Visible = True Me.Imagerechtsonderzonder.Visible = True

End Sub Rem invoegpunt rechtsonder zichtbaar maken door te klikken in image Private Sub Imagerechtsonderzonder_Click() Me.ImageLinksonder.Visible = False Me.Imagemiddenonder.Visible = False Me.Imagerechtsonder.Visible = True Me.Imagerechtsonderzonder.Visible = False Me.Imagelinksonderzonder.Visible = True Me.Imagemiddenonderzonder.Visible = True End Sub Rem achtergrondkleur tekstboxen bij doorsnede Private Sub OptionButtondoorsnede_Click() If Me.OptionButtondoorsnede.Value = True Then Me.TextBoxH.BackColor = &H80000005 Me.TextBoxd.BackColor = &H80000005 Me.TextBoxt1.BackColor = &H80000005 Me.TextBoxB1.BackColor = &H80000005 Me.TextBoxt2.BackColor = &H80000005 Me.TextBoxB2.BackColor = &H80000005 Me.FrameLengte.Enabled = False Me.TextBoxLengte.Enabled = False Me.CommandButtonPick.Enabled = False End If End Sub Rem achtergrondkleur tekstboxen bij bovenaanzicht Private Sub OptionButtonbovenaanzicht_Click() If Me.OptionButtonbovenaanzicht = True Then Me.TextBoxH.BackColor = &H8000000B Me.TextBoxd.BackColor = &H80000005 Me.TextBoxt1.BackColor = &H8000000B Me.TextBoxB1.BackColor = &H80000005 Me.TextBoxt2.BackColor = &H8000000B Me.TextBoxB2.BackColor = &H80000005 Me.TextBoxLengte.BackColor = &H80000005 Me.FrameLengte.Enabled = True Me.TextBoxLengte.Enabled = True Me.CommandButtonPick.Enabled = True Me.TextBoxLengte.ForeColor = &H80000008 Me.TextBoxLengte.BackColor = &H80000005 End If End Sub

Rem achtergrondkleur tekstboxen bij vooraanzicht Private Sub OptionButtonvooraanzicht_Click() If Me.OptionButtonvooraanzicht.Value = True Then Me.TextBoxH.BackColor = &H80000005 Me.TextBoxd.BackColor = &H8000000B Me.TextBoxt1.BackColor = &H80000005 Me.TextBoxB1.BackColor = &H8000000B Me.TextBoxt2.BackColor = &H80000005 Me.TextBoxB2.BackColor = &H8000000B Me.TextBoxLengte.BackColor = &H80000005 Me.FrameLengte.Enabled = True Me.TextBoxLengte.Enabled = True Me.CommandButtonPick.Enabled = True Me.TextBoxLengte.ForeColor = &H80000008 Me.TextBoxLengte.BackColor = &H80000005 End If End Sub Rem waardes textboxen naar image Private Sub TextBoxH_Change() Me.TextBoxH.BackColor = &H80000005 Me.LabelH.Caption = Me.TextBoxH.Value If Me.OptionButtonbovenaanzicht.Value = True Then Me.TextBoxH.BackColor = &H8000000B End If End Sub Private Sub TextBoxd_Change() Me.TextBoxd.BackColor = &H80000005 Me.Labeld.Caption = Me.TextBoxd.Value If Me.OptionButtonvooraanzicht.Value = True Then Me.TextBoxd.BackColor = &H8000000B End If End Sub Private Sub TextBoxt1_Change() Me.TextBoxt1.BackColor = &H80000005 Me.Labelt1.Caption = Me.TextBoxt1.Value If Me.OptionButtonbovenaanzicht.Value = True Then Me.TextBoxt1.BackColor = &H8000000B End If End Sub Private Sub TextBoxB1_Change() Me.TextBoxB1.BackColor = &H80000005 Me.LabelB1.Caption = Me.TextBoxB1.Value If Me.OptionButtonvooraanzicht.Value = True Then Me.TextBoxB1.BackColor = &H8000000B End If End Sub Private Sub TextBoxt2_Change() Me.TextBoxt2.BackColor = &H80000005 Me.Labelt2.Caption = Me.TextBoxt2.Value If Me.OptionButtonbovenaanzicht.Value = True Then Me.TextBoxt2.BackColor = &H8000000B End If End Sub Private Sub TextBoxB2_Change() Me.TextBoxB2.BackColor = &H80000005 Me.LabelB2.Caption = Me.TextBoxB2.Value If Me.OptionButtonvooraanzicht.Value = True Then Me.TextBoxB2.BackColor = &H8000000B End If End Sub

Rem waardes van textboxen vanuit combobox Private Sub TextBoxH_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Private Sub TextBoxd_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Private Sub TextBoxt1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Private Sub TextBoxB1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Private Sub TextBoxt2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Private Sub TextBoxB2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.ComboBoxProfiel.Value = "" End Sub Rem oplichten van waardes in image Private Sub TextBoxH_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = vbYellow Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub Private Sub TextBoxd_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = vbYellow Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub Private Sub TextBoxt1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = vbYellow Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub Private Sub TextBoxB1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = vbYellow Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = &H80000004 End Sub Private Sub TextBoxt2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = vbYellow Me.LabelB2.BackColor = &H80000004 End Sub

Private Sub TextBoxB2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.LabelH.BackColor = &H80000004 Me.Labeld.BackColor = &H80000004 Me.Labelt1.BackColor = &H80000004 Me.LabelB1.BackColor = &H80000004 Me.Labelt2.BackColor = &H80000004 Me.LabelB2.BackColor = vbYellow End Sub Private Sub TextBoxLengte_Change() Me.TextBoxLengte.BackColor = vbWhite Me.TextBoxLengte.ForeColor = vbBlack End Sub Private Sub UserForm_Initialize() Me.Width = 444 Rem koppeling maken met excel Dim X As Excel.Application Set X = CreateObject("Excel.application") Rem X.Visible = True Dim doc As Workbook Dim tabblad As Worksheet Dim cel As Range ReDim Preserve a(1 To 7, 1 To 1) Set doc = X.Workbooks.Open("C:\CURSUS\hq-lijst") Set tabblad = doc.Sheets.Item("hq") Do i = i + 1 ReDim Preserve a(1 To 7, 1 To i) For j = 1 To 7 a(j, i) = tabblad.Cells(i, j) If j = 1 Then naam = a(j, i) Else naam = naam & "-" & a(j, i) End If Next j Me.ComboBoxProfiel.AddItem (naam) naam = "" Loop While tabblad.Cells(i + 1, 1) <> "" Me.ComboBoxProfiel.ListIndex = 0 X.Quit Set X = Nothing Rem Dim Dim For

waarden combobox tbv lagen b() c() Each laag In ThisDrawing.Layers

ReDim Preserve b(0 To 1, 0 To Y) b(0, Y) = laag.Name b(1, Y) = laag.Color Y = Y + 1 Next laag ReDim c(0 To Y - 1, 0 To 1) For j = 0 To Y - 1 c(j, 0) = b(0, j) c(j, 1) = b(1, j) Next j Me.ComboBoxLaagDSN.List = c Me.ComboBoxLaagBA.List = c Me.ComboBoxLaagVB.List = c End Sub