From 156c2029a55e1384814011e498cd56b89b58f3e1 Mon Sep 17 00:00:00 2001 From: Michael Stangl Date: Mon, 18 May 2026 17:43:08 +0200 Subject: [PATCH] Undo Funktion mit ssg-start und ssg-end verwendet. Routinen standardisiert --- Lisp/KreiselInsert.lsp | 16 +-- Lisp/OmniModulInsert.lsp | 288 ++++++++++++++++----------------------- Lisp/ssg_core.lsp | 72 ++++++++++ 3 files changed, 199 insertions(+), 177 deletions(-) diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp index 73b7b3f..810e123 100644 --- a/Lisp/KreiselInsert.lsp +++ b/Lisp/KreiselInsert.lsp @@ -115,8 +115,7 @@ ;; Rueckgabe: Entity-Name des eingefuegten Blocks (defun draw-module (basePoint abstand rotation attribs / lastEnt ss e bname - radius pin-y is-pin - oldAttreq oldAttdia) + radius pin-y is-pin) ;; Attribute vorbereiten (setq attribs (ssg-attrib-merge attribs *kreisel-attrib-defs*)) @@ -184,13 +183,10 @@ ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) --- ;; basePoint kann 2D oder 3D sein; INSERT uebernimmt die Z-Koordinate - (setq oldAttreq (getvar "ATTREQ")) - (setq oldAttdia (getvar "ATTDIA")) + ;; ATTREQ/ATTDIA werden durch ssg-start/ssg-end der Aufrufer gesichert (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) (command "_.INSERT" bname basePoint 1 1 rotation) - (setvar "ATTREQ" oldAttreq) - (setvar "ATTDIA" oldAttdia) ;; --- Attribut-Werte setzen --- (ssg-attrib-set-many attribs) @@ -208,7 +204,7 @@ ;; -------------------------------------------- (defun c:KreiselInsert ( / pt abstand typ rotation rotStr) - (ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR"))) + (ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) ;; 1. Einfuegepunkt @@ -263,7 +259,7 @@ z1s z1e z2s z2e zCoord zTol ok msg) - (ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR"))) + (ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) (setq ok T msg nil) @@ -399,7 +395,7 @@ ;; ----------------------------------------------- (defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand) - (ssg-start "Kreisel Neu Zeichnen" '(("OSMODE") ("CECOLOR"))) + (ssg-start "Kreisel Neu Zeichnen" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) ;; 1. Bestehenden Kreisel-Block auswaehlen @@ -445,7 +441,7 @@ ;; KreiselQuick: Schnell mit Defaults (horizontal) ;; -------------------------------------------- (defun c:KreiselQuick ( / pt) - (ssg-start "Kreisel Schnell Einfuegen" '(("OSMODE") ("CECOLOR"))) + (ssg-start "Kreisel Schnell Einfuegen" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) (setq pt (getpoint "\nBasispunkt (AN-Seite): ")) (if pt diff --git a/Lisp/OmniModulInsert.lsp b/Lisp/OmniModulInsert.lsp index d84d6c6..6c7be8d 100644 --- a/Lisp/OmniModulInsert.lsp +++ b/Lisp/OmniModulInsert.lsp @@ -555,61 +555,16 @@ ;; --- Omniflo / Aluprofil Gerade --- -;; Attribut-Definitionen fuer Aluprofil-Bloecke: ((TAG DEFAULT) ...) -;; LAENGE und LAENGEMAX werden automatisch gesetzt. -(setq *omni-profil-attrib-defs* - '(("ETIKETTE" "") - ("AUFLOESE" "") - ("GRUPPE" "") - ("A" "") - ("B" "") - ("C" "") - ("BESCHR" "") - ("ARTINR" "") - ("MENGE" "") - ("POSITION" "") - ("LAENGE" "") - ("LAYER" "") - ("TLAGE" "") - ("LAENGEMAX" "")) -) - -;; Attribute eines bestimmten INSERT-Entity setzen. -;; ent = Entity-Name des INSERT-Blocks -;; attrib-alist = (("TAG" . "Wert") ...) -(defun omni: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)) - ) - ) - ) -) - ;; Aluprofil-Fahrstrecke einfuegen. ;; ;; Ablauf: -;; 1. Nutzer waehlt Einfuegepunkt -> Text "blockname" wird horizontal platziert -;; 2. Nutzer klickt Endpunkt -> Linie definiert Fahrstreckenlaenge und Richtung -;; 3. Laenge wird gegen laengemax geprueft (Fehlermeldung bei Ueberschreitung) -;; 4. Compound-Block aus Linie + Attributen wird erzeugt und eingefuegt -;; 5. Text wird gedreht, verschoben (oberhalb Linie) und Inhalt aktualisiert +;; 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") @@ -619,134 +574,142 @@ dx dy angle angleDeg textEnt textHeight textGap perpX perpY textPt ed - lastEnt ss e bname blockEnt attribs - oldOsnap oldCmdEcho oldLayer oldAttreq oldAttdia + lastEnt ss e bname blockEnt + srcAttribs attribDefs attribs ok) (setq textHeight 100.0) (setq textGap 20.0) - (setq pt (getpoint "\nEinfuegepunkt waehlen: ")) - (if (null pt) - (progn (princ "\n[OMNI] Abgebrochen.") nil) + ;; 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 - ;; Einstellungen sichern - (setq oldOsnap (getvar "OSMODE")) - (setq oldCmdEcho (getvar "CMDECHO")) - (setq oldLayer (getvar "CLAYER")) - (setvar "CMDECHO" 0) + ;; 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)))) + ) - ;; 1. Text horizontal am Einfuegepunkt erzeugen (per entmake) - (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)) + (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) - ;; 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 "") - (setvar "OSMODE" oldOsnap) - (setvar "CMDECHO" oldCmdEcho) - (setvar "CLAYER" oldLayer) - (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!")) + ;; 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 - (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)) + ;; 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 - (setq lastEnt textEnt) + ;; 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) "") + ;; Linie von Ursprung bis (laenge, 0) + (command "_.LINE" (list 0.0 0.0) (list laenge 0.0) "") - ;; Unsichtbare Attribut-Definitionen - (ssg-attrib-make-defs *omni-profil-attrib-defs* 50.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))) + ;; Neue Entities einsammeln (alles nach textEnt) + (setq ss (ssadd)) + (setq e (entnext lastEnt)) + (while e (ssadd e ss) (setq e (entnext e))) - ;; Block erzeugen - (setq bname (strcat blockname "_" - (ssg-make-blockname - (list (car pt) (cadr pt) - (if (caddr pt) (caddr pt) 0.0))))) - (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "") + ;; 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 (ohne Attribut-Dialog) - (setq oldAttreq (getvar "ATTREQ")) - (setq oldAttdia (getvar "ATTDIA")) - (setvar "ATTREQ" 0) - (setvar "ATTDIA" 0) - (command "_.INSERT" bname pt 1 1 angleDeg) - (setvar "ATTREQ" oldAttreq) - (setvar "ATTDIA" oldAttdia) + ;; Block einfuegen (ATTREQ/ATTDIA bereits auf 0) + (command "_.INSERT" bname pt 1 1 angleDeg) - (setq blockEnt (entlast)) + (setq blockEnt (entlast)) - ;; 4. Attribute setzen - (setq attribs (ssg-attrib-merge - (list (cons "LAENGE" laengeStr) - (cons "A" laengeStr) - (cons "LAENGEMAX" (rtos laengemax 2 0))) - *omni-profil-attrib-defs*)) - (omni:attrib-set-on blockEnt attribs) + ;; 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))) + ;; 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 (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) + ) ) - (setq ed (subst (cons 1 (strcat blockname " L=" laengeStr)) - (assoc 1 ed) ed)) - (entmod ed) - (entupd textEnt) - - (princ (strcat "\n[OMNI] " blockname " eingefuegt. Laenge=" laengeStr " mm")) - (setq ok T) ) ) ) + + (ssg-end) + pt ) ) - - ;; Einstellungen wiederherstellen - (setvar "OSMODE" oldOsnap) - (setvar "CMDECHO" oldCmdEcho) - (setvar "CLAYER" oldLayer) - pt ) ) ) @@ -956,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 - oldOsnap oldCmdEcho oldLayer) +(defun omni:insert-dxf (sivasnr-str / dxf-pfad data-pfad pt) (setq data-pfad (getenv "DXFM_DATA")) (if (null data-pfad) (progn @@ -976,21 +938,13 @@ (if (null pt) (progn (princ "\n[OMNI] Abgebrochen.") nil) (progn - ;; Einstellungen sichern - (setq oldOsnap (getvar "OSMODE")) - (setq oldCmdEcho (getvar "CMDECHO")) - (setq oldLayer (getvar "CLAYER")) - (setvar "CMDECHO" 0) + (ssg-start "OMNI DXF Insert" '(("OSMODE"))) ;; 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 ) ) diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp index 5ce0e8a..a2792b0 100644 --- a/Lisp/ssg_core.lsp +++ b/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