Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros

Lisp/Gefaellestrecke.lsp

@@ -46,6 +46,8 @@
 (if (null *aus-ks-ein-local*) (setq *aus-ks-ein-local* nil))
 (if (null *ein-ks-ein-local*) (setq *ein-ks-ein-local* nil))
 (if (null *lib-initialized*)  (setq *lib-initialized*  nil))
+;; Laufende GF-Blocknummer (sitzungspersistent)
+(if (null #GF_LetzteNr) (setq #GF_LetzteNr 0))
 
 ;; DXFM_DIM sicher lesen (type-Guard gegen nicht-String Rueckgabewerte)
 (setq *gf-dxfm-dim* (getenv "DXFM_DIM"))
@@ -356,8 +358,8 @@
 )
 
 ;; --- Bibliothek initialisieren: AS/ES-Masse aus einzelnen DWG-Dateien extrahieren ---
-(if (null (car (atoms-family 1 '("INIT-BIBLIOTHEK"))))
-  (defun init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
+(if (null (car (atoms-family 1 '("GF-INIT-BIBLIOTHEK"))))
+  (defun gf-init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
     (if *lib-initialized*
       t
       (progn
@@ -869,7 +871,10 @@
                               entry-hz exit-hz
                               first-idx last-idx neu-l
                               chz shz as-target
-                              aktuell-pt)
+                              aktuell-pt nach-aus-pt
+                              gf-nummer last-ent
+                              L-gf-str delta-l-gf laengen-liste first-l l-item
+                              bL90 bL60 bL30 bR90 bR60 bR30 n-bogen-gf)
   (princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<")
   (princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,")
   (princ "\ndann ENTER druecken:")
@@ -1034,6 +1039,10 @@
   (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
   (if (not (= antwort "2"))
     (progn
+      ;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern
+      (setq gf-nummer (gf-next-number))
+      (setq last-ent  (entlast))
+
       ;; AUS-Element: Block-Ursprung an startpunkt ausrichten.
       ;; KS_EIN liegt im Block seitlich (Delta-Y = Drehteller-Anschluss).
       ;; Damit KS_AUS auf der gezeichneten Linie liegt, muss der Einfuegepunkt
@@ -1055,6 +1064,7 @@
       (princ (strcat "\n\n>>> AUS-Element: " as-block
                      " (hz=" (rtos entry-hz 2 1) grad-zeichen ")"))
       (setq aktuell-pt (gf-insert-gefaellebogen-by-ks as-block as-target entry-hz))
+      (setq nach-aus-pt aktuell-pt)
 
       ;; Linienzug mit Gefaellebogen und Separatoren (gekuerzte Laengen)
       (setq aktuell-pt (gf-linienzug-einfuegen segmente grade aktuell-pt))
@@ -1070,6 +1080,64 @@
                      " (hz=" (rtos exit-hz 2 1) grad-zeichen ")"))
       (gf-insert-gefaellebogen-by-ks es-block aktuell-pt exit-hz)
 
+      ;; --- GF_N-Block erstellen ---
+
+      ;; L_GF_m: kommagetrennte Segment-Laengen in Metern (angepasste Staustrecke)
+      (setq laengen-liste '()  first-l t)
+      (foreach seg segmente
+        (if (= (car seg) "Linie")
+          (setq laengen-liste
+            (append laengen-liste
+                    (list (rtos (/ (caddr seg) 1000.0) 2 3))))
+        )
+      )
+      (setq L-gf-str "")
+      (foreach l-item laengen-liste
+        (if first-l
+          (progn (setq L-gf-str l-item) (setq first-l nil))
+          (setq L-gf-str (strcat L-gf-str "," l-item))
+        )
+      )
+
+      ;; Bogen-Typen zaehlen
+      (setq bL90 0  bL60 0  bL30 0  bR90 0  bR60 0  bR30 0)
+      (foreach seg segmente
+        (if (= (car seg) "Bogen")
+          (progn
+            (cond
+              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 90)) (setq bL90 (1+ bL90)))
+              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 60)) (setq bL60 (1+ bL60)))
+              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 30)) (setq bL30 (1+ bL30)))
+              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 90)) (setq bR90 (1+ bR90)))
+              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 60)) (setq bR60 (1+ bR60)))
+              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 30)) (setq bR30 (1+ bR30)))
+            )
+          )
+        )
+      )
+      (setq n-bogen-gf (+ bL90 bL60 bL30 bR90 bR60 bR30))
+
+      ;; Horizontaldistanz Start->Ende (2D)
+      (setq delta-l-gf
+        (sqrt (+ (expt (- (car  endpunkt-ref) (car  startpunkt)) 2)
+                 (expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2))))
+
+      ;; Block mit allen Attributen erstellen
+      (gf-block-erstellen
+        "gruppe" as-seite gf-nummer
+        (caddr startpunkt)
+        (caddr endpunkt-ref)
+        deltaH
+        delta-l-gf
+        L-gf-str
+        grade
+        (1+ n-bogen-gf)
+        0
+        bL90 bL60 bL30
+        bR90 bR60 bR30
+        startpunkt last-ent nach-aus-pt entry-hz
+        (caddr (nth first-idx segmente)))
+
       (princ "\n\n=========================================")
       (princ "\n>>> Fertig! <<<")
       (princ "\n=========================================")
