Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Undo Funktion mit ssg-start und ssg-end verwendet. Routinen standardisiert

Browse Source
This commit is contained in:
Michael Stangl
2026-05-18 17:43:08 +02:00
parent e801c84439
commit 156c2029a5
3 changed files with 199 additions and 177 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/KreiselInsert.lsp
+6 -10
View File
@@ -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
Lisp/OmniModulInsert.lsp
+121 -167
View File
@@ -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
)
)
Lisp/ssg_core.lsp
+72
View File
@@ -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