(princ "Kaart.LSP, gemaakt door www.cadcollege.nl, versie oktober 2025\n")
(defun c:Kaart_Inkleuren (/ 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 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") 
    (while (not (setq plGeselecteerd (ssget "_:S" '((0 . "LWPOLYLINE"))))))
  )
  (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))
      (command "offset" 100 (ssname plGeselecteerd 0) "*0,0,0" "")
      (setq ptLst (mapcar 
                    '(lambda (x) (trans x 0 1))
                    (mapcar 'cdr 
                            (vl-remove-if-not 
                              '(lambda (x) (= 10 (car x)))
                              (entget (entlast))
                            )
                    )
                  )
      )
      (entdel (entlast))
      (setq ptLst (append ptLst (list (nth 0 ptLst))))
      (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_Manage ( / htmlcontent htmlbegin header bodybegin bodyend htmlend 
                         htmltabelbegin htmltabelend htmltabelrij 
                         Optie latitude longitude schaal 
                         radius url j htmlcontent 
                         ) 
  (setvar "cmdecho" 0)
  (initget "Opschonen Kaart Info Help")
  (setq Optie (getkword "\nKies voor [Opschonen/Kaart op internet/detail Informatie/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)
    )
  )
  (if (eq Optie "Info") 
    (progn 
      (setq htmlbegin "<!DOCTYPE html><html>")
      (setq header "<head><style>html{background:white;}dl{display:grid;grid-template-columns: 1fr 2fr;}dt{float:left;}</style><title>CADCollege</title></head>")
      (setq bodybegin "<body style='font-family:Arial;'>")
      (setq bodyend "</body>")
      (setq htmlend "</html>")
      (setq htmltabelbegin "<dl>")
      (setq htmltabelrij "")
      (setq htmltabelend "</dl>")
      (setq j 0)
      (while (< j  3) 
        (setq htmltabelrij (strcat htmltabelrij "<dt>Tag:</dt><dd>in voorbereiding</dd>"))
        (setq j (1+ j))
      )
      (setq htmlcontent (strcat htmltabelbegin htmltabelrij htmltabelend))
      (showhtmlmodalwindow 
        (strcat "data:text/html," htmlbegin header bodybegin htmlcontent bodyend 
                htmlend
        )
      )
    )
  )
  (setvar "cmdecho" 1)
)
(defun c:Kaart (/ Optie MijnCommando) 
  (initget "Draaien Inkleuren Trimmen Manage")
  (setq Optie (getkword "Maak uw keuze [Draaien/Inkleuren/Trimmen/Manage]: "))
  (setq MijnCommando (read (strcat "(Command (C:Kaart_" Optie ") )")))
  (eval MijnCommando)
  (prin1)
)
(princ "<<Lisproutines geladen: start met KAART>>")
Kaart