@@ -1078,19 +1146,180 @@
   )
 )
 
+;; ============================================================
+;; TEIL 4.5: GF-BLOCK-SYSTEM (Nummerierung, Label, Attribute)
+;; ============================================================
+
+;; Attribut-Definitionen fuer GF_N-Bloecke
+(setq *gf-attrib-defs*
+  '(("NUMMER"           "0")
+    ("TYP"              "standard")
+    ("SEITE"            "rechts")
+    ("MONTAGEHOEHE_m"   "0.000")
+    ("HOEHE_VON"        "0")
+    ("HOEHE_BIS"        "0")
+    ("DELTA_H"          "0")
+    ("DELTA_L"          "0")
+    ("L_GF_m"           "0.000")
+    ("WINKEL"           "0.000")
+    ("ANZAHL_SEPARATOR" "0")
+    ("ANZAHL_SCANNER"   "0")
+    ("GF_Bogen_L_90"    "0")
+    ("GF_Bogen_L_60"    "0")
+    ("GF_Bogen_L_30"    "0")
+    ("GF_Bogen_R_90"    "0")
+    ("GF_Bogen_R_60"    "0")
+    ("GF_Bogen_R_30"    "0")
+  )
+)
+
+;; Naechste freie GF-Nummer (scannt alle GF_* Bloecke nach Max-NUMMER)
+(defun gf-next-number ( / ss i nr maxnr attribs)
+  (setq maxnr 0)
+  (setq ss (ssget "X" '((0 . "INSERT") (2 . "GF_*"))))
+  (if ss
+    (progn
+      (setq i 0)
+      (while (< i (sslength ss))
+        (setq attribs (ssg-attrib-read (ssname ss i)))
+        (foreach pair attribs
+          (if (= (car pair) "NUMMER")
+            (progn
+              (setq nr (atoi (cdr pair)))
+              (if (> nr maxnr) (setq maxnr nr))
+            )
+          )
+        )
+        (setq i (1+ i))
+      )
+    )
+  )
+  (setq #GF_LetzteNr (max #GF_LetzteNr maxnr))
+  (setq #GF_LetzteNr (1+ #GF_LetzteNr))
+  #GF_LetzteNr
+)
+
+;; Sichtbare Beschriftung auf Layer GF_Beschriftung erzeugen.
+;; nach-aus-pt:  KS_AUS des AUS-Elements (Beginn der ersten Geraden).
+;; entry-hz:     Horizontalwinkel der Foerderrichtung in Grad.
+;; L-first-seg:  Laenge der ersten geraden Staustrecke in mm.
+;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht rechts versetzt.
+(defun gf-make-label (gf-nummer hoehe-von hoehe-bis deltaH deltaL
+                      L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg /
+                      label-txt label-pt chz-l shz-l halb)
+  (setq chz-l (cos (* entry-hz (/ pi 180.0))))
+  (setq shz-l (sin (* entry-hz (/ pi 180.0))))
+  (setq halb  (/ (float L-first-seg) 2.0))
+  (setq label-pt
+    (list (+ (car  nach-aus-pt) (* halb chz-l) (*  400.0 shz-l))
+          (+ (cadr nach-aus-pt) (* halb shz-l) (* -400.0 chz-l))
+          (caddr nach-aus-pt)))
+  (setq label-txt
+    (strcat "GF" (itoa gf-nummer)
+            "  von:" (itoa (fix hoehe-von)) " bis:" (itoa (fix hoehe-bis)) "mm"
+            "  dH=" (itoa (fix (abs deltaH))) "mm"
+            "  dL=" (itoa (fix deltaL)) "mm"
+            "  L=[" L-gf-str "]m"
+            "  W=" (rtos (float winkel) 2 2) grad-zeichen
+            "  Sep=" (itoa n-separator)))
+  (entmake
+    (list '(0 . "TEXT")
+          (cons 10 label-pt)
+          (cons 11 label-pt)
+          '(40 . 100.0)
+          (cons 1 label-txt)
+          '(7 . "Standard")
+          '(8 . "GF_Beschriftung")
+          '(72 . 1)
+          '(73 . 2)))
+)
+
+;; GF_N-Block aus allen seit last-ent erzeugten Entities erstellen
+;; und alle 18 Attribute setzen.
+(defun gf-block-erstellen (typ seite gf-nummer
+                            hoehe-von hoehe-bis deltaH deltaL
+                            L-gf-str winkel n-separator n-scanner
+                            bogen-L90 bogen-L60 bogen-L30
+                            bogen-R90 bogen-R60 bogen-R30
+                            startpunkt last-ent nach-aus-pt entry-hz L-first-seg /
+                            gf-bname gf-ss ent gf-insert)
+  ;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht versetzt
+  (gf-make-label gf-nummer hoehe-von hoehe-bis deltaH deltaL
+                 L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg)
+  ;; ATTDEFs (unsichtbar, am Startpunkt)
+  (foreach def *gf-attrib-defs*
+    (entmake
+      (list '(0 . "ATTDEF")
+            (cons 10 startpunkt)
+            (cons 11 startpunkt)
+            '(40 . 50.0)
+            (cons 1 (cadr def))
+            (cons 2 (car def))
+            (cons 3 (car def))
+            '(70 . 1)
+            '(72 . 0)
+            '(74 . 0)))
+  )
+  ;; Alle Entities seit last-ent in Selektionssatz sammeln
+  (setq gf-ss (ssadd))
+  (setq ent (if last-ent (entnext last-ent) (entnext)))
+  (while ent
+    (ssadd ent gf-ss)
+    (setq ent (entnext ent))
+  )
+  ;; Block definieren und einfuegen
+  (setq gf-bname (strcat "GF_" (itoa gf-nummer)))
+  (command "_.-BLOCK" gf-bname startpunkt gf-ss "")
+  (command "_.INSERT" gf-bname startpunkt 1.0 1.0 0.0)
+  ;; Attribute auf das eingefuegte INSERT-Objekt setzen
+  (setq gf-insert (entlast))
+  (ssg-attrib-set-on gf-insert
+    (list
+      (cons "NUMMER"           (itoa gf-nummer))
+      (cons "TYP"              typ)
+      (cons "SEITE"            seite)
+      (cons "MONTAGEHOEHE_m"   "0.000")
+      (cons "HOEHE_VON"        (itoa (fix hoehe-von)))
+      (cons "HOEHE_BIS"        (itoa (fix hoehe-bis)))
+      (cons "DELTA_H"          (itoa (fix (abs deltaH))))
+      (cons "DELTA_L"          (itoa (fix deltaL)))
+      (cons "L_GF_m"           L-gf-str)
+      (cons "WINKEL"           (rtos (float winkel) 2 3))
+      (cons "ANZAHL_SEPARATOR" (itoa n-separator))
+      (cons "ANZAHL_SCANNER"   (itoa n-scanner))
+      (cons "GF_Bogen_L_90"    (itoa bogen-L90))
+      (cons "GF_Bogen_L_60"    (itoa bogen-L60))
+      (cons "GF_Bogen_L_30"    (itoa bogen-L30))
+      (cons "GF_Bogen_R_90"    (itoa bogen-R90))
+      (cons "GF_Bogen_R_60"    (itoa bogen-R60))
+      (cons "GF_Bogen_R_30"    (itoa bogen-R30))
+    )
+  )
+  (princ (strcat "\n>>> GF-Block erstellt: " gf-bname))
+  gf-insert
+)
+
 ;; ============================================================
 ;; TEIL 5: MODUS 1+2 - EINFACHE GEFAELLESTRECKE
 ;; ============================================================
 
-(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite /
-                                   aktueller-punkt as-block es-block endpunkt)
+;; deltaL-total: gesamte Horizontaldistanz (fuer DELTA_L-Attribut)
+(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite deltaL-total /
+                                   aktueller-punkt as-block es-block endpunkt
+                                   gf-nummer last-ent rad gf-deltaH L-gf-str
+                                   nach-aus-pt)
   (setq aktueller-punkt startpunkt)
   (setq as-block (strcat "_3D_AS_90_" seite))
   (setq es-block (strcat "_3D_ES_90_" seite))
-  (if (not *lib-initialized*) (init-bibliothek))
+  (if (not *lib-initialized*) (gf-init-bibliothek))
+
+  ;; GF-Nummer und Entity-Grenze vor erster Einfuegung
+  (setq gf-nummer (gf-next-number))
+  (setq last-ent  (entlast))
 
   (princ (strcat "\n\n1/4: " as-block))
   (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
+  (setq nach-aus-pt aktueller-punkt)
 
   (princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
                  " mm  " (itoa winkel) grad-zeichen))
@@ -1106,6 +1335,24 @@
   (princ (strcat "\n\n4/4: " es-block))
   (setq endpunkt (insert-block-by-ks es-block aktueller-punkt))
 
+  ;; Abgeleitete Werte fuer Attribute
+  (setq rad      (* (float winkel) (/ pi 180.0)))
+  (setq gf-deltaH (* L_stau (sin rad)))
+  (setq L-gf-str  (rtos (/ L_stau 1000.0) 2 3))
+
+  ;; GF_N-Block mit Attributen erstellen
+  (gf-block-erstellen
+    "standard" seite gf-nummer
+    (caddr startpunkt)
+    (- (caddr startpunkt) gf-deltaH)
+    gf-deltaH
+    (float deltaL-total)
+    L-gf-str
+    winkel
+    1 0
+    0 0 0  0 0 0
+    startpunkt last-ent nach-aus-pt 0.0 (float L_stau))
+
   (princ "\n\n=========================================")
   (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
   (princ "\n=========================================")
@@ -1126,7 +1373,7 @@
   (princ "\n=========================================")
 
   ;; Bibliothek initialisieren
-  (if (not (init-bibliothek))
+  (if (not (gf-init-bibliothek))
     (progn
       (alert "Fehler beim Initialisieren der Bibliothek!\nBitte DXFM_DATA pruefen.")
       (exit)
@@ -1234,7 +1481,7 @@
      ;; Bestaetigung
      (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
      (if (not (= antwort "2"))
-       (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen seite)
+       (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen seite deltaL)
        (princ "\nAbgebrochen.")
      )
     )