(princ "Kaart.LSP, gemaakt door www.cadcollege.nl, versie oktober 2025\n")
(defun pline2ptLst (pline / x) 
  (mapcar '(lambda (x) (trans x 0 1)) 
          (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) pline))
  )
)
(defun c:Kaart_Kleuren (/ ss i j ent Lagen Laag layer Filter) 
  (terpri)
  (princ "\n<<< Inkleuren bezig. Geduld A.U.B. >>> ")
  (setvar "cmdecho" 0)
  (command "_.UNDO" "Begin")
  (setvar "transparencydisplay" 1)
  (setq Lagen '("BEGROEIDTERREINDEEL" "ONBEGROEIDTERREINDEEL" "OVERBRUGGINGSDEEL" 
                "WATERDEEL" "ONDERSTEUNENDWATERDEEL" "WEGDEEL" "ONDERSTEUNENDWEGDEEL" 
                "PAND"
               )
  )
  (setq OnzichtbareLagen '("PerceelNummer" "kadastrale_CODE" "kadastrale_OPPERVLAK" 
                           "PERCEEL"
                          )
  )
  (setq j 0)
  (while (< j (length Lagen)) 
    (setq Laag (nth j Lagen))
    (setq NieuweLaag (strcat "Arcering_" Laag))
    (setq kleur (cdr (assoc 62 (tblsearch "layer" laag))))
    (command "_.layer" "make" NieuweLaag "color" kleur "" "Transparency" 75 "" "")
    (setq Filter (list (cons 0 "LWPOLYLINE") (Cons 8 Laag)))
    (setq ss (ssget "ALL" Filter)) ; Select all polylines
    (if ss 
      (progn 
        (setq i 0)
        (while (< i (sslength ss)) 
          (setq ent (ssname ss i))
          (command "_.HATCH" "Solid" ent "")
          (setq xdata (assoc -3 (entget ent '("CADCollege"))))
          (if (not (eq xdata nil)) 
            (progn 
              (setq arcering (entget (entlast)))
              (setq arceringMetXdata (append arcering (list xdata)))
              (entmod arceringMetXdata)
            )
          )
          (setq i (1+ i))
        )
        (princ 
          (strcat "\naantal arceringen in de laag " 
                  Laag
                  ": "
                  (vl-princ-to-string i)
          )
        )
      )
      (princ (strcat "\ngeen arceringen in de laag: " Laag))
    )
    (setq j (1+ j))
  )
  (terpri)
  (setvar "clayer" "0")
  (command "-LAYOUT" "NEW" "Onbewerkt")
  (command "CTAB" "Onbewerkt")
  (command "MSPACE")
  (setq j 0)
  (while (< j (length Lagen)) 
    (setq OnzichtbareLaag (strcat "Arcering_" (nth j Lagen)))
    (command "_.vplayer" "freeze" OnzichtbareLaag "current" "")
    (setq j (1+ j))
  )
  (command "_.zoom" "_extents")
  (command "_.zoom" "0.95x")
  (command "vports" "Lock" "ON" "ALL" "")
  (command "-LAYOUT" "NEW" "Ingekleurd")
  (command "CTAB" "Ingekleurd")
  (command "MSPACE")
  (setq j 0)
  (while (< j (length OnzichtbareLagen)) 
    (setq OnzichtbareLaag (nth j OnzichtbareLagen))
    (command "_.vplayer" "freeze" OnzichtbareLaag "current" "")
    (setq j (1+ j))
  )
  (command "_.zoom" "_extents")
  (command "_.zoom" "0.95x")
  (command "PSPACE")
  (command "_.UNDO" "End")
  (setvar "cmdecho" 1)
  (prompt "einde inkleuren")
)
(defun c:Kaart_Trimmen (/ pt1 pt2 AantalPunten i) 
  (setvar "cmdecho" 0)
  (command "_.UNDO" "Begin")
  (if (= (getvar "tilemode") 0) (command "MSPACE"))
  (initget "Selecteer Rechthoek Cirkel") ;begin kiezen/maken pline
  (setq Optie (getpoint "\nStartpunt van Polyline of [Selecteer polyline/Rechthoek/Cirkel]<Selecteer polyline>: "))
  (if (= Optie nil) (setq Optie "Selecteer"))
  (if (and (listp Optie) (= (length Optie) 3)) 
    (progn 
      (setq pt1 Optie)
      (setq pt2 (getpoint pt1 "\nVolgend punt : "))
      (if pt2 
        (progn 
          (setq AantalPunten 2)
          (command "_.PLINE" pt1 pt2)
          (while pt2 
            (setq AantalPunten (1+ AantalPunten))
            (if (> AantalPunten 3) 
              (setq Vraag "\nVolgend punt (of Enter om te beëindigen): ")
              (setq Vraag "\nVolgend punt : ")
            )
            (setq pt2 (getpoint pt2 Vraag))
            (if pt2 
              (command pt2)
              (command "")
            )
          )
          (if (> AantalPunten 3) 
            (setq plGeselecteerd (ssadd (entlast)))
            (entdel (entlast))
          )
        )
        (princ "Geen tweede punt opgegeven.")
      )
    )
  )
  (if (eq Optie "Selecteer") 
    (progn 
      (if (= (getvar "tilemode") 0) (command "MSPACE"))
      (setq selectioncyclingOud (getvar "selectioncycling"))
      (setvar "selectioncycling" 2)
      (while (not (setq plGeselecteerd (ssget "_:S" '((0 . "LWPOLYLINE"))))))
      (setvar "selectioncycling" selectioncyclingOud)
    )
  )
  (if (eq Optie "Rechthoek") 
    (progn 
      (setq pt1 (getpoint "\nGeef het eerste hoekpunt: "))
      (setq pt2 (getcorner pt1 "\nGeef het tweede hoekpunt: "))
      (command "_.RECTANGLE" pt1 pt2)
      (setq plGeselecteerd (ssadd (entlast)))
    )
  )
  (if (eq Optie "Cirkel") 
    (progn 
      (setq pt1 (getpoint "\nGeef het Midden: "))
      (command "_.Polygon" 48 pt1 "I" pause)
      (setq plGeselecteerd (ssadd (entlast)))
    )
  ) ; einde kiezen/maken pline
  (if plGeselecteerd 
    (progn 
      (setq entGeselecteerd (entget (ssname plGeselecteerd 0)))
      (entmod (subst (cons 70 1) (assoc 70 entGeselecteerd) entGeselecteerd))
      (if (= 4 (getvar "Insunits")) 
        (setq OffsetAfstand 100)
        (setq OffsetAfstand 0.1)
      )
      (command "offset" OffsetAfstand (ssname plGeselecteerd 0) "*0,0,0" "")
      (setq ptLst (pline2ptlst (entget (entlast))))
      (entdel (entlast))
      (command "Trim" plGeselecteerd "" "Fence")
      (foreach pt ptLst (command (list (car pt) (cadr pt))))
      (command "" "")
      (setq ElementenArceringen (ssget "_F" ptLst '((0 . "HATCH"))))
      (if ElementenArceringen 
        (progn 
          (setq entGeselecteerd (entget (ssname plGeselecteerd 0)))
          (entmod (subst (cons 70 1) (assoc 70 entGeselecteerd) entGeselecteerd))
          (setq i 0)
          (while (< i (sslength ElementenArceringen)) 
            (setq ElementArcering (ssname ElementenArceringen i))
            (setq laag (cdr (assoc 8 (entget ElementArcering))))
            (setq HandleEenNaLaatsteElement (cdr (assoc 5 (entget (entlast)))))
            (command "-Hatchedit" ElementArcering "B" "R" "N")
            (setq HandleLaatsteElement (cdr (assoc 5 (entget (entlast)))))
            (setq Regions (ssget "_X" '((0 . "REGION"))))
            (if Regions 
              (if (/= HandleEenNaLaatsteElement HandleLaatsteElement) 
                (progn 
                  (setq regArcering (entlast))
                  (command "Copy" plGeselecteerd "" "0,0,0" "0,0,0")
                  (command "Region" (entlast) "")
                  (setq regGeselecteerd (entlast))
                  (command "Intersect" regArcering regGeselecteerd "")
                  (command "_.HATCH" "Solid" (entlast) "")
                  (setq hArcering (entget (entlast)))
                  (entmod (subst (cons 8 laag) (assoc 8 hArcering) hArcering))
                  (entdel regArcering)
                  (entdel regGeselecteerd)
                )
              )
            )
            (setq i (1+ i))
          )
        )
      )
      (sssetfirst nil 
                  (setq ElementenBinnenkant (ssget "_WP" ptLst))
      )
      (if ElementenBinnenkant 
        (progn 
          (setq ElementenBuitenkant (ssget "_X"))
          (setq i 0)
          (while (< i (sslength ElementenBinnenkant)) 
            (setq ElementBinnenkant (ssname ElementenBinnenkant i))
            (setq ElementenBuitenkant (ssdel ElementBinnenkant ElementenBuitenkant))
            (setq i (1+ i))
          )
          (command "_.erase" ElementenBuitenkant "")
        )
        (prompt "geen pline gevonden")
      )
    )
    (prompt "geen pline geselecteerd")
  )
  (command "_.UNDO" "End")
  (setvar "cmdecho" 1)
  (prompt "einde trimmen")
)
(defun c:Kaart_Draaien (/) 
  (if (= (getvar "tilemode") 0) (command "MSPACE"))
  (initget "Object Noordgericht 90 180")
  (setq Optie (getPoint "Klik op twee punten voor de horizontale richting: [Object/Noordgericht/90/180]:<Object> "))
  (if Optie 
    (progn 
      (if (= Optie nil) (setq Optie "Object"))
      (if (eq Optie "Object") (command "_.UCS" "OBject" pause))
      (if (eq Optie "Noordgericht") (command "_.UCS" "World"))
      (if (eq optie "90") (command "_.UCS" "Z" "90"))
      (if (eq optie "180") (command "_.UCS" "Z" "180"))
      (if (and (listp Optie) (= (length Optie) 3)) 
        (progn 
          (setq Hoek (Getangle Optie "Klik op het tweede punt voor de x-richting:"))
          (if Hoek 
            (progn 
              (setq graden (* (/ Hoek pi) 180.0))
              (command "_.UCS" "OR" Optie)
              (command "_.UCS" "Z" graden)
            )
            (princ "\nInvoer geannuleerd door gebruiker.")
          )
        )
      )
      (if (eq Optie "Noordgericht") 
        (command "Plan" "" "")
        (progn 
          (setq Zoomfactor (getvar "viewsize"))
          (setq middenpunt '(0 0 0))
          (setq linksboven (list (- (car middenpunt) (/ Zoomfactor 2)) 
                                 (+ (cadr middenpunt) (/ Zoomfactor 2))
                                 0
                           )
          )
          (setq rechtsonder (list (+ (car middenpunt) (/ Zoomfactor 2)) 
                                  (- (cadr middenpunt) (/ Zoomfactor 2))
                                  0
                            )
          )
          (command "._zoom" linksboven rechtsonder)
          (command "regen")
          (command "Plan" "" "")
          (command "._zoom" linksboven rechtsonder)
        )
      )
    )
  )
)
(defun c:Kaart_Info (/ htmlcontent htmlbegin htmlend htmltabelbegin htmltabelend 
                     htmltabelrij Optie lat lon schaal radius url j
                    ) 
  (setvar "cmdecho" 0)
  (command "MSPACE")
  (setq selectioncyclingOud (getvar "selectioncycling"))
  (setvar "selectioncycling" 2)
  (initget "Informatie Posities")
  (setq Optie (getkword "\nKies voor [object Informatie/Posities]: "))
  (if (eq Optie "Posities") 
    (progn 
      (setvar "Luprec" 6)
      (initget "Gps Rd Algemeen Uitlezen gpX")
      (setq Optie (getkword "\nKies voor [Gps/Rd/Algemeen/Uitlezen/export gpX]<Gps>: "))
      (if (= Optie nil) (setq Optie "Gps"))
      (if (eq Optie "Gps") 
        (progn 
          (while (setq pt (getpoint "\nGeef een punt aan: (Enter om te stoppen)")) 
            (command "Insert" "*Punt-gps" pt "1" "0")
          )
        )
      )
      (if (eq Optie "Rd") 
        (progn 
          (if (= 4 (getvar "Insunits")) 
            (setq blok "*Punt-rd-mm")
            (setq blok "*Punt-rd-m")
          )
          (while (setq pt (getpoint "\nGeef een punt aan: (Enter om te stoppen)")) 
            (command "Insert" blok pt "1" "0")
          )
        )
      )
      (if (eq Optie "Algemeen") 
        (progn 
          (if (= 4 (getvar "Insunits")) 
            (setvar "GEOMARKPOSITIONSIZE" 500)
            (setvar "GEOMARKPOSITIONSIZE" 0.5)
          )
          (setq merk (getint "\nGeef het merknummer op voor het gemarkeerde punt: <1>"))
          (if (= merk nil) (setq merk 1))
          (while (setq pt (getpoint "\nGeef een punt aan: (Enter om te stoppen)")) 
            (command "geomarkpoint" pt merk)
            (setq merk (+ merk 1))
          )
        )
      )
      (if (eq Optie "gpX") 
        (progn 
          (princ "\n\nKies POSITIONMARKER elementen en/of druk op Enter om te verder te gaan.")
          (setq ss (ssget '((0 . "POSITIONMARKER"))))
          (setq wpt "")
          (if ss 
            (progn 
              (setq i 0)
              (while (< i (sslength ss)) 
                (setq obj (vlax-ename->vla-object (ssname ss i)))
                (setq lat (vla-get-Latitude obj))
                (setq lon (vla-get-Longitude obj))
                (setq notes (vla-get-Notes obj))
                (if (= (assoc 101 (entget (ssname ss i))) nil) 
                  (setq label "")
                  (setq label (vla-get-textstring obj))
                )

                (setq wpt (strcat wpt "\t<wpt lat=\"" lat "\" lon=\"" lon "\">\n" 
                                  "\t\t<name>" label "</name>\n" "\t\t<desc>" notes 
                                  "</desc>\n" "\t</wpt>\n"
                          )
                )
                (setq i (1+ i))
              )
            )
          )
          (princ "\nKies polylijnen.")
          (setq ss (ssget '((0 . "LWPOLYLINE"))))
          (setq i 0)
          (setq trk "")
          (if ss 
            (progn 
              (while (< i (sslength ss)) 
                (setq trk (strcat trk 
                                  "\t<trk>\n\t\t<name>CADCollege GPX export</name>\n\t\t<trkseg>\n"
                          )
                )
                (setq ptlst (pline2ptLst (entget (ssname ss i))))
                (foreach pt ptLst 
                  (progn 
                    (command "geomarkpoint" pt "1")
                    (setq obj (vlax-ename->vla-object (entlast)))
                    (setq lat (vla-get-Latitude obj))
                    (setq lon (vla-get-Longitude obj))
                    (setq trk (strcat trk "\t\t\t<trkpt lat=\"" lat "\" lon=\"" lon 
                                      "\"></trkpt>\n"
                              )
                    )
                    (entdel (entlast))
                  )
                )
                (setq trk (strcat trk "\t\t</trkseg>\n\t</trk>\n"))
                (setq i (1+ i))
              )
            )
          )
          (if (> (strlen (strcat wpt trk))   1) 
            (progn 
              (setq header "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<gpx version=\"1.1\" creator=\"CADCollege\" xmlns=\"http://www.topografix.com/GPX/1/1\">\n")
              (setq BeginTrack "\t<trk>\n\t\t<name>CADCollege GPX export</name>\n\t\t<trkseg>\n")
              (setq footer "</gpx>")
              (setq fileInhoud (strcat header wpt trk footer))
              (setq tijdelijkeFile (vl-filename-mktemp "kaart.gpx"))
              (setq file (open tijdelijkeFile "w"))
              (write-line fileInhoud file)
              (close file)
              (command "AI_EDITCUSTFILE" tijdelijkeFile)
            )
          )
        )
      )
      (if (eq Optie "Uitlezen") 
        (progn 
          (princ "\nKies POSITIONMARKER elementen (op volgorde).")
          (setq ss (ssget '((0 . "POSITIONMARKER"))))
          (if ss 
            (progn 
              (setq i 0)
              (if (= 4 (getvar "Insunits")) 
                (setq cijfersachterkomma 0)
                (setq cijfersachterkomma 3)
              )
              (setq Inhoud "")
              (while (< i (sslength ss)) 
                (setq ent (ssname ss i))
                (setq x (rtos (car (cdr (assoc 10 (entget ent)))) 
                              2
                              cijfersachterkomma
                        )
                )
                (setq y (rtos (cadr (cdr (assoc 10 (entget ent)))) 
                              2
                              cijfersachterkomma
                        )
                )
                (setq obj (vlax-ename->vla-object ent))
                (setq lat (vla-get-Latitude obj))
                (setq lon (vla-get-Longitude obj))
                (setq notes (vla-get-Notes obj))
                (if (= (assoc 101 (entget ent)) nil) 
                  (setq label "")
                  (setq label (vla-get-textstring obj))
                )
                (setq Inhoud (strcat Inhoud label "\t" notes "\t" x "\t" y "\t" lat "\t" lon 
                                     "\n"
                             )
                )
                (setq i (1+ i))
              )
              (setq header "label\tnotities\tx\ty\tOosterlengte\tNoorderbreedte\n")
              (setq fileInhoud (strcat header Inhoud))
              (setq tijdelijkeFile (vl-filename-mktemp "kaart.csv"))
              (setq file (open tijdelijkeFile "w"))
              (write-line fileInhoud file)
              (close file)
              (command "AI_EDITCUSTFILE" tijdelijkeFile)
            )
          )
        )
      )
    )
  )
  (if (eq Optie "Informatie") 
    (progn 
      (if (= (getvar "tilemode") 0) (command "MSPACE"))
      (setq ent (car (entsel "\nSelect an entity: ")))
      (setq laag (cdr (assoc 8 (entget ent))))
      (setq htmltitel (strcat "<h1>" laag "</h1>"))

      (setq xdatalist (cdr (car (cdr (assoc -3 (entget ent '("CADCollege")))))))
      (if (not xdatalist) 
        (princ "\nGeen Gis data van CADCollege gevonden voor dit element.")
        (progn 
          (setq htmlcontent "<dl>")
          (foreach paar xdatalist 
            (if (eq (car paar) 1000) 
              (progn 
                (setq content (cdr paar))
                (setq positieScheidingsteken (vl-string-search ";" content))
                (setq eigenschap (substr content 1 positieScheidingsteken))
                (setq waarde (substr content (+ positieScheidingsteken 2)))
                (setq htmltabelrij (strcat "<dt>" eigenschap "</dt><dd>" waarde 
                                           "</dd>"
                                   )
                )
                (setq htmlcontent (strcat htmlcontent htmltabelrij))
              )
            )
          )
          (setq htmlcontent (strcat htmlcontent "</dl>"))
          (setq htmlbegin "<html lang='nl'><head><link rel='stylesheet' href='https://www.cadcollege.nl/cadtools/conversie/uitleg/kaart.css'></head><body><div>")
          (setq htmlend "</div></body></html>")
          (setq plaatje "<svg><polygon points='10,10 20,20'/></svg>")
          (setq plaatje "<br>")
          (setq html (strcat htmlbegin htmltitel plaatje htmlcontent htmlend))
          (if (> (strlen html) 400) 
            (progn 
              (setq tijdelijkeFile (vl-filename-mktemp "kaart.html"))
              (setq file (open tijdelijkeFile "w"))
              (write-line html file)
              (close file)
              (setq html (strcat "file:///" tijdelijkeFile))
            )
            (progn 
              (setq html (strcat "data:text/html," html))
              (while (vl-string-search " " html) 
                (setq html (vl-string-subst "%20" " " html))
              )
            )
          )
          (command "browser" html)
        )
      )
    )
  )
  (setvar "selectioncycling" selectioncyclingOud)
  (setvar "cmdecho" 1)
)
(defun c:Kaart_Extra (/) 
  (setvar "cmdecho" 0)
  (initget "Opschonen Kaart Help")
  (setq Optie (getkword "\nKies voor [Opschonen/Kaart op internet/Help]<Opschonen>: "))
  (if (= Optie nil) (setq Optie "Opschonen"))
  (if (eq Optie "Help") 
    (progn 
      (command "Browser" 
               "https://www.cadcollege.nl/CADTools/Conversie/Kaarten_AutoCAD_uitleg.htm#lisp_routine"
      )
    )
  )
  (if (eq Optie "Opschonen") 
    (progn 
      (setq block_ss (ssget "_X" '((0 . "INSERT") (2 . "LEGENDA"))))
      (if block_ss 
        (progn 
          (setq i 0)
          (while (< i (sslength block_ss)) 
            (entdel (ssname block_ss i))
            (setq i (1+ i))
          )
        )
      )
      (setq blkDef (tblobjname "BLOCK" "LEGENDA"))
      (if blkDef (entdel blkdef))
      (command "PURGE" "Blocks" "*" "No")
      (command "PURGE" "Layers" "*" "No")
    )
  )
  (if (eq Optie "Kaart") 
    (progn 
      (setq latitude (getvar "latitude"))
      (setq longitude (getvar "longitude"))
      (setq schaal (if (eq (getvar "INSUNITS") 4) 1000 1))
      (setq radius (fix 
                     (/ 
                       (- (car (getvar "Limmax")) (car (getvar "Limmin")))
                       schaal
                       2
                     )
                   )
      )
      (setq url (strcat "https://www.cadcollege.nl/CADTools/Conversie/Kaarten_AutoCAD_kadaster.htm?nb=" 
                        (rtos latitude 2 8)
                        "&ol="
                        (rtos longitude 2 8)
                        "&r=r"
                        (itoa radius)
                )
      )
      (command "Browser" url)
    )
  )
  (setvar "cmdecho" 1)
)
(defun c:Kaart (/ Optie MijnCommando) 
  (initget "Draaien Kleuren Trimmen Info Extra")
  (setq Optie (getkword "Maak uw keuze [Draaien/Kleuren/Trimmen/Info/Extra]: "))
  (setq MijnCommando (read (strcat "(Command (C:Kaart_" Optie ") )")))
  (eval MijnCommando)
  (prin1)
)
(princ "<<Lisproutines geladen: start met KAART>>")
Kaart