Merge

Lisp/KreiselInsert.lsp

@@ -353,8 +353,7 @@
 
   ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) ---
   ;; basePoint kann 2D oder 3D sein; INSERT uebernimmt die Z-Koordinate
-  (setq oldAttreq (getvar "ATTREQ"))
+  ;; ATTREQ/ATTDIA werden durch ssg-start/ssg-end der Aufrufer gesichert
-  (setq oldAttdia (getvar "ATTDIA"))
   (setvar "ATTREQ" 0)
   (setvar "ATTDIA" 0)
 

Lisp/OmniModulInsert.lsp

@@ -554,8 +554,176 @@
 )
 
 ;; --- Omniflo / Aluprofil Gerade ---
+
+;; Aluprofil-Fahrstrecke einfuegen.
+;;
+;; Ablauf:
+;;   1. Quell-Block (.dwg) temporaer einfuegen, Attribute lesen, loeschen
+;;   2. Nutzer waehlt Einfuegepunkt -> Text "blockname" wird horizontal platziert
+;;   3. Nutzer klickt Endpunkt -> Linie definiert Fahrstreckenlaenge und Richtung
+;;   4. Laenge wird gegen laengemax geprueft (Fehlermeldung bei Ueberschreitung)
+;;   5. Compound-Block aus Linie + ATTDEFs (mit Quell-Werten) wird erzeugt
+;;      Blockname: blockname_YYYYMMDDHHMMSS
+;;   6. Text wird gedreht, oberhalb der Linie positioniert, Inhalt aktualisiert
+;;      z.B. "APG110 L=2879"
+;;
+;; blockname = Profiltyp (z.B. "AP60", "AP110", "APG110")
+;; laengemax = Maximale Fahrstreckenlaenge in mm
+(defun omni:insert-block (blockname laengemax /
+                           pt pt2 laenge laengeStr
+                           dx dy angle angleDeg
+                           textEnt textHeight textGap
+                           perpX perpY textPt ed
+                           lastEnt ss e bname blockEnt
+                           srcAttribs attribDefs attribs
+                           ok)
+
+  (setq textHeight 100.0)
+  (setq textGap 20.0)
+
+  ;; 0. Attribute aus der Quell-.dwg lesen (vor ssg-start, da eigene INSERT/ERASE)
+  (setq srcAttribs (ssg-attrib-read-dwg (strcat *block-path* blockname ".dwg")))
+  (if (null srcAttribs)
+    (progn (princ "\n[OMNI] Keine Attribute im Quell-Block gefunden.") nil)
+    (progn
+      ;; LAENGEMAX aus Quell-Attribut lesen (falls vorhanden), sonst Parameter
+      (if (and (assoc "LAENGEMAX" srcAttribs)
+               (> (strlen (cdr (assoc "LAENGEMAX" srcAttribs))) 0))
+        (setq laengemax (atof (cdr (assoc "LAENGEMAX" srcAttribs))))
+      )
+
+      (setq pt (getpoint "\nEinfuegepunkt waehlen: "))
+      (if (null pt)
+        (progn (princ "\n[OMNI] Abgebrochen.") nil)
+        (progn
+          (ssg-start "OMNI Aluprofil" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
+          ;; ATTREQ/ATTDIA auf 0 setzen (werden durch ssg-end wiederhergestellt)
+          (setvar "ATTREQ" 0)
+          (setvar "ATTDIA" 0)
+
+          ;; 1. Text horizontal am Einfuegepunkt erzeugen
+          (entmake (list '(0 . "TEXT")
+                         (cons 8 (getvar "CLAYER"))
+                         (cons 10 (list (car pt) (cadr pt)
+                                        (if (caddr pt) (caddr pt) 0.0)))
+                         (cons 40 textHeight)
+                         (cons 1 blockname)
+                         '(50 . 0.0)))
+          (setq textEnt (entlast))
+
+          ;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung)
+          (setq ok nil)
+          (while (not ok)
+            (setq pt2 (getpoint pt "\nEndpunkt der Fahrstrecke waehlen: "))
+            (if (null pt2)
+              (progn
+                ;; Abbruch: Text loeschen
+                (command "_.ERASE" textEnt "")
+                (princ "\n[OMNI] Abgebrochen.")
+                (setq ok T pt nil)
+              )
+              (progn
+                (setq laenge (distance (list (car pt) (cadr pt))
+                                       (list (car pt2) (cadr pt2))))
+                (if (> laenge laengemax)
+                  (alert (strcat "Die gewuenschte Fahrstreckenlaenge von "
+                                 (rtos laenge 2 0) " mm ueberschreitet die Maximallaenge von "
+                                 (rtos laengemax 2 0) " mm des Fahrstreckenprofils.\n"
+                                 "Bitte neu definieren!"))
+                  (progn
+                    (setq laengeStr (rtos laenge 2 0))
+                    (setq dx (- (car pt2) (car pt))
+                          dy (- (cadr pt2) (cadr pt)))
+                    (setq angle (atan dy dx))
+                    (setq angleDeg (* (/ 180.0 pi) angle))
+
+                    ;; 3. Compound-Block: Linie bei (0,0) + ATTDEFs aus Quell-Attributen
+                    (setq lastEnt textEnt)
+
+                    ;; Linie von Ursprung bis (laenge, 0)
+                    (command "_.LINE" (list 0.0 0.0) (list laenge 0.0) "")
+
+                    ;; ATTDEFs aus Quell-Attributen erzeugen
+                    (setq attribDefs (ssg-attrib-alist-to-defs srcAttribs))
+                    (ssg-attrib-make-defs attribDefs 50.0)
+
+                    ;; Neue Entities einsammeln (alles nach textEnt)
+                    (setq ss (ssadd))
+                    (setq e (entnext lastEnt))
+                    (while e (ssadd e ss) (setq e (entnext e)))
+
+                    ;; Block mit eindeutigem Zeitstempel-Namen erzeugen
+                    (setq bname (strcat blockname "_" (ssg-timestamp)))
+                    ;; Falls Name schon existiert, Suffix anhaengen
+                    (if (tblsearch "BLOCK" bname)
+                      (setq bname (strcat bname "_" (itoa (fix (* (getvar "CDATE") 1000000)))))
+                    )
+                    (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
+
+                    ;; Block einfuegen (ATTREQ/ATTDIA bereits auf 0)
+                    (command "_.INSERT" bname pt 1 1 angleDeg)
+
+                    (setq blockEnt (entlast))
+
+                    ;; 4. Attribute setzen: Quell-Werte + LAENGE/A aktualisieren
+                    (setq attribs srcAttribs)
+                    (if (assoc "LAENGE" attribs)
+                      (setq attribs (subst (cons "LAENGE" laengeStr)
+                                           (assoc "LAENGE" attribs) attribs))
+                      (setq attribs (cons (cons "LAENGE" laengeStr) attribs))
+                    )
+                    (if (assoc "A" attribs)
+                      (setq attribs (subst (cons "A" laengeStr)
+                                           (assoc "A" attribs) attribs))
+                      (setq attribs (cons (cons "A" laengeStr) attribs))
+                    )
+                    (ssg-attrib-set-on blockEnt attribs)
+
+                    ;; 5. Text aktualisieren: oberhalb der Linie positionieren,
+                    ;;    um Linienwinkel drehen, Inhalt mit Laenge ergaenzen
+                    (setq perpX (* (- (sin angle)) textGap)
+                          perpY (* (cos angle) textGap))
+                    (setq textPt (list (+ (car pt) perpX)
+                                       (+ (cadr pt) perpY)
+                                       (if (caddr pt) (caddr pt) 0.0)))
+
+                    (setq ed (entget textEnt))
+                    (setq ed (subst (cons 10 textPt) (assoc 10 ed) ed))
+                    (if (assoc 50 ed)
+                      (setq ed (subst (cons 50 angle) (assoc 50 ed) ed))
+                      (setq ed (append ed (list (cons 50 angle))))
+                    )
+                    (setq ed (subst (cons 1 (strcat blockname " L=" laengeStr))
+                                    (assoc 1 ed) ed))
+                    (entmod ed)
+                    (entupd textEnt)
+
+                    (princ (strcat "\n[OMNI] " bname " eingefuegt. Laenge=" laengeStr " mm"))
+                    (setq ok T)
+                  )
+                )
+              )
+            )
+          )
+
+          (ssg-end)
+          pt
+        )
+      )
+    )
+  )
+)
+
+(defun c:OMNI_AP60 ()
+  (omni:insert-block "AP60" 7000.0)
+  (princ)
+)
 (defun c:OMNI_AP110 ()
-  (princ "\n[DUMMY] AP 110 Aluprofil Gerade")
+  (omni:insert-block "AP110" 6000.0)
+  (princ)
+)
+(defun c:OMNI_APG110 ()
+  (omni:insert-block "APG110" 6000.0)
   (princ)
 )
 
@@ -751,8 +919,7 @@
 ;; --- DXF-Datei als Block einfuegen ---
 ;; sivasnr-str = SivasNr als String (Dateiname ohne .dxf)
 ;; Rueckgabe: Einfuegepunkt oder nil bei Abbruch
-(defun omni:insert-dxf (sivasnr-str / dxf-pfad data-pfad pt
+(defun omni:insert-dxf (sivasnr-str / dxf-pfad data-pfad pt)
-                         oldOsnap oldCmdEcho oldLayer)
   (setq data-pfad (getenv "DXFM_DATA"))
   (if (null data-pfad)
     (progn
@@ -771,21 +938,13 @@
           (if (null pt)
             (progn (princ "\n[OMNI] Abgebrochen.") nil)
             (progn
-              ;; Einstellungen sichern
+              (ssg-start "OMNI DXF Insert" '(("OSMODE")))
-              (setq oldOsnap  (getvar "OSMODE"))
-              (setq oldCmdEcho (getvar "CMDECHO"))
-              (setq oldLayer  (getvar "CLAYER"))
-              (setvar "CMDECHO" 0)
 
               ;; Block einfuegen mit Winkelabfrage (pause)
               (command "_.INSERT" dxf-pfad pt "" "" pause)
 
-              ;; Einstellungen wiederherstellen
-              (setvar "OSMODE" oldOsnap)
-              (setvar "CMDECHO" oldCmdEcho)
-              (setvar "CLAYER" oldLayer)
-
               (princ (strcat "\n[OMNI] " sivasnr-str " eingefuegt."))
+              (ssg-end)
               pt
             )
           )

Lisp/ssg_core.lsp

@@ -181,6 +181,15 @@
 ;; BLOCK-OPERATIONEN
 ;; ------------------------------------------------------------
 
+;; Zeitstempel als YYYYMMDDHHMMSS erzeugen (fuer eindeutige Blocknamen)
+(defun ssg-timestamp ( / cd ds ts)
+  (setq cd (rtos (getvar "CDATE") 2 6))
+  ;; cd = "20260518.143052" -> Punkt entfernen
+  (setq ds (substr cd 1 8))
+  (setq ts (substr cd 10 6))
+  (strcat ds ts)
+)
+
 ;; Eindeutigen Blocknamen aus Einfuegepunkt + Zeitstempel erzeugen
 ;; pt = Einfuegepunkt (Liste); Rueckgabe: Blockname als String
 (defun ssg-make-blockname (pt / k1 k2)
@@ -347,6 +356,69 @@
   )
 )
 
+;; Attribute eines bestimmten INSERT-Entity setzen (nicht entlast).
+;; ent          = Entity-Name des INSERT-Blocks
+;; attrib-alist = (("TAG" . "Wert") ...)
+(defun ssg-attrib-set-on (ent attrib-alist / obj ed typ tag wert)
+  (setq obj (entnext ent))
+  (while obj
+    (setq ed (entget obj))
+    (setq typ (cdr (assoc 0 ed)))
+    (if (equal typ "SEQEND") (setq obj nil)
+      (progn
+        (if (equal typ "ATTRIB")
+          (progn
+            (setq tag (cdr (assoc 2 ed)))
+            (setq wert (cdr (assoc tag attrib-alist)))
+            (if (and wert (> (strlen wert) 0))
+              (progn
+                (entmod (subst (cons 1 wert) (assoc 1 ed) ed))
+                (entupd obj)
+              )
+            )
+          )
+        )
+        (setq obj (entnext obj))
+      )
+    )
+  )
+)
+
+;; Assoziationsliste in ATTDEF-Definitionsliste konvertieren.
+;; alist = (("TAG" . "Wert") ...) -> ((TAG Wert) ...)
+;; Passend fuer ssg-attrib-make-defs.
+(defun ssg-attrib-alist-to-defs (alist / result)
+  (foreach pair alist
+    (setq result (cons (list (car pair) (cdr pair)) result))
+  )
+  (reverse result)
+)
+
+;; Block (.dwg) temporaer einfuegen, Attribute lesen, Block loeschen.
+;; dwg-pfad = vollstaendiger Pfad zur .dwg Datei
+;; Rueckgabe: Assoziationsliste (("TAG" . "Wert") ...) oder nil
+(defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia)
+  (if (not (findfile dwg-pfad))
+    (progn
+      (princ (strcat "\nFEHLER: Block nicht gefunden: " dwg-pfad))
+      nil
+    )
+    (progn
+      (setq oldAttreq (getvar "ATTREQ"))
+      (setq oldAttdia (getvar "ATTDIA"))
+      (setvar "ATTREQ" 0)
+      (setvar "ATTDIA" 0)
+      (command "_.INSERT" dwg-pfad (list 0.0 0.0 0.0) 1 1 0)
+      (setvar "ATTREQ" oldAttreq)
+      (setvar "ATTDIA" oldAttdia)
+      (setq tmpEnt (entlast))
+      (setq srcAttribs (ssg-attrib-read tmpEnt))
+      (command "_.ERASE" tmpEnt "")
+      srcAttribs
+    )
+  )
+)
+
 ;; Attribut eines Blocks anhand seines Handle suchen und aendern
 ;; handle     = Entity-Handle (String) des INSERT
 ;; tag        = Attributbezeichner

menu/SSG_LIB.mnu

@@ -46,7 +46,9 @@
 [22.5]^C^COMNI_APB_550_225
 [<-180 ]^C^COMNI_APB_650_180
 [->Aluprofil Gerade]
-[<-AP 110]^C^COMNI_AP110
+[AP 60]^C^COMNI_AP60
+[AP 110]^C^COMNI_AP110
+[<-APG 110]^C^COMNI_APG110
 [->Weiche 90 Grad]
 [Einfach 90 700/700 links M]^C^COMNI_W90_Einfach
 [Doppel 90 700/700 M]^C^COMNI_W90_Doppel