[ADD] Modul zum Erstellen von Hängewarenlagerbereichen und Stockwerken mit Attributsdefinition für den Export in ein Anforderungsdokument für Ausschreibungen

Lisp/ssg_core.lsp

@@ -1622,6 +1622,210 @@
 )
 
 
+;; ------------------------------------------------------------
+;; POLYGON-HELFER (2D, reine Berechnung - ohne Zeichnung testbar)
+;; ------------------------------------------------------------
+;; Ein Polygon ist eine Liste von Punkten ((x y [z]) ...), implizit
+;; geschlossen (der letzte Punkt wird mit dem ersten verbunden; ein
+;; doppelter Schlusspunkt stoert nicht). Z wird ignoriert.
+;; Genutzt von LagerInsert.lsp (Geschoss-/Bereichskonturen, Auto-Fuellung),
+;; bewusst hier, weil nichts davon lagerspezifisch ist.
+
+;; Vorzeichenbehaftete Flaeche (Gauss'sche Trapezformel): > 0 = Umlauf
+;; gegen den Uhrzeigersinn, < 0 = im Uhrzeigersinn.
+(defun ssg-poly-flaeche-signiert (pts / s p q rest)
+  (setq s 0.0 rest pts)
+  (while rest
+    (setq p (car rest)
+          q (if (cdr rest) (cadr rest) (car pts)))
+    (setq s (+ s (- (* (car p) (cadr q)) (* (car q) (cadr p)))))
+    (setq rest (cdr rest))
+  )
+  (/ s 2.0)
+)
+
+;; Flaeche, immer >= 0.
+(defun ssg-poly-flaeche (pts)
+  (abs (ssg-poly-flaeche-signiert pts))
+)
+
+;; Kanten als Liste ((p1 p2) ...), inklusive Schlusskante. Kanten der
+;; Laenge 0 (doppelter Schlusspunkt) fallen weg.
+(defun ssg-poly-kanten (pts / erg rest p q)
+  (setq erg nil rest pts)
+  (while rest
+    (setq p (car rest)
+          q (if (cdr rest) (cadr rest) (car pts)))
+    (if (> (distance (list (car p) (cadr p)) (list (car q) (cadr q))) 1e-9)
+      (setq erg (cons (list p q) erg)))
+    (setq rest (cdr rest))
+  )
+  (reverse erg)
+)
+
+;; Umfang (Summe aller Kantenlaengen in XY).
+(defun ssg-poly-umfang (pts / s)
+  (setq s 0.0)
+  (foreach k (ssg-poly-kanten pts)
+    (setq s (+ s (distance (list (car (car k)) (cadr (car k)))
+                           (list (car (cadr k)) (cadr (cadr k)))))))
+  s
+)
+
+;; Achsparallele Huelle -> ((xmin ymin) (xmax ymax)), nil fuer leere Liste.
+(defun ssg-poly-bbox (pts)
+  (if pts
+    (list (list (apply 'min (mapcar 'car pts)) (apply 'min (mapcar 'cadr pts)))
+          (list (apply 'max (mapcar 'car pts)) (apply 'max (mapcar 'cadr pts))))
+  )
+)
+
+;; Punkt im Polygon? (Strahlverfahren, Punkte AUF dem Rand sind nicht
+;; eindeutig zugeordnet - fuer Zuordnungen mit Toleranz unkritisch.)
+(defun ssg-punkt-in-poly-p (pt pts / innen p q x y)
+  (setq innen nil x (car pt) y (cadr pt))
+  (foreach k (ssg-poly-kanten pts)
+    (setq p (car k) q (cadr k))
+    (if (and (not (eq (> (cadr p) y) (> (cadr q) y)))
+             (< x (+ (car p) (/ (* (- (car q) (car p)) (- y (cadr p)))
+                                (- (cadr q) (cadr p))))))
+      (setq innen (not innen)))
+  )
+  innen
+)
+
+;; Punkt um zentrum (2D) um winkel (Bogenmass, gegen Uhrzeigersinn) drehen.
+;; Ein Z-Wert bleibt erhalten.
+(defun ssg-punkt-drehen (pt winkel zentrum / dx dy c s erg)
+  (setq dx (- (car pt) (car zentrum))
+        dy (- (cadr pt) (cadr zentrum))
+        c  (cos winkel)
+        s  (sin winkel))
+  (setq erg (list (+ (car zentrum) (- (* dx c) (* dy s)))
+                  (+ (cadr zentrum) (+ (* dx s) (* dy c)))))
+  (if (caddr pt) (append erg (list (caddr pt))) erg)
+)
+
+(defun ssg-poly-drehen (pts winkel zentrum)
+  (mapcar '(lambda (p) (ssg-punkt-drehen p winkel zentrum)) pts)
+)
+
+;; Innere Abschnitte der waagrechten Geraden y im Polygon.
+;; Rueckgabe: aufsteigend sortierte Intervalle ((x1 x2) ...).
+;; Halboffene Kantenregel (ymin <= y < ymax): eine Gerade genau durch eine
+;; Ecke zaehlt die Kante nur einmal; waagrechte Kanten zaehlen nie.
+(defun ssg-poly-schnitt-y (pts y / xs p q erg)
+  (setq xs nil)
+  (foreach k (ssg-poly-kanten pts)
+    (setq p (car k) q (cadr k))
+    (if (or (and (<= (cadr p) y) (< y (cadr q)))
+            (and (<= (cadr q) y) (< y (cadr p))))
+      (setq xs (cons (+ (car p) (/ (* (- (car q) (car p)) (- y (cadr p)))
+                                   (- (cadr q) (cadr p))))
+                     xs)))
+  )
+  (setq xs (vl-sort xs '<) erg nil)
+  (while (cadr xs)
+    (if (> (- (cadr xs) (car xs)) 1e-9)
+      (setq erg (cons (list (car xs) (cadr xs)) erg)))
+    (setq xs (cddr xs))
+  )
+  (reverse erg)
+)
+
+;; Polygon an der Waagrechten y = grenze abschneiden (Sutherland-Hodgman,
+;; eine Kante). oben = T behaelt den Teil mit y >= grenze, sonst y <= grenze.
+;; Rueckgabe: Punktliste (2D), leer = nichts bleibt.
+(defun ssg-poly-clip-y (pts grenze oben / erg rest p q pin qin)
+  (setq erg nil rest pts)
+  (while rest
+    (setq p (car rest)
+          q (if (cdr rest) (cadr rest) (car pts)))
+    (setq pin (if oben (>= (cadr p) grenze) (<= (cadr p) grenze))
+          qin (if oben (>= (cadr q) grenze) (<= (cadr q) grenze)))
+    (if pin (setq erg (cons (list (car p) (cadr p)) erg)))
+    (if (not (eq pin qin))
+      (setq erg (cons (list (+ (car p) (/ (* (- (car q) (car p)) (- grenze (cadr p)))
+                                          (- (cadr q) (cadr p))))
+                            grenze)
+                      erg)))
+    (setq rest (cdr rest))
+  )
+  (reverse erg)
+)
+
+;; x-Ausdehnung des Polygonteils im Band y0 <= y <= y1: (xmin xmax) oder nil.
+;; Ein Polygon, das das Band nur an einer Kante beruehrt (Teil ohne Hoehe),
+;; zaehlt nicht - ein Gang direkt neben einer Reihe sperrt sie nicht.
+;; Exakt fuer konvexe Polygone (Gang-Rechtecke); bei konkaven die Huelle.
+(defun ssg-poly-band-x (pts y0 y1 / c ys xs)
+  (setq c (ssg-poly-clip-y (ssg-poly-clip-y pts y0 T) y1 nil))
+  (if c
+    (progn
+      (setq ys (mapcar 'cadr c) xs (mapcar 'car c))
+      (if (and (> (- (apply 'max ys) (apply 'min ys)) 1e-6)
+               (> (- (apply 'max xs) (apply 'min xs)) 1e-6))
+        (list (apply 'min xs) (apply 'max xs)))))
+)
+
+;; Schnittmenge zweier sortierter Intervall-Listen ((a1 a2) ...).
+(defun ssg-intervalle-schnitt (a b / erg lo hi)
+  (setq erg nil)
+  (while (and a b)
+    (setq lo (max (car (car a)) (car (car b)))
+          hi (min (cadr (car a)) (cadr (car b))))
+    (if (> hi lo) (setq erg (cons (list lo hi) erg)))
+    (if (< (cadr (car a)) (cadr (car b)))
+      (setq a (cdr a))
+      (setq b (cdr b)))
+  )
+  (reverse erg)
+)
+
+;; Intervall-Liste a ohne die Intervalle aus b (beide sortiert).
+(defun ssg-intervalle-minus (a b / erg iv rest x1 x2 bb)
+  (setq erg nil)
+  (foreach iv a
+    (setq rest (list iv))
+    (foreach bb b
+      (setq rest
+        (apply 'append
+          (mapcar
+            '(lambda (r / x1 x2)
+               (setq x1 (car r) x2 (cadr r))
+               (cond
+                 ((or (<= (cadr bb) x1) (>= (car bb) x2)) (list r))
+                 (T (append
+                      (if (> (car bb) x1) (list (list x1 (car bb))))
+                      (if (< (cadr bb) x2) (list (list (cadr bb) x2)))))))
+            rest)))
+    )
+    (setq erg (append erg rest))
+  )
+  erg
+)
+
+;; Eckpunkte einer LWPOLYLINE in Weltkoordinaten (Z aus der Erhebung, Code
+;; 38). Bogensegmente (Bulge /= 0) werden wie gerade Kanten behandelt; ob
+;; welche vorkommen, meldet ssg-lwpoly-boegen-p.
+(defun ssg-lwpoly-punkte (ent / ed z nrm erg)
+  (setq ed  (entget ent)
+        z   (cond ((cdr (assoc 38 ed))) (0.0))
+        nrm (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
+  (setq erg nil)
+  (foreach g ed
+    (if (= (car g) 10)
+      (setq erg (cons (trans (list (cadr g) (caddr g) z) nrm 0) erg)))
+  )
+  (reverse erg)
+)
+
+(defun ssg-lwpoly-boegen-p (ent)
+  (vl-some '(lambda (g) (and (= (car g) 42) (not (equal (cdr g) 0.0 1e-9))))
+           (entget ent))
+)
+
+
 ;; ------------------------------------------------------------
 ;; DCL ZUR LAUFZEIT GENERIEREN
 ;; ------------------------------------------------------------