From 86291d54792c6f0f2eabc9a8668adb9212de248d Mon Sep 17 00:00:00 2001 From: Michael Stangl Date: Fri, 15 May 2026 15:17:11 +0200 Subject: [PATCH] =?UTF-8?q?Kreisel=20Block=20enth=C3=A4lt=20jetzt=20alle?= =?UTF-8?q?=20Attribute=20die=20wir=20auch=20in=20die=20csv=20Datei=20schr?= =?UTF-8?q?eiben=20wollen.=20=C3=84nderung=20des=20Blocks=20f=C3=BChrt=20z?= =?UTF-8?q?um=20auslesen=20der=20Attribute=20und=20zum=20Neuerzeugung=20mi?= =?UTF-8?q?t=20den=20bereits=20gesetzten=20Attributen=20nur=20mit=20neuer?= =?UTF-8?q?=20L=C3=A4nge.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lisp/KreiselInsert.lsp | 176 +++++++++++++++++++++++++++++++---------- Lisp/ssg_core.lsp | 70 ++++++++++++++++ 2 files changed, 205 insertions(+), 41 deletions(-) diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp index f3ea19e..e395975 100644 --- a/Lisp/KreiselInsert.lsp +++ b/Lisp/KreiselInsert.lsp @@ -1,6 +1,6 @@ ;; KreiselInsert.lsp -;; Kreisel Modul-Einfuegesystem mit Compound-Block -;; Version: 5.0 (Compound Block + 2-Linien-Connect) +;; Kreisel Modul-Einfuegesystem mit Compound-Block + Attribute +;; Version: 6.0 (Attribute, Redraw, 2-Linien-Connect) ;; Setzt ssg_core.lsp voraus. ;; ============================================ @@ -22,35 +22,45 @@ (princ (strcat "\nBlock-Pfad aktiv: " block-pfad)) ;; Kreisel-Geometrie-Konstanten -(setq *kreisel-durchmesser* 800.0) ;; Kreisdurchmesser AN8/SP8 -(setq *kreisel-pin-abstand* 100.0) ;; Einrueckung PIN-Linie vom Kreisrand -(setq *kreisel-default-laenge* 2300.0) ;; Standard-Tangentenlaenge +(setq *kreisel-durchmesser* 800.0) ;; Kreisdurchmesser AN8/SP8 +(setq *kreisel-pin-abstand* 100.0) ;; Einrueckung PIN-Linie vom Kreisrand +(setq *kreisel-default-laenge* 2300.0) ;; Standard-Tangentenlaenge -;; Standardwerte -(if (null #Kreisel_Typ) (setq #Kreisel_Typ "PIN")) +;; Attribut-Definitionen: ((TAG DEFAULT) ...) +;; Reihenfolge = Reihenfolge der ATTDEFs im Block +(setq *kreisel-attrib-defs* + '(("DREHRICHTUNG" "UZS") + ("N_SEPARATOREN" "2") + ("KREISELART" "STANDARD") + ("N_SCANNER" "0") + ("N_RAMPEN" "0") + ("DREHUNG" "0") + ("ABSTAND" "2300")) +) + +;; Letzter gewaehlter Typ (gespeichert zwischen Aufrufen) +(if (null #Kreisel_Typ) (setq #Kreisel_Typ "STANDARD")) ;; ============================================================ ;; TEIL 2: HILFSFUNKTIONEN ;; ============================================================ -;; PIN-Typ abfragen. Rueckgabe: "PIN" oder "OhnePIN" +;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD" (defun kreisel-ask-typ ( / typNum typ) - (princ "\n[1] Kreisel mit PIN") - (princ "\n[2] Kreisel ohne PIN") - (princ (strcat "\nBitte waehlen <" (if (= #Kreisel_Typ "PIN") "1" "2") ">: ")) + (princ "\n[1] STANDARD (ohne PIN)") + (princ "\n[2] PIN") + (princ (strcat "\nBitte waehlen <" (if (= #Kreisel_Typ "PIN") "2" "1") ">: ")) (setq typNum (getstring "")) (cond - ((= typNum "2") (setq typ "OhnePIN")) - (t (setq typ "PIN")) + ((= typNum "2") (setq typ "PIN")) + (t (setq typ "STANDARD")) ) (setq #Kreisel_Typ typ) typ ) ;; Punkt auf Gerade projizieren (Fusspunkt der Senkrechten) -;; pt = beliebiger Punkt; lstart/lend = Geradenendpunkte (jeweils 2D) -;; Rueckgabe: 2D-Punkt auf der Geraden (defun kreisel-project-point (pt lstart lend / dx dy tval) (setq dx (- (car lend) (car lstart)) dy (- (cadr lend) (cadr lstart))) @@ -61,8 +71,7 @@ (+ (cadr lstart) (* tval dy))) ) -;; Linien-Endpunkte aus LINE-Entity lesen -;; Rueckgabe: ((sx sy) (ex ey)) +;; Linien-Endpunkte aus LINE-Entity lesen. Rueckgabe: ((sx sy) (ex ey)) (defun kreisel-get-line-pts (ent / ed p10 p11) (setq ed (entget ent)) (setq p10 (cdr (assoc 10 ed)) @@ -72,7 +81,6 @@ ) ;; Pruefen ob zwei Richtungsvektoren parallel sind -;; Normiertes Kreuzprodukt < Toleranz (defun kreisel-parallel-p (d1 d2 / cross len1 len2) (setq cross (abs (- (* (car d1) (cadr d2)) (* (cadr d1) (car d2)))) len1 (sqrt (+ (* (car d1) (car d1)) (* (cadr d1) (cadr d1)))) @@ -81,16 +89,23 @@ ) +;; Attribut-Funktionen: ssg-attrib-read, ssg-attrib-merge, +;; ssg-attrib-defaults, ssg-attrib-make-defs aus ssg_core.lsp + + ;; ============================================================ ;; TEIL 3: COMPOUND BLOCK ERZEUGEN UND EINFUEGEN ;; ============================================================ -;; Zeichnet Kreisel-Geometrie bei (0,0), erzeugt Block, fuegt ihn ein. +;; Zeichnet Kreisel-Geometrie bei (0,0), erzeugt Block mit Attributen, +;; fuegt ihn ein und setzt Attribut-Werte. ;; ;; basePoint = Einfuegepunkt (2D-Liste), AN-Seite ;; abstand = Tangentenlaenge zwischen Kreismitten -;; typ = "PIN" oder "OhnePIN" ;; rotation = Einfuegewinkel in Grad (0=rechts, 90=oben, 180=links, 270=unten) +;; attribs = alist mit Attribut-Ueberschreibungen (nil = alles Defaults) +;; ABSTAND und DREHUNG werden automatisch aus den Parametern gesetzt. +;; KREISELART bestimmt ob PIN-Linien gezeichnet werden. ;; ;; Blockgeometrie (bei Rotation 0, horizontal): ;; Basispunkt (0,0) = linke Kreistangente (AN-Seite) @@ -100,8 +115,17 @@ ;; ;; Rueckgabe: Entity-Name des eingefuegten Blocks -(defun draw-module (basePoint abstand typ rotation / lastEnt ss e bname - radius pin-y) +(defun draw-module (basePoint abstand rotation attribs / lastEnt ss e bname + radius pin-y is-pin + oldAttreq oldAttdia) + + ;; Attribute vorbereiten + (setq attribs (ssg-attrib-merge attribs *kreisel-attrib-defs*)) + (setq attribs (subst (cons "ABSTAND" (rtos abstand 2 0)) + (assoc "ABSTAND" attribs) attribs)) + (setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1)) + (assoc "DREHUNG" attribs) attribs)) + (setq is-pin (equal (cdr (assoc "KREISELART" attribs)) "PIN")) ;; Abgeleitete Masse (setq radius (/ *kreisel-durchmesser* 2.0)) @@ -120,7 +144,7 @@ ;; Tangenten auf Layer S_LP (ssg-make-layer "S_LP" "7" T) - (if (= typ "PIN") + (if is-pin (setvar "CECOLOR" "5") (setvar "CECOLOR" "1") ) @@ -131,7 +155,7 @@ (command "_.LINE" (list radius (- radius)) (list (+ radius abstand) (- radius)) "") ;; PIN-Linien - (if (= typ "PIN") + (if is-pin (progn (ssg-make-layer "pinbereich" "3" T) (command "_LAYER" "_LT" "2punkt" "pinbereich" "") @@ -143,6 +167,9 @@ ) ) + ;; Unsichtbare Attribut-Definitionen erzeugen + (ssg-attrib-make-defs *kreisel-attrib-defs* 50.0) + ;; --- Neue Entities einsammeln --- (setq ss (ssadd)) (setq e (entnext lastEnt)) @@ -156,8 +183,17 @@ (list (car basePoint) (cadr basePoint) 0.0)))) (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "") - ;; --- Block am Zielpunkt mit Rotation einfuegen --- + ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) --- + (setq oldAttreq (getvar "ATTREQ")) + (setq oldAttdia (getvar "ATTDIA")) + (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) (entlast) ) @@ -192,15 +228,16 @@ (setq rotation (atof rotStr)) ) - ;; 4. Typ + ;; 4. Kreiselart (setq typ (kreisel-ask-typ)) (princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " Rotation: " (rtos rotation 2 1) - " Typ: " typ)) + " Kreiselart: " typ)) - ;; 5. Modul einfuegen - (draw-module (list (car pt) (cadr pt)) abstand typ rotation) + ;; 5. Modul einfuegen (Attribute = Defaults + KREISELART) + (draw-module (list (car pt) (cadr pt)) abstand rotation + (list (cons "KREISELART" typ))) (princ "\nKreisel Modul eingefuegt.") (ssg-end) @@ -214,7 +251,7 @@ ;; 1. Erste Linie anklicken -> AN-Position (Antriebsstation) ;; 2. Zweite Linie anklicken -> SP-Seite (Spannstation) ;; 3. Richtung + Abstand werden aus der Geometrie berechnet -;; 4. Nur PIN ja/nein wird abgefragt +;; 4. Nur Kreiselart (PIN/STANDARD) wird abgefragt ;; ;; Beide Linien muessen parallel sein und gleiche Z-Koordinate haben. ;; Horizontale und vertikale Linien werden unterstuetzt. @@ -309,15 +346,16 @@ ;; Winkel von AN-Punkt (snap1) zum SP-Fusspunkt (foot) (setq rotation (* (/ 180.0 pi) (atan dy dx))) - ;; Typ abfragen (einzige Benutzer-Eingabe) + ;; Kreiselart abfragen (einzige Benutzer-Eingabe) (setq typ (kreisel-ask-typ)) (princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm" " Rotation: " (rtos rotation 2 1) " Grad" - " Typ: " typ)) + " Kreiselart: " typ)) ;; Modul als Compound-Block einfuegen - (draw-module snap1 abstand typ rotation) + (draw-module snap1 abstand rotation + (list (cons "KREISELART" typ))) (princ "\nKreisel Connect erfolgreich!") ) @@ -329,6 +367,58 @@ ) +;; ----------------------------------------------- +;; KreiselRedraw: Bestehenden Kreisel neu zeichnen +;; +;; Liest Attribute aus dem bestehenden Block, +;; loescht ihn, und zeichnet ihn mit (optional +;; geaendertem) Abstand neu. Alle Attribute bleiben +;; erhalten. +;; ----------------------------------------------- +(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand) + + (ssg-start "Kreisel Neu Zeichnen" '(("OSMODE") ("CECOLOR"))) + (setvar "OSMODE" 0) + + ;; 1. Bestehenden Kreisel-Block auswaehlen + (setq sel (entsel "\nKreisel-Block auswaehlen: ")) + (if (null sel) (exit)) + (setq ent (car sel)) + (setq ed (entget ent)) + + ;; Pruefen ob INSERT + (if (/= (cdr (assoc 0 ed)) "INSERT") + (progn (ssg-emsg "Kein Block ausgewaehlt!") (exit)) + ) + + ;; 2. Bestehende Werte auslesen + (setq attribs (ssg-attrib-read ent)) + (setq basePoint (cdr (assoc 10 ed))) + (setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed)))) + + (princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs)) + " Drehung=" (cdr (assoc "DREHUNG" attribs)) + " Art=" (cdr (assoc "KREISELART" attribs)))) + + ;; 3. Neuen Abstand abfragen (Enter = beibehalten) + (initget 6) + (setq newAbstand (getdist (strcat "\nNeuer Abstand <" (cdr (assoc "ABSTAND" attribs)) ">: "))) + (if (null newAbstand) + (setq newAbstand (atof (cdr (assoc "ABSTAND" attribs)))) + ) + + ;; 4. Alten Block loeschen + (command "_.ERASE" ent "") + + ;; 5. Neu zeichnen mit bestehenden Attributen + neuem Abstand + (draw-module (list (car basePoint) (cadr basePoint)) + newAbstand rotation attribs) + + (princ (strcat "\nKreisel neu gezeichnet. Abstand=" (rtos newAbstand 2 0))) + (ssg-end) +) + + ;; -------------------------------------------- ;; KreiselQuick: Schnell mit Defaults (horizontal) ;; -------------------------------------------- @@ -337,7 +427,7 @@ (setvar "OSMODE" 0) (setq pt (getpoint "\nBasispunkt (AN-Seite): ")) (if pt - (draw-module (list (car pt) (cadr pt)) *kreisel-default-laenge* #Kreisel_Typ 0.0) + (draw-module (list (car pt) (cadr pt)) *kreisel-default-laenge* 0.0 nil) ) (princ "\nSchnell Einfuegen fertig.") (ssg-end) @@ -348,15 +438,19 @@ ;; KreiselParams: Aktuelle Parameter anzeigen ;; -------------------------------------------- (defun c:KreiselParams () - (princ "\n=== Aktuelle Kreisel Parameter ===") - (princ (strcat "\nTyp: " #Kreisel_Typ)) - (princ "\nBasispunkt: AN-Seite (Antriebsstation)") - (princ "\nBlock: Compound (AN8 + SP8 + Tangenten + PIN)") - (princ "\n===================================\n") + (princ "\n=== Kreisel Parameter ===") + (princ (strcat "\nKreiselart: " #Kreisel_Typ)) + (princ (strcat "\nDurchmesser: " (rtos *kreisel-durchmesser* 2 0))) + (princ (strcat "\nDefault-Laenge: " (rtos *kreisel-default-laenge* 2 0))) + (princ "\nAttribute im Block:") + (foreach def *kreisel-attrib-defs* + (princ (strcat "\n " (car def) " = " (cadr def))) + ) + (princ "\n=========================\n") (princ) ) -(princ "\nKreiselInsert.lsp geladen (Version 5.0 - Compound Block)") -(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselQuick, KreiselParams") +(princ "\nKreiselInsert.lsp geladen (Version 6.0 - Attribute + Redraw)") +(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselParams") (princ) diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp index d681180..5ce0e8a 100644 --- a/Lisp/ssg_core.lsp +++ b/Lisp/ssg_core.lsp @@ -277,6 +277,76 @@ ) ) +;; Alle Attribute eines INSERT-Entity als Assoziationsliste lesen. +;; ent = Entity-Name eines INSERT mit Attributen. +;; Rueckgabe: (("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) oder nil +(defun ssg-attrib-read (ent / e ed result) + (setq e (entnext ent)) + (while e + (setq ed (entget e)) + (if (equal (cdr (assoc 0 ed)) "SEQEND") + (setq e nil) + (progn + (if (equal (cdr (assoc 0 ed)) "ATTRIB") + (setq result (cons (cons (cdr (assoc 2 ed)) (cdr (assoc 1 ed))) result)) + ) + (setq e (entnext e)) + ) + ) + ) + (reverse result) +) + +;; Default-Attribute aus einer Definitionsliste erzeugen. +;; attrib-defs = Liste von (TAG DEFAULT) Paaren, z.B. '(("TYP" "A") ("NR" "0")) +;; Rueckgabe: Assoziationsliste (("TYP" . "A") ("NR" . "0") ...) +(defun ssg-attrib-defaults (attrib-defs / result) + (foreach def attrib-defs + (setq result (cons (cons (car def) (cadr def)) result)) + ) + (reverse result) +) + +;; Gegebene Attribute mit Defaults zusammenfuehren. +;; given = alist mit Ueberschreibungen (darf nil sein) +;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...) +;; Rueckgabe: vollstaendige alist mit allen Tags +(defun ssg-attrib-merge (given attrib-defs / defaults pair existing) + (setq defaults (ssg-attrib-defaults attrib-defs)) + (if given + (foreach pair given + (setq existing (assoc (car pair) defaults)) + (if existing + (setq defaults (subst pair existing defaults)) + (setq defaults (append defaults (list pair))) + ) + ) + ) + defaults +) + +;; Unsichtbare ATTDEF-Entities bei (0,0) erzeugen. +;; Muss VOR dem _BLOCK-Befehl aufgerufen werden, damit die ATTDEFs +;; Teil der Blockdefinition werden. +;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...) +;; text-height = Texthoehe der ATTDEFs (z.B. 50.0) +(defun ssg-attrib-make-defs (attrib-defs text-height / ypos) + (setq ypos 0.0) + (foreach def attrib-defs + (entmake (list + '(0 . "ATTDEF") + '(8 . "0") + (cons 10 (list 0.0 ypos 0.0)) + (cons 40 text-height) + (cons 1 (cadr def)) + (cons 3 (car def)) + (cons 2 (car def)) + '(70 . 1) + )) + (setq ypos (- ypos (* text-height 2.0))) + ) +) + ;; Attribut eines Blocks anhand seines Handle suchen und aendern ;; handle = Entity-Handle (String) des INSERT ;; tag = Attributbezeichner