From e85fefa7d3d9ed6932c2a9abdcc0415dd82b7d32 Mon Sep 17 00:00:00 2001 From: Michael Stangl Date: Tue, 26 May 2026 14:17:38 +0200 Subject: [PATCH] =?UTF-8?q?Eckrad=20wird=20eingef=C3=BCgt.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lisp/KreiselInsert.lsp | 429 ++++++++++++++++++++++++++--------------- dcl/kreisel_edit.dcl | 53 +++++ 2 files changed, 327 insertions(+), 155 deletions(-) create mode 100644 dcl/kreisel_edit.dcl diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp index fc83a39..f288af8 100644 --- a/Lisp/KreiselInsert.lsp +++ b/Lisp/KreiselInsert.lsp @@ -8,10 +8,13 @@ ;; TEIL 1: GLOBALE EINSTELLUNGEN ;; ============================================================ -;; Zähler für Kreisel-Nummerierung (wird in Zeichnung gespeichert) +;; Zähler für Nummerierung (werden in Zeichnung gespeichert) (if (null #Kreisel_LetzteNr) (setq #Kreisel_LetzteNr 0) ) +(if (null #Eckrad_LetzteNr) + (setq #Eckrad_LetzteNr 0) +) ;; Block-Pfad (setq block-pfad (getenv "DXFM_BLOCKS")) @@ -47,6 +50,18 @@ ("HOEHE" "0")) ) +;; Eckrad-Einstellungen +(setq *eckrad-default-hoehe* 2000.0) ;; Standard-Höhe (Z-Koordinate) + +;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...) +(setq *eckrad-attrib-defs* + '(("NAME" "") + ("DREHRICHTUNG" "UZS") + ("DREHUNG" "0") + ("NUMMER" "0") + ("HOEHE" "0")) +) + ;; Letzter gewaehlter Typ (gespeichert zwischen Aufrufen) (if (null #Kreisel_Typ) (setq #Kreisel_Typ "STANDARD")) @@ -80,11 +95,20 @@ style-name ) -;; Nächste freie Kreisel-Nummer ermitteln -(defun kreisel-next-number ( / maxNr tag val ss i ent attribs) +;; Allgemeine Nummerierung: Naechste freie Nummer fuer einen Komponententyp ermitteln +;; blockprefix = Blockname-Praefix fuer ssget (z.B. "KREISEL_*" oder "ECKRAD_*") +;; lastNrVar = Symbol der globalen Zaehler-Variable (z.B. '#Kreisel_LetzteNr) +;; Rueckgabe: naechste freie Nummer (integer) +(defun component-next-number (blockprefix lastNrVar / maxNr tag val ss i ent attribs lastNr result) + (dbgf "component-next-number") + (dbg 'blockprefix) + (dbg 'lastNrVar) (setq maxNr 0) - (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KREISEL_*")))) + (setq lastNr (eval lastNrVar)) + (dbgp (strcat "lastNr=" (itoa lastNr))) + (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blockprefix)))) (progn + (dbgp (strcat "Gefundene Bloecke: " (itoa (sslength ss)))) (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i)) @@ -96,12 +120,32 @@ (setq i (1+ i)) ) ) + (dbgp "Keine bestehenden Bloecke gefunden") ) (if (= maxNr 0) - (setq maxNr #Kreisel_LetzteNr) + (setq maxNr lastNr) ) - (setq #Kreisel_LetzteNr (1+ maxNr)) - #Kreisel_LetzteNr + (set lastNrVar (1+ maxNr)) + (setq result (eval lastNrVar)) + (dbgp (strcat "Naechste Nummer: " (itoa result))) + (dbgreturn result) + result +) + +;; Wrapper: Naechste Kreisel-Nummer +(defun kreisel-next-number ( / result) + (dbgf "kreisel-next-number") + (setq result (component-next-number "KREISEL_*" '#Kreisel_LetzteNr)) + (dbgreturn result) + result +) + +;; Wrapper: Naechste Eckrad-Nummer +(defun eckrad-next-number ( / result) + (dbgf "eckrad-next-number") + (setq result (component-next-number "ECKRAD_*" '#Eckrad_LetzteNr)) + (dbgreturn result) + result ) ;; Beschriftungstext erzeugen @@ -506,159 +550,78 @@ ;; ----------------------------------------------- -;; KreiselConnect: 2 parallele Linien anklicken +;; KreiselConnect: Linie zeichnen fuer Kreisel-Platzierung ;; ;; Ablauf: -;; 1. Erste Linie anklicken -> AN-Position (Antriebsstation) -;; 2. Zweite Linie anklicken -> SP-Seite (Spannstation) -;; 3. Richtung + Abstand werden aus der Geometrie berechnet -;; 4. Nur Kreiselart (PIN/STANDARD) wird abgefragt -;; -;; Beide Linien muessen parallel sein und gleiche Z-Koordinate haben. -;; Horizontale und vertikale Linien werden unterstuetzt. +;; 1. Startpunkt anklicken -> aeusserster AN-Punkt (Antriebsstation) +;; 2. Endpunkt anklicken -> aeusserster SP-Punkt (Spannstation) +;; 3. Abstand = Distanz - Durchmesser, Rotation aus Winkel +;; 4. Hoehe aus Z-Koordinate des Startpunkts +;; 5. Nur Kreiselart (PIN/STANDARD) wird abgefragt ;; ----------------------------------------------- -(defun c:KreiselConnect ( / sel1 ent1 pt1 sel2 ent2 pt2 - lpts1 lpts2 s1 e1 s2 e2 - dir1 dir2 snap1 foot - dx dy dist abstand rotation typ hoehe - z1s z1e z2s z2e zCoord zTol - ok msg) +(defun c:KreiselConnect ( / ptStart ptEnd dx dy dist abstand rotation typ hoehe) (ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR"))) - (setq ok T msg nil) - (princ "\n--- Kreisel zwischen zwei parallelen Linien ---") + (princ "\n--- Kreisel durch Linie definieren (AN -> SP) ---") - ;; 1. Erste Linie anklicken (AN-Seite) - (if ok + ;; 1. Startpunkt (aeusserster Punkt AN-Seite) + (setq ptStart (getpoint "\nStartpunkt (AN-Seite aussen): ")) + (if (null ptStart) + (progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit)) + ) + + ;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband + (setq ptEnd (getpoint ptStart "\nEndpunkt (SP-Seite aussen): ")) + (if (null ptEnd) + (progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit)) + ) + + ;; 3. Geometrie berechnen + (setq dx (- (car ptEnd) (car ptStart)) + dy (- (cadr ptEnd) (cadr ptStart))) + (setq dist (sqrt (+ (* dx dx) (* dy dy)))) + (setq abstand (- dist *kreisel-durchmesser*)) + + (if (<= abstand 0.0) (progn - (setq sel1 (entsel "\nErste Linie anklicken (AN-Seite): ")) - (cond - ((null sel1) - (setq ok nil)) - ((/= (cdr (assoc 0 (entget (car sel1)))) "LINE") - (setq ok nil msg "Erste Auswahl ist kein LINE-Objekt!")) - ) + (ssg-emsg (strcat "Distanz zu klein! (" + (rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")")) + (ssg-end) + (exit) ) ) - ;; 2. Zweite Linie anklicken (SP-Seite) - (if ok + ;; 4. Rotation aus Winkel Start->End + (setq rotation (* (/ 180.0 pi) (atan dy dx))) + + ;; 5. Hoehe aus Z-Koordinate des Startpunkts + (if (and (> (length ptStart) 2) (caddr ptStart)) + (setq hoehe (caddr ptStart)) + (setq hoehe 0.0) + ) + (if (<= hoehe 0.0) (progn - (setq sel2 (entsel "\nZweite Linie anklicken (SP-Seite): ")) - (cond - ((null sel2) - (setq ok nil)) - ((/= (cdr (assoc 0 (entget (car sel2)))) "LINE") - (setq ok nil msg "Zweite Auswahl ist kein LINE-Objekt!")) - ) + (setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: "))) + (if (null hoehe) (setq hoehe *kreisel-default-hoehe*)) ) + (princ (strcat "\n-> Hoehe aus Startpunkt uebernommen: " (rtos hoehe 2 0))) ) - ;; 3. Geometrie auswerten - (if ok - (progn - (setq ent1 (car sel1) pt1 (cadr sel1)) - (setq ent2 (car sel2) pt2 (cadr sel2)) + ;; 6. Kreiselart abfragen + (setq typ (kreisel-ask-typ)) - ;; Linien-Endpunkte lesen - (setq lpts1 (kreisel-get-line-pts ent1) - s1 (car lpts1) e1 (cadr lpts1)) - (setq lpts2 (kreisel-get-line-pts ent2) - s2 (car lpts2) e2 (cadr lpts2)) + (princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm" + " Rotation: " (rtos rotation 2 1) " Grad" + " Hoehe: " (rtos hoehe 2 0) + " Kreiselart: " typ)) - ;; Richtungsvektoren - (setq dir1 (list (- (car e1) (car s1)) (- (cadr e1) (cadr s1)))) - (setq dir2 (list (- (car e2) (car s2)) (- (cadr e2) (cadr s2)))) - - ;; Parallelitaet pruefen - (if (not (kreisel-parallel-p dir1 dir2)) - (setq ok nil msg "Linien sind nicht parallel!") - ) - - ;; Z-Koordinaten pruefen (alle 4 Endpunkte muessen gleiche Hoehe haben) - (if ok - (progn - (setq z1s (caddr s1) z1e (caddr e1) - z2s (caddr s2) z2e (caddr e2)) - ;; Fehlende Z-Werte als 0 behandeln - (if (null z1s) (setq z1s 0.0)) - (if (null z1e) (setq z1e 0.0)) - (if (null z2s) (setq z2s 0.0)) - (if (null z2e) (setq z2e 0.0)) - (setq zTol 0.1) - (if (or (> (abs (- z1s z1e)) zTol) - (> (abs (- z2s z2e)) zTol) - (> (abs (- z1s z2s)) zTol)) - (setq ok nil msg "Start und Ziel auf ungleicher Hoehe!") - (setq zCoord z1s) - ) - ) - ) - ) - ) - - ;; 4. Positionen und Abstand berechnen - (if ok - (progn - ;; Klickpunkt exakt auf Linie 1 projizieren - (setq snap1 (kreisel-project-point (list (car pt1) (cadr pt1)) s1 e1)) - - ;; Von snap1 senkrecht auf Linie 2 projizieren - (setq foot (kreisel-project-point snap1 s2 e2)) - - ;; Richtung und Distanz - (setq dx (- (car foot) (car snap1)) - dy (- (cadr foot) (cadr snap1))) - (setq dist (sqrt (+ (* dx dx) (* dy dy)))) - (setq abstand (- dist *kreisel-durchmesser*)) - - (if (<= abstand 0.0) - (setq ok nil - msg (strcat "Abstand zwischen Linien zu klein! (" - (rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")")) - ) - ) - ) - - ;; 5. Rotation berechnen und Modul einfuegen - (if ok - (progn - ;; Winkel von AN-Punkt (snap1) zum SP-Fusspunkt (foot) - (setq rotation (* (/ 180.0 pi) (atan dy dx))) - - ;; Höhe (Z-Koordinate) - NUR abfragen, wenn zCoord keine Höhe hat (also 0 ist) - (if (and zCoord (> zCoord 0)) - (progn - (setq hoehe zCoord) - (princ (strcat "\n-> Höhe aus Linie übernommen: " (rtos hoehe 2 0))) - ) - (progn - (setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: "))) - (if (null hoehe) (setq hoehe *kreisel-default-hoehe*)) - ) - ) - - ;; 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" - " Höhe: " (rtos hoehe 2 0) - " Kreiselart: " typ)) - - ;; Modul als Compound-Block einfuegen (mit Z-Koordinate) - ;; NEU - Höhe im Aufruf übergeben: - (draw-module (list (car snap1) (cadr snap1) hoehe) abstand rotation - (list (cons "KREISELART" typ) - (cons "HOEHE" (rtos hoehe 2 0)))) ;; <-- HOEHE Attribut - - (princ "\nKreisel Connect erfolgreich!") - ) - ;; Fehlerfall - (if msg (ssg-emsg msg) (princ "\nAbgebrochen.")) - ) + ;; 7. Modul einfuegen + (draw-module (list (car ptStart) (cadr ptStart) hoehe) abstand rotation + (list (cons "KREISELART" typ) + (cons "HOEHE" (rtos hoehe 2 0)))) + (princ "\nKreisel Connect erfolgreich!") (ssg-end) ) @@ -972,12 +935,13 @@ ;; -------------------------------------------- ;; ILS_Eckrad: Befehl - fragt Eingaben ab und fuegt Eckrad ein ;; -------------------------------------------- -(defun c:ILS_Eckrad ( / pt rotStr rotation) +(defun c:ILS_Eckrad ( / pt rotStr rotation hoehe) (dbgf "c:ILS_Eckrad") ;; 1. Einfuegepunkt (setq pt (getpoint "\nEinfuegepunkt Eckrad: ")) (if (null pt) (progn (dbgreturn nil) (exit))) + (dbg 'pt) ;; 2. Rotation (setq rotStr (getstring "\nRotation in Grad <0>: ")) @@ -985,35 +949,190 @@ (setq rotation 0.0) (setq rotation (atof rotStr)) ) + (dbg 'rotation) - ;; 3. Einfuegen - (ils-eckrad-insert pt rotation) + ;; 3. Hoehe bestimmen + (if (and (> (length pt) 2) (caddr pt) (> (caddr pt) 0)) + (progn + (setq hoehe (caddr pt)) + (princ (strcat "\n-> Hoehe aus 3D-Punkt uebernommen: " (rtos hoehe 2 0))) + ) + (progn + (setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *eckrad-default-hoehe* 2 0) ">: "))) + (if (null hoehe) (setq hoehe *eckrad-default-hoehe*)) + ) + ) + (dbg 'hoehe) + + ;; 4. Einfuegen + (ils-eckrad-insert (list (car pt) (cadr pt) hoehe) rotation nil) (dbgreturn nil) ) ;; -------------------------------------------- -;; ils-eckrad-insert: Fuegt AN8-Block an Punkt mit Rotation ein +;; ils-eckrad-insert: Erzeugt Eckrad als Compound-Block mit Attributen ;; Parameter: -;; pt - Einfuegepunkt (Liste x y [z]) +;; pt - Einfuegepunkt (Liste x y z) ;; rotation - Drehwinkel in Grad +;; attribs - alist mit Attribut-Ueberschreibungen (nil = Defaults) +;; Rueckgabe: Entity-Name des eingefuegten Blocks ;; -------------------------------------------- -(defun ils-eckrad-insert (pt rotation) +(defun ils-eckrad-insert (pt rotation attribs / lastEnt ss e bname + eckrad-nummer block-exists + z-hoehe block-hoehe + insertPoint block-ent + att-entity att-data att-tag new-value) (dbgf "ils-eckrad-insert") (dbg 'pt) (dbg 'rotation) - (ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA"))) + (ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR"))) + + ;; Attribute vorbereiten + (setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*)) + (setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1)) + (assoc "DREHUNG" attribs) attribs)) + (dbgp "Attribute nach merge vorbereitet") + + ;; Hoehe bestimmen + (if (and pt (caddr pt) (> (caddr pt) 0)) + (progn + (setq z-hoehe (caddr pt)) + (setq block-hoehe (rtos z-hoehe 2 0)) + ) + (progn + (setq block-hoehe (cdr (assoc "HOEHE" attribs))) + (if (or (null block-hoehe) (= block-hoehe "")) + (setq block-hoehe "0") + ) + (setq z-hoehe (atof block-hoehe)) + ) + ) + (setq attribs (subst (cons "HOEHE" block-hoehe) + (assoc "HOEHE" attribs) attribs)) + (dbg 'z-hoehe) + (dbg 'block-hoehe) + + ;; Automatische Nummer vergeben + (setq eckrad-nummer (eckrad-next-number)) + (setq attribs (subst (cons "NUMMER" (itoa eckrad-nummer)) + (assoc "NUMMER" attribs) attribs)) + (dbg 'eckrad-nummer) + + ;; Blockname: ECKRAD_1, ECKRAD_2, ... + (setq bname (strcat "ECKRAD_" (itoa eckrad-nummer))) + (dbg 'bname) + + ;; Pruefen ob Block bereits existiert + (setq block-exists (tblsearch "BLOCK" bname)) + (dbgp (strcat "block-exists=" (if block-exists "JA" "NEIN"))) + + ;; ATTREQ/ATTDIA und OSMODE setzen (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) + (setvar "OSMODE" 0) - (dbgp (strcat "INSERT Block: " *block-path* "AN8.dwg")) - (command "_.INSERT" (strcat *block-path* "AN8.dwg") pt 1 1 rotation) + ;; --- Geometrie NUR zeichnen, wenn Block noch nicht existiert --- + (if (not block-exists) + (progn + (dbgp "Erzeuge neue Blockdefinition...") + ;; Letzten Entity merken (mit SEQEND-Schutz wie bei draw-module) + (if (setq lastEnt (entlast)) + (progn + (dbgp (strcat "lastEnt Typ=" (cdr (assoc 0 (entget lastEnt))))) + (if (and (= (cdr (assoc 0 (entget lastEnt))) "INSERT") + (= (cdr (assoc 66 (entget lastEnt))) 1)) + (progn + (dbgp "lastEnt ist INSERT mit Attributen -> navigiere zu SEQEND") + (setq lastEnt (entnext lastEnt)) + (while (and lastEnt + (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND")) + (setq lastEnt (entnext lastEnt)) + ) + (dbgp "SEQEND erreicht") + ) + ) + ) + (setq lastEnt nil) + ) - (princ (strcat "\nEckrad eingefuegt bei " - (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1) - " Rotation=" (rtos rotation 2 1))) + ;; AN8 Block einfuegen bei (0,0) - Eckrad ist ein einzelner Kreis + (dbgp (strcat "INSERT Block: " *block-path* "AN8.dwg")) + (command "_.INSERT" (strcat *block-path* "AN8.dwg") (list 0.0 0.0 0.0) 1 1 0) + + ;; Unsichtbare Attribut-Definitionen erzeugen + (dbgp (strcat "Erzeuge " (itoa (length *eckrad-attrib-defs*)) " Attribut-Definitionen")) + (ssg-attrib-make-defs *eckrad-attrib-defs* 50.0) + + ;; Neue Entities einsammeln + (setq ss (ssadd)) + (if (null lastEnt) + (setq e (entnext)) + (setq e (entnext lastEnt)) + ) + (while e + (ssadd e ss) + (setq e (entnext e)) + ) + (dbgp (strcat "Entities eingesammelt: " (itoa (sslength ss)))) + + ;; Block erzeugen + (if (> (sslength ss) 0) + (progn + (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "") + (dbgp (strcat "Blockdefinition erzeugt: " bname)) + ) + (progn + (princ "\nFehler: Keine Entities zum Block erstellen!") + (dbgp "FEHLER: Keine Entities fuer Block!") + ) + ) + (princ (strcat "\n-> Neue Blockdefinition: " bname)) + ) + (progn + (princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname)) + (dbgp (strcat "Verwende bestehende Blockdefinition: " bname)) + ) + ) + + ;; Block am Zielpunkt einfuegen + (setq insertPoint (list (car pt) (cadr pt) z-hoehe)) + (dbg 'insertPoint) + (dbgp (strcat "INSERT " bname " bei " (rtos (car insertPoint) 2 1) + "," (rtos (cadr insertPoint) 2 1) + "," (rtos (caddr insertPoint) 2 1) + " Rotation=" (rtos rotation 2 1))) + (command "_.INSERT" bname insertPoint 1 1 rotation) + + ;; Attribut-Werte durch direkte Datenbankaenderung setzen + (setq block-ent (entlast)) + (setq att-entity (entnext block-ent)) + (dbgp "Setze Attribut-Werte:") + (while att-entity + (setq att-data (entget att-entity)) + (if (= (cdr (assoc 0 att-data)) "ATTRIB") + (progn + (setq att-tag (cdr (assoc 2 att-data))) + (setq new-value (cdr (assoc att-tag attribs))) + (if new-value + (progn + (dbgp (strcat " " att-tag "=" new-value)) + (setq att-data (subst (cons 1 new-value) (assoc 1 att-data) att-data)) + (entmod att-data) + ) + ) + ) + ) + (setq att-entity (entnext att-entity)) + ) + (entupd block-ent) + + (princ (strcat "\n-> Eckrad #" (itoa eckrad-nummer) " eingefuegt: " bname + " bei " (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1) + " Rotation=" (rtos rotation 2 1) + " Hoehe=" block-hoehe)) (ssg-end) - (dbgreturn nil) + (dbgreturn (entlast)) ) ;; NEU: KreiselLabelSetup - Hier einfügen! diff --git a/dcl/kreisel_edit.dcl b/dcl/kreisel_edit.dcl new file mode 100644 index 0000000..b715316 --- /dev/null +++ b/dcl/kreisel_edit.dcl @@ -0,0 +1,53 @@ +// ============================================================ +// kreisel_edit.dcl - Kreisel Parameter bearbeiten +// Erlaubt das Aendern von Abstand, Hoehe, Ausrichtung, +// Drehrichtung, Typ und Name eines bestehenden Kreisels. +// ============================================================ + +kreisel_edit : dialog { + label = "Kreisel bearbeiten"; + + : column { + + : edit_box { + key = "name"; + label = "Kreiselname:"; + edit_width = 30; + } + + : row { + : edit_box { + key = "abstand"; + label = "Abstand (mm):"; + edit_width = 10; + } + : edit_box { + key = "hoehe"; + label = "Hoehe (mm):"; + edit_width = 10; + } + } + + : popup_list { + key = "ausrichtung"; + label = "Ausrichtung:"; + width = 30; + } + + : row { + : popup_list { + key = "drehrichtung"; + label = "Motordrehrichtung:"; + width = 16; + } + : popup_list { + key = "kreiselart"; + label = "Typ:"; + width = 16; + } + } + + } + + ok_cancel; +}