(princ "Kaart.LSP, gemaakt door www.cadcollege.nl, versie 30 september 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" "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");begin kiezen/maken pline
  (setq Optie (getpoint "\nStartpunt van Polyline of [Selecteer polyline/Rechthoek]<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 "\nSpecify first corner: "))
      (setq pt2 (getcorner pt1 "\nSpecify opposite corner: "))  
      (command "_.RECTANGLE" pt1 pt2)
      (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 elementen 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_Opschonen (/) 
  (setvar "cmdecho" 0)
  (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")
  (setvar "cmdecho" 1)
)
(defun c:Kaart (/ Optie MijnCommando) 
  (initget "Draaien Inkleuren Trimmen Opschonen")
  (setq Optie (getkword "Maak uw keuze [Draaien/Inkleuren/Trimmen/Opschonen]"))
  (setq MijnCommando (read (strcat "(Command (C:Kaart_" Optie ") )")))
  (eval MijnCommando)
  (prin1)
)
(princ "<<Lisproutines geladen: start met KAART>>")
Kaart