Kreisel Block enthält jetzt alle Attribute die wir auch in die csv Datei schreiben wollen. Änderung des Blocks führt zum auslesen der Attribute und zum Neuerzeugung mit den bereits gesetzten Attributen nur mit neuer Länge.

This commit is contained in:
2026-05-15 15:17:11 +02:00
parent d8283437e8
commit 86291d5479
2 changed files with 205 additions and 41 deletions
+135 -41
View File
@@ -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)
+70
View File
@@ -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