opvragen oppervlaktes en lengtes
Pagina 1 van 39
Titel:
Opvragen van oppervlaktes en lengtes.
Ondertitel:
Het totaliseren van oppervlaktes van verschillende vlakken, het totaliseren van lengtes van verschillende lijnstukken en het bepalen kadastrale oppervlaktes.
Opgesteld door:
Annelies de Vos
Datum :
12 mei 2003
Instituut:
CADCollege Nijmegen
Studierichting:
Autocad system manager
Begeleidend docent:
ir. R. Boeklagen
Bedrijf:
Provincie Zuid–Holland
Afdeling:
Beheerstrategie/Geo-informatie
Pagina 2 van 39
Voorwoord Dit rapport is een afstudeeropdracht in het kader van het eindexamen voor Autocad system manager.
De opdracht is gedeeltelijk uitgevoerd bij het bureau Geo-informatie van de Provincie Zuid–Holland te Den Haag. Dit omdat er duidelijk behoefte was aan deze tool.
Bij deze wil ik tevens de mensen bedanken die mij begeleid en geholpen hebben bij deze studie.
2003, Annelies de Vos
Pagina 3 van 39
Inhoudsopgave Voorwoord ..................................................................... 3 Inhoudsopgave .............................................................. 4 Organisatie .................................................................... 5 Omschrijving kaartmateriaal .................................................................7
Aanleiding voor de opdracht .......................................... 9 Huidige werkwijze.................................................................................9 Probleembeschrijving ......................................................................... 10 Doel.................................................................................................... 10
Mogelijke oplossingen ..................................................11 Nieuwe werkwijze ............................................................................... 12
Werking programma .....................................................13 Programmaonderdeel lengtes............................................................. 13 Programmaonderdeel oppervlaktes.................................................... 17 Programmaonderdeel kadastrale oppervlakte .................................... 20
Conclusie......................................................................23 Installatie handleiding ...................................................24 Bijlagen.........................................................................27 De code van de verschillende programma onderdelen ...................... 27 Verschillende tekeningen.................................................................... 36 Totaal tekening situatie, grenzen, wegvakken, asfaltvlakken. ............................ 37 Verkooptekening................................................................................................. 38 Aktetekening....................................................................................................... 39
Pagina 4 van 39
Organisatie De Provincie Zuid-Holland telt ruim 2000 medewerkers, onderverdeeld in vier directies. De directie waarbij ik werkzaam ben is de Directie Ruimte en Mobiliteit. In deze directie is een aparte dienst gevormd, de Dienst Beheer Infrasructuur. Taakopdracht
voor
de
Dienst
Beheer
Infrastructuur:
beheersplannen,
instandhoudingsplannen meerjarenprogramma's onderhoud, ontwerp en advies, gegevensbeheer
areaal,
uitvoeren
onderhoudprogramma's,
dagelijks
beheer
infrastructuur, het beheer en onderhoud van tunnels, bruggen, provinciale wegennet, provinciale vaarwegennet, verkeersinstallaties en openbare verlichting langs provinciale wegen e.d.
ORGANIGRAM DIENST BEHEER EN INFRASTRUCTUUR DIRECTEUR DBI CONTROLLER
PLV DIRECTEUR
EENHEID AANBESTEDING
BUREAU ONDERSTEUNING
EENHEID SPECAILISTISCH ONDERHOUD
DISTRICTEN (STEDELIJK GEBIED LANDELIJK GEBIED)
AFD. BEHEER STRATEGIE
Bur. Beheer en Verkeer
Bur. Beheer Advies
Bur. Onderhoud en Verbetering
Bur. GEO-informatie
Bur. Bedrijfsvoering
Sectie Juridisch beheer
Sectie Binnendienst Sectie Landmeetkunde Sectie Gegevensbeheer Pagina 5 van 39
Zelf ben ik werkzaam, sinds 1991 bij de afdeling Beheerstrategie binnen het bureau Geo-informatie het vroegere bureau Landmeetkunde, als systeembeheerder van de pakketten AUTOCAD, TOPOCAD, Automanager Teamwork, Arcview-systeem en Vastgoedsysteem. Daarnaast eerste lijnsondersteuning AUTOCAD voor de sectie binnendienst en de twee tekenaars in de districten, het uitvoeren van het berekenen van grondslag en GPS puntsbepaling, en bijzonder tekenwerk.
ORGANIGRAM BUREAU GEO-INFORMATIE
BUREAUHOOFD
Systeembeheerder
Sectie Binnendienst
Sectiehoofd Sr. medewerker CAD Sr. medewerker Vastgoed Vastgoed CADoperator
Sectie Landmeetkunde Sectiehoofd
Sectie Gegevensbeheer Sectiehoofd
Landmeetkundige
Medewerker GIS
Chefmeetploeg (6x)
Gegevensbeheer (2x)
Landmeetkundig opnemer (5x)
Medewerker opmaak wegenlegger Medewerker invoer wegenlegger
Landmeetkundig CAD-operator(2x)
Pagina 6 van 39
Omschrijving kaartmateriaal De provincie is verantwoordelijk voor het beheer en onderhoud van de provinciale wegen en vaarwegen, met de daarbij behorende wegmeubilair, bomen en struiken en andere groenvoorziening, verderop samengevat als areaalgegevens. Mede daarom worden alle provinciale wegen zeer gedetailleerd opgemeten. Er lopen 5 meetploegen buiten verdeeld over de gehele provincie. Daarna worden alle kadastrale grenzen toegevoegd aan de ingemeten situatie. Deze kadastrale grenzen worden vanuit de kadastrale veldwerken gekaarteerd, als SUF-bestand aangeschaft bij het kadaster of gedigitaliseerd van polyesters waarop in het verleden de grenzen op gekaarteerd zijn. Later worden vanuit de districten de onderhoudgrenzen toegevoegd. Omdat deze niet samen hoeven te lopen met de kadastrale grenzen, worden deze in een apart bestand bewaard. De lagenindeling in de tekening is zo gemaakt dat alle objecten een aparte laag hebben. Dit om de gegevens makkelijker te beheren. Dit houdt tevens in dat er per tekening een kleine 100 lagen aanwezig kunnen zijn, dit komt doordat er onderscheid gemaakt wordt in de laagaanduiding hoe de lijnen tot stand gekomen zijn bijv. Terrestrisch gemeten (met tachymeter), fotogrammetrisch (uit luchtfotografie) of gedigitaliseerd. Door de sectie gegevensbeheer worden in overleg met de districten de wegvakken gedefinieerd en als gesloten polylines in de tekening gezet. Binnen die wegvakken worden er gesloten polylines gevormd van de soort wegverharding, groenstroken enz. Er is voor gekozen om zowel de wegvakken met de vakaanduiding in een apart bestand te zetten als de gesloten polylines van de wegverharding, groenstroken t.b.v. areaalgegevens in een apart bestand te zetten. Er ontstaan dus 4 bestanden, die met de situatie en de kadastrale grenzen, de onderhoudsgrenzen, wegvakken met vakaanduiding en een bestand t.b.v. areaalgegevens. Deze bestanden zijn zo uitgesplitst omdat de sectie binnendienst verantwoordelijk is voor de situatie en de kadastrale grenzen, de districten zijn verantwoordelijk voor de onderhoudgrenzen en de sectie gegevensbeheer voor de wegvakken en de areaalgegevens. Bij het opvragen van oppervlaktes en lengtes wordt er gebruik gemaakt van het bestand
Pagina 7 van 39
met areaalgegevens met daar achter als Xref het bestand met de wegvakken. Het werken met Xref's heeft ook als grote voordeel dat in het bestand makkelijker gewerkt kan worden, omdat er anders te veel infornatie in een bestand staat, vooral het ingemeten bestand heeft zoveel informatie dat de wegvakken en de polylines voor de areaalgegevens nog nauwelijks zichtbaar zijn. Voor het maken van aan- en verkooptekeningen wordt ook een apart bestand aangemaakt, hier wordt gebruik gemaakt van een gedeelte van het bestand met de situatie en de kadastrale grenzen, deze wordt niet als Xref gebruikt maar als bestand geïnsert. Omdat er afspraken zijn gemaakt over de situatie en grenzen moet deze blijven bestaan.
Pagina 8 van 39
Aanleiding voor de opdracht Deze afstudeeropdracht heb ik gekozen, omdat voor het nieuw op te zetten project areaalgegevens alle gegevens binnen een wegvak geïnventariseerd moeten worden. Zoals bijvoorbeeld de hoeveelheid asfalt of tegels dat er binnen een wegvak is. Als in de toekomst de wegbeheerder, de districten, de vraag stelt hoeveel meter geleiderail er langs een bepaalde weg staat of hoeveel vierkante meters asfalt, klinkers of andere verhardingen er in een bepaalde wegvak ligt, daar antwoord op gegeven kan worden in verband met het maken van een bestek. De wegen worden in vakken ingedeeld door de wegbeheerder. In deze wegvakken worden per verhardingssoort gesloten vakken gemaakt. Dit gebeurd met het programma TOPOCAD (een ARX-applicatie binnen AUTOCAD), van de firma Nedgraphics. Eerst worden de wegen gesegmenteerd van knooppunt tot knooppunt daarna geoptimaliseerd waardoor er gesloten vlakken ontstaan. Thans is er geen goede mogelijkheid om de oppervlaktes op te vragen en te totaliseren. Per verhardingssoort is een aparte laag aangemaakt waar de vlakken in staan. Op dit moment zijn alleen de asfaltvlakken, van een aantal wegen gedefiniëerd, omdat dit voor de meeste bestekken het belangrijkste is en aan de rest wordt druk gewerkt.
Huidige werkwijze Het probleem nu is dat voor een geleiderail, (poly)lijn voor (poly)lijn aangewezen moet worden en opgeschreven moet worden wat de lengte is. Dit zijn allemaal losse (poly)lijnen, omdat de geleiderail in de provincie alleen wordt gebruikt bij onveilige situaties, bij bruggen, viaducten en andere kunstwerken. Ditzelfde geldt ook voor het opvragen van oppervlaktes, binnen een wegvak ontstaan allemaal losse vlakken, door bijv. drempels of verkeersdruppels in een andere verharding. De lengtes en oppervlaktes moeten stuk voor stuk worden opgeschreven en opgeteld. Ook komen er regelmatig vragen binnen voor het maken van aan- en
Pagina 9 van 39
verkooptekeningen, waarbij het aan- of te verkopen deel gearceerd dient te worden met
een
oppervlakte
tekst
daarin.
Deze
tekeningen
worden
later
bij
de
overdrachtsakte gevoegd als aktetekening. Hierbij gaat het meestal om één of twee oppervlaktes. De tekst van de oppervlakte en de arcering blijven in de tekening bestaan, omdat het kan zijn dat de aan- of verkoopprocedure lange tijd in beslag kan nemen en er eerst met alle partijen overeenstemming bereikt dient te zijn.
Probleembeschrijving Het opvragen van lengtes en oppervlaktes vergen heel veel tijd en schrijf- en optelfouten zijn zo gemaakt. Doordat het zoveel tijd vergt, worden de gegevens ook vaak opgemeten vanaf tekening wat tot grote onnauwkeurigheid leidt. Het maken van aan- en verkooptekeningen vergt vele handelingen, van het maken van een boundary in het aangegeven gebied met het arceren met het plaatsen van een tekst wat de oppervlakte is, hierbij ook weer de kans op schrijffouten. Daarna moet het aan of te verkopen gedeelte gearceerd worden.
Doel Doel van deze eindopdracht is het vergemakkelijken van het opvragen en totaliseren van oppervlaktes of lengtes uit de tekening, en het maken van aan- en verkooptekeningen, zodat dit sneller verloopt en dat de kans op het maken van fouten kleiner wordt.
Pagina 10 van 39
Mogelijke oplossingen Met behulp van een te schrijven programma in VBA zal dat optellen van lengtes of oppervlaktes automatisch moeten gebeuren, zodat fouten nog nauwelijks gemaakt kunnen worden. Er waren drie mogelijke manieren om het VBA programma op te starten:
De drie tools die in het VBA programma zitten, in een toolbar zetten. Hier is niet voor gekozen omdat door de aanwezigheid van andere applicaties binnen Autocad er anders teveel toolbar's op het beeld zouden komen te staan.
Een formulier aanmaken en daar de drie tools via een button laten opstarten. Dit vonden degene die met het programma moeten werken niet prettig.
Er is voor gekozen om deze module, waar deze drie tools inzitten onder het pulldownmenu EIGEN te zetten, omdat hier nog meer utilities staan die niet standaard in Autocad of de andere aangekochte programma's zitten, meestal zijn het scriptfiles die gebruik maken van TOPOCAD en Automanager Workflow. Hier staan ook scriptfiles in voor het aan- of uitzetten van lagen om het plotten van verschillende tekeningen makkelijker te maken.
Pagina 11 van 39
Wat ook een groot voordeel was om het in het menu EIGEN op te nemen dat met VBARUN het programma automatisch wordt opgestart.
Nieuwe werkwijze De gebruiker hoeft alleen nog de lijn of de vlakken aan te wijzen en de afstanden of oppervlaktes worden automatisch opgeteld, dit bij het opvragen van totale van oppervlaktes en lengtes. Er is voor gekozen dat de CAD-operator zelf de laag aanzet waar de oppervlakte of de lengte van bepaald dient te worden, omdat deze lagen structuur zeer goed bekend is bij hem of haar.
Bij het aanmaken van aan- en verkooptekeningen moet er een punt aangewezen worden in het aan te kopen of te verkopen stuk. Er word dan automatisch een boundary gemaakt, op datzelfde punt wordt dan ook de oppervlakte afgerond op hele m2 geïnsert en de boundary wordt tevens gearceerd. Zowel de arcering en de oppervlaktetekst dienen in de goede laag geplaatst te worden, dit moet worden opgevangen in het programma.
Pagina 12 van 39
Werking programma De module OPVRAGEN die is aangemaakt bevat eigenlijk vier programmaonderdelen, opvragen lengtes, opvragen oppervlaktes en kadastrale oppervlakte . De beschrijving die volgt is van de drie onderdelen die in de module voorkomen.
Programmaonderdeel lengtes start
Selectie objecten
Aantal objecten
ja polyline
explode
Aantal elementen
nee Lijn- en arclengtes optellen
ja Lijn, arc, cirkel
Optellen lengtes
nee nee Andere objecten
nee
ja
Foutmelding in messagebox
Elementen gehad
ja
Alle objecten gehad
nee
ja Totaal lijn, arc en cirkel
Totaal lengte polyline
ja Totaal lengtes messagebox en klembord
Stroomdiagram opvragen lengtes Pagina 13 van 39
Het programma wordt opgestart. Op de commandregel wordt er gevraagd om een aantal objecten te selecteren. Hiervan worden de lengtes bij elkaar opgeteld en in een messagebox weergegeven, in meters met twee cijfers achter de komma.
Voor de objecten die geen lengte hebben, bijvoorbeeld een tekst, wordt er een foutmelding op het beeldscherm getoond.
Pagina 14 van 39
Van de overige objecten worden de lengtes bij elkaar opgeteld. De totale lengte die wordt gevonden, wordt tevens naar het klembord gekopieerd. Dit zodat het in het desgewenste document, bijv. Word, Acces of Excel gekopieerd kan worden.
Bij het testen bleek dat een cirkelboog, een arclength heeft en een cirkel, een circumference heeft. Het grootste probleem was echter dat (lw)polylines geen lengte bevatten. Dit wordt opgevangen door de (lw)polylines eerst te exploderen, zodat er losse lijnstukken of cirkelbogen ontstaan. De lengtes van de losse delen kunnen er wel bij opgeteld worden. Case obj.ObjectName = "AcDbPolyline" Set element = obj aantalElementenBegin = ThisDrawing.ModelSpace.Count element.Explode aantalElementenEind = ThisDrawing.ModelSpace.Count - 1 For nr = aantalElementenBegin To aantalElementenEind Set e = ThisDrawing.ModelSpace.Item(aantalElementenBegin) If e.ObjectName = "AcDbArc" Then lengte = lengte + e.ArcLength If e.ObjectName = "AcDbLine" Then lengte = lengte + e.length e.Delete Next nr
Case obj.ObjectName = "AcDbArc" Set boog = obj lengte = lengte + boog.ArcLength Case obj.ObjectName = "AcDbLine" lengte = lengte + obj.length Case obj.ObjectName = "AcDbCircle" lengte = lengte + obj.Circumference
De originele (lw)polyline blijft overigens wel gewoon bestaan en de losse lijnstukken en cirkelbogen worden aan het eind van het programma gedeleted.
Pagina 15 van 39
In de module staat ook een programma, klembord, dat de waarde van de opgetelde lengtes naar het klembord kopieerd, deze wordt aangroepen in opvragen_lengte
Sub length() Dim l As String l = lengte MsgBox "Totale lengte van de geselekteerde objecten is: " & l & " m" Klembord.kopieer (l) End Sub
Pagina 16 van 39
Programmaonderdeel oppervlaktes
start
Selectie objecten
Aantal objecten
ja
Oppervlakte object berekenen
polyline
Gevonden waarde
nee Andere objecten
ja
Messagebox doorgaan
Nee
Programma stopt
ja nee
nee
Alle objecten gehad
ja Totaal oppervlaktes messagebox en klembord
Stroomdiagram opvragen oppervlaktes
Het programma wordt opgestart. Op de commandregel wordt er gevraagd om een aantal objecten te selecteren. Hiervan worden de oppervlaktes bij elkaar opgeteld en
Pagina 17 van 39
in een messagebox weergegeven, in meters met twee cijfers achter de komma.
Als er objecten in voorkomen die geen oppervlakte bevatten wordt er een foutmelding op het beeldscherm getoond, het object dat geen oppervlakte heeft wordt dan rood gekleurd en er wordt gevraagd of je wilt doorgaan ja of nee. Kies je voor nee dan wordt het programma gestopt .
Als je voor ja kiest worden de oppervlaktes van de objecten bij elkaar opgeteld en de kleur wordt weer teruggezet naar de orginele kleur, dit omdat je dan vindt dat dit object niet in deze selectie thuishoort. Kies je er voor dat het programma stopt, dan blijf het object rood gekleurd. Dit omdat je dan kunt onderzoeken wat er mis is gegaan.
Ook hier wordt de subroutine klembord gebruikt om de totale oppervlakte naar het klemboord te kopiëren.
Pagina 18 van 39
Kleur wordt veranderd omdat dit object geen oppervlakte bevat. If Err.Description = "Object doesn't support this property or method" Then orgkleur = ssOpp.Item(i - 1).Color ssOpp.Item(i - 1).Color = acRed ssOpp.Update
Melding dat er een object is dat geen oppervlakte heeft en of het programma moet doorgaan of niet. If MsgBox("object " & i & " wordt rood gekleurd" & " heeft geen oppervlakte." & vbCrLf & _ "De waarde kan niet bij de totale oppervlakte worden gevoegd, Wil je doorgaan?", vbYesNo, "Lisp to VBA") = vbYes Then
Kies je ervoor om door te gaan wordt de kleur weer naar de orginele kleur teruggezet.
Err.Clear ssOpp.Item(i - 1).Color = orgkleur ssOpp.Update Resume Next End If Else Debug.Print Err.Description ssOpp.Update
Pagina 19 van 39
Programmaonderdeel kadastrale oppervlakte start
Punt aanwijzen
Boundary
Oppervlakte bepalen
Plaatst waarde als tekst op aangewezen punt
Kader om tekst
Stroomdiagram opvragen Kadastrale oppervlaktes Arceren
Kader om tekst onzichtbaar maken
Einde
Het programma wordt opgestart. Op commandregel wordt gevraagd een punt op te geven. Dit moet een punt zijn in het vlak waar je de oppervlakte van wilt bepalen, ook wordt van dit opgegeven punt gebruik gemaakt om de oppervlakte als een tekst in het vlak te zetten. Van de (poly)lijnen wordt met behulp van het commando boundary een gesloten polyline om het vlak geplaatst, hiervan wordt de oppervlakte bepaald. De goede laag wordt aangezet, waarin de tekst moet staan, daarna wordt de tekst in
Pagina 20 van 39
het vlak geplaatst met een hoogte van 1 mm, dit omdat het leesbaar moet zijn op schaal 1: 500. De oppervlakte wordt afgerond op hele m2. Het vlak moet ook nog gearceerd worden, maar omdat de arcering niet door de tekst mag lopen, wordt eerst een minimum en een maximum punt van de tekst bepaald en deze wordt dan 0.1 mm verschoven. Op die punten wordt een rechthoek geplaatst.
Call T.GetBoundingBox(p0, p2) p0(0) = p0(0) - 0.1 p0(1) = p0(1) - 0.1 p2(0) = p2(0) + 0.1 p2(1) = p2(1) + 0.1
p1(0) = p2(0) p1(1) = p0(1) p3(0) = p0(0) p3(1) = p2(1) 'rechthoek plaatsen om de tekst heen Set l0 = ThisDrawing.ModelSpace.AddLine(p0, p1) Set l1 = ThisDrawing.ModelSpace.AddLine(p1, p2) Set l2 = ThisDrawing.ModelSpace.AddLine(p2, p3) Set l3 = ThisDrawing.ModelSpace.AddLine(p3, p0)
Dim grensBuiten(0 To 0) As AcadEntity Dim GrensBinnen(0 To 3) As AcadEntity Set grensBuiten(0) = laatste_element
Set GrensBinnen(0) = l0 Set GrensBinnen(1) = l1 Set GrensBinnen(2) = l2
Pagina 21 van 39
Set GrensBinnen(3) = l3
Dim TekstEnRechthoek(0 To 4) As AcadEntity Set TekstEnRechthoek(0) = T Set TekstEnRechthoek(1) = l0 Set TekstEnRechthoek(2) = l1 Set TekstEnRechthoek(3) = l2 Set TekstEnRechthoek(4) = l3
De laag wordt veranderd voor de te plaatsen arcering. De arcering wordt geplaatst in het gemaakte vlak met uitzondering van de rechthoek, die om de tekst geplaatst is. Deze rechthoek wordt daarna invisible gemaakt.
Pagina 22 van 39
Conclusie De nieuwe werkmethode levert voor het bureau Geo-informatie tijdwinst op, door dat het totaliseren van oppervlaktes en lengtes vele malen sneller gaat dan eerst het geval was. Ook is de kans op fouten drastisch afgenomen, ook omdat de waarde naar het klembord wordt gekopieerd en met plakken rechtstreeks in het bestek of in de areaal database geplaatst kan worden. Daar de informatie die vooraf wordt ingewonnen bij het maken van een bestek, nauwkeuriger is dan voorheen, is de prijs bepaling van een te maken werk ook veel nauwkeuriger. De tool is zo eenvoudig dat iedereen die Autocad tot zijn beschikking heeft deze kan gebruiken, zo blijft het opvragen van lengtes en oppervlaktes niet allen beperkt tot het bureau Geo-informatie, maar zouden ze in de beide districten ook deze tool kunnen hanteren.
Pagina 23 van 39
Installatie handleiding
Windows verkenner, De bestanden dienen vanaf de cd-rom gekopieerd te worden in een aan te maken te maken directory PZH; (C:\PZH);
De bestanden die gekopieerd worden van een cd-rom staan automatisch op “alleen lezen” d.m.v. de rechtermuisknop vervolgens eigenschappen, kunnen de afgevinkte eigenschappen “alleen lezen” per bestand uitgeschakeld worden. Dit is alleen nodig als je de bestanden wilt aanpassen. Bijv. in de MENU-file staan een pad waarvan de tool OPVRAGEN geladen wordt, als je dit pad wilt veranderen moet de eigenschap “alleen lezen” uitgeschakeld worden.
Pagina 24 van 39
Handelingen in AUTOCAD, In het pulldown menu Tools, options, tabblad file wordt in het support search path een verwijzing gemaakt naar de directory PZH.
Via het pulldown menu Tools, customize, menus dient met behulp van browse, load het menu EIGEN.mnu geladen te worden.
Pagina 25 van 39
Met behulp van het tabblad Menubar wordt het pulldown menu toegevoegd.
In het menu EIGEN staat een item OPVRAGEN LENGTES EN OPPERVLAKTES met daar achter de 3 opties, die wordt met VBARUN dan automatisch geladen.
Pagina 26 van 39
Bijlagen De code van de verschillende programma onderdelen "opvragen_lengte" Option Explicit
Public Function lengte() As Double 'variabelen Dim obj As AcadEntity 'Dim lengte As Double Dim i As Integer Dim prompt As String Dim sslengte As AcadSelectionSet Dim element As AcadLWPolyline Dim boog As AcadArc Dim aantalElementenBegin As Long Dim aantalElementenEind As Long Dim kleur As AcadLayer Dim e As AcadEntity Dim nr As Long
lengte = 0 ' regel prompt = "de totale lengte in m van de geselekteerde objecten is:" i=1 On Error Resume Next ThisDrawing.SelectionSets.Item("lengtes").Delete On Error GoTo 0 Set sslengte = ThisDrawing.SelectionSets.Add("lengtes")
Pagina 27 van 39
'selecteren sslengte.SelectOnScreen
'optelling For Each obj In sslengte
Select Case True
Case obj.ObjectName = "AcDbPolyline" Set element = obj aantalElementenBegin = ThisDrawing.ModelSpace.Count element.Explode aantalElementenEind = ThisDrawing.ModelSpace.Count - 1 For nr = aantalElementenBegin To aantalElementenEind Set e = ThisDrawing.ModelSpace.Item(aantalElementenBegin) If e.ObjectName = "AcDbArc" Then lengte = lengte + e.ArcLength If e.ObjectName = "AcDbLine" Then lengte = lengte + e.length e.Delete Next nr
Case obj.ObjectName = "AcDbArc" Set boog = obj lengte = lengte + boog.ArcLength Case obj.ObjectName = "AcDbLine" lengte = lengte + obj.length Case obj.ObjectName = "AcDbCircle" lengte = lengte + obj.Circumference
Pagina 28 van 39
'foutafhandeling Case Else MsgBox "Dit element bevat geen lengte: " & obj.ObjectName End Select
i=i+1
Next obj
'format voor 2 cijfers achter de komma
lengte = Format(lengte, "###0.00")
Exit Function ThisDrawing.SelectionSets.Item("lengtes").Delete End Function
Sub length() Dim l As String l = lengte MsgBox "Totale lengte van de geselekteerde objecten is: " & l & " m" ' starten subroutine om de totale lengte naar het klembord te kopieeren Klembord.kopieer (l) End Sub
Pagina 29 van 39
"opvragen_opp" Option Explicit
Public Sub opp() 'variabelen Dim Objsel As Object Dim opp As Double Dim i As Integer Dim prompt As String Dim orgkleur As String Dim arcering As AcadHatch Dim ssOpp As AcadSelectionSet Dim outerLoop(0 To 0) As AcadEntity On Error GoTo foutafhandeling
'visuele regel prompt = "de totale oppervlakte van de geselekteerde objecten is:" i=1 Set ssOpp = ThisDrawing.SelectionSets.Add("oppervlaktes")
'selecteren ssOpp.SelectOnScreen
Pagina 30 van 39
'optelling For Each Objsel In ssOpp
opp = opp + Objsel.Area i=i+1
Next 'format voor 2 cijfers achter de komma
opp = Format(opp, "###0.00")
'informatie op in massegebox en klembord MsgBox prompt & vbCrLf & opp & " m2", vbInformation, "lisp to VBA" Klembord.kopieer (opp) ThisDrawing.SelectionSets.Item("oppervlaktes").Delete
Exit Sub 'de foutafhandeling foutafhandeling:
If Err.Description = "Object doesn't support this property or method" Then orgkleur = ssOpp.Item(i - 1).Color ssOpp.Item(i - 1).Color = acRed ssOpp.Update If MsgBox("object " & i & " wordt rood gekleurd" & " heeft geen oppervlakte." & vbCrLf & _ "De waarde kan niet bij de totale oppervlakte worden gevoegd, Wil je doorgaan?", vbYesNo, "Lisp to VBA") = vbYes Then Err.Clear ssOpp.Item(i - 1).Color = orgkleur
Pagina 31 van 39
ssOpp.Update Resume Next End If Else Debug.Print Err.Description
End If ThisDrawing.SelectionSets.Item("oppervlaktes").Delete End Sub
"opvragen_kadopp" Sub kadopp()
'punt opvragen en vlak maken p = ThisDrawing.Utility.GetPoint(, "geef punt") regel = "-boundary " & CLng(p(0)) & "," & CLng(p(1)) ThisDrawing.SendCommand (regel & vbCr & vbCr) Set laatste_element = hisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1) Dim opp As Long opp = laatste_element.Area MsgBox laatste_element.Area
Dim p1(0 To 2) As Double Dim p3(0 To 2) As Double
Pagina 32 van 39
'Oppervlakte tekst plaatsen in de gemaakte boundary
regel = "-layer s grondnr " ThisDrawing.SendCommand (regel & vbCr & vbCr)
Dim T As AcadText Set T = ThisDrawing.ModelSpace.AddText(CStr(opp), p, 1#)
'Opvragen min en max punten van de text, en het rechthoek aan weerzijde 0.1 mm groter maken
Call T.GetBoundingBox(p0, p2)
p0(0) = p0(0) - 0.1 p0(1) = p0(1) - 0.1 p2(0) = p2(0) + 0.1 p2(1) = p2(1) + 0.1
p1(0) = p2(0) p1(1) = p0(1) p3(0) = p0(0) p3(1) = p2(1)
'rechthoek plaatsen om de tekst heen
Set l0 = ThisDrawing.ModelSpace.AddLine(p0, p1) Set l1 = ThisDrawing.ModelSpace.AddLine(p1, p2) Set l2 = ThisDrawing.ModelSpace.AddLine(p2, p3) Set l3 = ThisDrawing.ModelSpace.AddLine(p3, p0)
Pagina 33 van 39
Dim grensBuiten(0 To 0) As AcadEntity Dim GrensBinnen(0 To 3) As AcadEntity
Set grensBuiten(0) = laatste_element Set GrensBinnen(0) = l0 Set GrensBinnen(1) = l1 Set GrensBinnen(2) = l2 Set GrensBinnen(3) = l3
Dim TekstEnRechthoek(0 To 4) As AcadEntity Set TekstEnRechthoek(0) = T Set TekstEnRechthoek(1) = l0 Set TekstEnRechthoek(2) = l1 Set TekstEnRechthoek(3) = l2 Set TekstEnRechthoek(4) = l3
'plaatsen van een arcering met uitzondering van het gemaakte tekstvlak
Dim arcering As AcadHatch
regel = "-layer s arc " ThisDrawing.SendCommand (regel & vbCr & vbCr)
Set arcering = ThisDrawing.ModelSpace.AddHatch(0, "solid,_o", True)
arcering.AppendOuterLoop (grensBuiten) arcering.AppendInnerLoop (GrensBinnen) arcering.Evaluate arcering.Update
Pagina 34 van 39
l0.Visible = False l1.Visible = False l2.Visible = False l3.Visible = False
Dim willekeur As Integer willekeur = 10000 * Rnd Dim groep As AcadGroup
regel = "-layer s grondnr " ThisDrawing.SendCommand (regel & vbCr & vbCr) Set groep = ThisDrawing.Groups.Add("opp" & willekeur) groep.AppendItems (TekstEnRechthoek)
End Sub
"Klembord" Sub kopieer(ByVal waarde As String)
Dim MyData As DataObject Dim strClip As String strClip = waarde
Set MyData = New DataObject MyData.SetText strClip
MyData.PutInClipboard End Sub
Pagina 35 van 39
Verschillende tekeningen
Pagina 36 van 39
Totaal tekening situatie, grenzen, wegvakken, asfaltvlakken.
Pagina 37 van 39
Verkooptekening
Pagina 38 van 39
Aktetekening
Pagina 39 van 39
