diff --git a/CLAUDE.md b/CLAUDE.md index 96cccfa..64a06fd 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -59,6 +59,40 @@ Werden via `bin/setenv.bat` gesetzt. Wichtigste: - Komponentendaten (Masse, Sivas-IDs) liegen als JSON in `data/json/` - Sprache im Code und Kommentaren: Deutsch +## Python-Bibliotheken + +### PyRx-Module (`lib/elemente/`) - laufen innerhalb BricsCAD via PyRx + +Abhaengigkeiten: PyRx (`PyRx`, `PyDb`, `PyGe`, `PyEd`), `wx` (wxPython fuer Dialoge). + +| Modul | Beschreibung | +|---|---| +| `elemente/utils.py` | Gemeinsame Hilfsfunktionen: Block-Pfad, Nummernvergabe (`component_next_number`), Layer/Textstil anlegen, DWG-Bloecke laden, Block mit Attributen einfuegen | +| `elemente/kreisel.py` | ILS Kreisel komplett in Python. Befehle: `KreiselInsert`, `KreiselConnect`, `KreiselRedraw`, `KreiselQuick`, `KreiselEdit`, `KreiselParams`, `KreiselLabelSetup`, `KreiselLabelPos`, `KreiselLabelHoehe`. Enthaelt `KreiselEditDialog` (wxPython, ersetzt `kreisel_edit.dcl`) | +| `elemente/eckrad.py` | ILS Eckrad in Python. Befehle: `ILS_Eckrad`, `EckradEdit`. Enthaelt `EckradEditDialog` (wxPython) | +| `elemente/dblclick.py` | Dispatcher `SSG_BLOCKEDIT` fuer Rechtsklick-Bearbeitung. Erkennt KREISEL_*/ECKRAD_* Bloecke und oeffnet passenden wx-Dialog, sonst BEDIT | + +### Standalone-Skripte (`lib/`) - laufen extern mit ezdxf + +Abhaengigkeiten: `ezdxf`, Standard-Library. Benoetigen Umgebungsvariablen (`DXFM_DATA`, `DXFM_RESULTS`, `DXFM_CFG`). + +| Skript | Beschreibung | +|---|---| +| `omniflo_utils.py` | Gemeinsame Hilfsfunktionen fuer Omniflo-Skripte: `ROW_GROUPS` (Reihen-Gruppierung), `SWITCH_FILTERS` (Schalter-Filter), `build_row_layout`, `import_element_as_block`, `draw_cross`, `load_omniflo_data` | +| `set_einfuegepkt.py` | Setzt `$INSBASE` (Einfuegepunkt) in Omniflo-DXF-Dateien. Schalter je Typ: `--boegen`, `--weichen45`, `--weichen90`, `--weichenkoerper`, `--weichen-parallel`, `--delta`, `--dreifachweiche`, `--sternweiche`, `--show-omniflo` | +| `set_koords.py` | Setzt Koordinatensystem-Bloecke (K1-K4) in Omniflo-DXF-Dateien. Schalter: `--k1set` bis `--k4set`, `--set-all`, `--force`, `--show-omniflo`, `--test`, `--number` | +| `attradd.py` | Fuegt ATTDEF-Attribute zu Omniflo-DXF-Dateien hinzu. Liest Konfiguration aus `cfg/attradd.cfg`. Schalter: `--number`, `--dry-run` | +| `export_sivas.py` | Erzeugt Sivas-Export-CSV mit Summierungszeilen (ILS Automation, Omniflo Sum). Aufruf: `python export_sivas.py ` | +| `export_csv.py` | Erzeugt einfache Item-Liste als CSV (ohne Summierung). Aufruf: `python export_csv.py ` | +| `testpycall.py` | Testskript fuer LISP-Python-Aufruf via CALLPYTHON | + +### Typische Verarbeitungskette (Omniflo-DXF) + +1. `attradd.py` - Attribute zu Quell-DXFs hinzufuegen +2. `set_einfuegepkt.py` - Einfuegepunkte berechnen und setzen +3. `set_koords.py` - Koordinatensysteme (K1-K4) setzen +4. `export_sivas.py` / `export_csv.py` - Export aus Zeichnung + ## Entwicklungsstand Siehe `doc/Entwicklungsplan.md` fuer Meilensteinplanung und Aufwandsschaetzung. diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp deleted file mode 100644 index ab57c29..0000000 --- a/Lisp/KreiselInsert.lsp +++ /dev/null @@ -1,1197 +0,0 @@ -;; KreiselInsert.lsp -;; Kreisel Modul-Einfuegesystem mit Compound-Block + Attribute -;; Version: 6.0 (Attribute, Redraw, 2-Linien-Connect) -;; Setzt ssg_core.lsp voraus. -;; ============================================ - -;; ============================================================ -;; TEIL 1: GLOBALE EINSTELLUNGEN -;; ============================================================ - -;; 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")) - -(if (or (null block-pfad) (= block-pfad "")) - (progn - (setq block-pfad "C:/Users/y.wang/Documents/dxfmakros/Blocks/") - (alert (strcat "Umgebungsvariable DXFM_BLOCKS nicht gefunden.\nNutze Standardpfad: " block-pfad)) - ) - (setq block-pfad (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" block-pfad)) "/")) -) - -(setq *block-path* block-pfad) -(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-default-hoehe* 2000.0) ;; Standard-Höhe (Z-Koordinate) - -;; Attribut-Definitionen: ((TAG DEFAULT) ...) -(setq *kreisel-attrib-defs* - '(("NAME" "") - ("DREHRICHTUNG" "UZS") - ("N_SEPARATOREN" "2") - ("KREISELART" "STANDARD") - ("N_SCANNER" "0") - ("N_RAMPEN" "0") - ("DREHUNG" "0") - ("ABSTAND" "2300") - ("NUMMER" "0") - ("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")) - -;; Beschriftungs-Einstellungen (NUR EINMAL definieren!) -(setq *kreisel-beschriftung-layer* "S_KRS_BESCHR") -(setq *kreisel-beschriftung-hoehe* 100.0) ;; Texthöhe in mm -(setq *kreisel-beschriftung-farbe* 7) ;; 7 = weiß -(setq *kreisel-beschriftung-abstand-oben* 0.0) ;; Abstand über Kreisel-Mitte -(setq *kreisel-beschriftung-schriftart* "Arial") ;; Schriftart - - -;; ============================================================ -;; TEIL 2: HILFSFUNKTIONEN -;; ============================================================ - -;; Funktion zum Erstellen/Setzen der Schriftart Arial -(defun kreisel-setup-textstyle ( / style-name) - (setq style-name "Kreisel_Arial") - - ;; Prüfen ob der Textstil bereits existiert - (if (not (tblsearch "STYLE" style-name)) - (progn - ;; Neuen Textstil mit Arial erstellen - (command "_.STYLE" style-name "Arial" 0 1 0 "N" "N" "N") - (princ (strcat "\n-> Textstil '" style-name "' mit Arial erstellt")) - ) - ) - - ;; Aktuellen Textstil setzen - (setvar "TEXTSTYLE" style-name) - style-name -) - -;; 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) - (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)) - (setq attribs (ssg-attrib-read ent)) - (setq tag (cdr (assoc "NUMMER" attribs))) - (if (and tag (setq val (atoi tag)) (> val maxNr)) - (setq maxNr val) - ) - (setq i (1+ i)) - ) - ) - (dbgp "Keine bestehenden Bloecke gefunden") - ) - (if (= maxNr 0) - (setq maxNr lastNr) - ) - (set lastNrVar (1+ maxNr)) - (setq result (eval lastNrVar)) - (dbgp (strcat "Naechste Nummer: " (itoa result))) - (dbgreturn result) -) - -;; Wrapper: Naechste Kreisel-Nummer -(defun kreisel-next-number ( / result) - (dbgf "kreisel-next-number") - (setq result (component-next-number "KREISEL_*" '#Kreisel_LetzteNr)) - (dbgreturn result) -) - -;; Wrapper: Naechste Eckrad-Nummer -(defun eckrad-next-number ( / result) - (dbgf "eckrad-next-number") - (setq result (component-next-number "ECKRAD_*" '#Eckrad_LetzteNr)) - (dbgreturn result) -) - -;; Beschriftungstext erzeugen -(defun kreisel-make-label (nummer abstand kreiselart / textStr insertPoint radius mitteX mitteY textHoehe) - ;; Text: "KREISEL 1: PIN_4000" - (setq textStr (strcat "KREISEL " (itoa nummer) ": " kreiselart "_" (rtos abstand 2 0))) - - ;; Geometrie berechnen - (setq radius (/ *kreisel-durchmesser* 2.0)) - - ;; Mitte zwischen AN8 und SP8 (X-Mitte des gesamten Kreisels) - (setq mitteX (+ radius (/ abstand 2.0))) - - ;; Y-Position: Leicht über der mitteX - (setq mitteY *kreisel-beschriftung-abstand-oben*) - - ;; Texthöhe - (setq textHoehe *kreisel-beschriftung-hoehe*) ;; 100 mm - - ;; Position - (setq insertPoint (list mitteX mitteY 0)) - - ;; Schriftart Arial einstellen - (kreisel-setup-textstyle) - - ;; Layer erstellen - (ssg-make-layer *kreisel-beschriftung-layer* (itoa *kreisel-beschriftung-farbe*) T) - - ;; Text mit entmake erstellen (zentriert) - (entmake (list - '(0 . "TEXT") - (cons 8 *kreisel-beschriftung-layer*) - (cons 10 insertPoint) - (cons 40 textHoehe) - (cons 1 textStr) - (cons 50 0.0) - (cons 7 "Kreisel_Arial") ;; Arial Textstil - (cons 62 *kreisel-beschriftung-farbe*) - '(72 . 1) ;; Horizontale Ausrichtung: Mitte - '(73 . 2) ;; Vertikale Ausrichtung: Mitte - (cons 11 insertPoint) ;; Ausrichtungspunkt - )) - - (princ (strcat "\n-> Beschriftung: " textStr " (Höhe=" (rtos textHoehe 2 0) "mm, Arial, zentriert)")) - textStr -) - -;; ... Rest Ihrer Funktionen (kreisel-ask-typ, kreisel-project-point, etc.) - -;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD" -(defun kreisel-ask-typ ( / typNum typ) - (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 "PIN")) - (t (setq typ "STANDARD")) - ) - (setq #Kreisel_Typ typ) - typ -) - -;; Punkt auf Gerade projizieren (Fusspunkt der Senkrechten) -(defun kreisel-project-point (pt lstart lend / dx dy tval) - (setq dx (- (car lend) (car lstart)) - dy (- (cadr lend) (cadr lstart))) - (setq tval (/ (+ (* (- (car pt) (car lstart)) dx) - (* (- (cadr pt) (cadr lstart)) dy)) - (+ (* dx dx) (* dy dy)))) - (list (+ (car lstart) (* tval dx)) - (+ (cadr lstart) (* tval dy))) -) - -;; Linien-Endpunkte aus LINE-Entity lesen. Rueckgabe: ((sx sy sz) (ex ey ez)) -(defun kreisel-get-line-pts (ent / ed p10 p11) - (setq ed (entget ent)) - (setq p10 (cdr (assoc 10 ed)) - p11 (cdr (assoc 11 ed))) - (list p10 p11) -) - -;; Pruefen ob zwei Richtungsvektoren parallel sind -(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)))) - len2 (sqrt (+ (* (car d2) (car d2)) (* (cadr d2) (cadr d2))))) - (< (/ cross (* len1 len2)) 0.01) -) - - -;; 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 mit Attributen, -;; fuegt ihn ein und setzt Attribut-Werte. -;; -;; basePoint = Einfuegepunkt (2D-Liste), AN-Seite -;; abstand = Tangentenlaenge zwischen Kreismitten -;; 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) -;; AN8 Zentrum bei (radius, 0) -;; SP8 Zentrum bei (radius+abstand, 0) -;; Gesamtbreite = durchmesser + abstand -;; -;; Rueckgabe: Entity-Name des eingefuegten Blocks - -(defun draw-module (basePoint abstand rotation attribs / lastEnt ss e bname - radius pin-y is-pin - oldAttreq oldAttdia - kreisel-nummer block-exists - z-hoehe block-hoehe - insertPoint block-ent - att-entity att-data att-tag new-value - beforeAtt) - - ;; 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 attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1)) - (assoc "HOEHE" attribs) attribs)) - (setq is-pin (equal (cdr (assoc "KREISELART" attribs)) "PIN")) - - ;; NUMMER: Bestehende beibehalten (Redraw/Edit), sonst neue vergeben - (setq kreisel-nummer (atoi (cdr (assoc "NUMMER" attribs)))) - (if (<= kreisel-nummer 0) - (progn - (setq kreisel-nummer (kreisel-next-number)) - (setq attribs (subst (cons "NUMMER" (itoa kreisel-nummer)) - (assoc "NUMMER" attribs) attribs)) - ) - ) - - ;; NAME automatisch setzen: "KreiselN" - (setq attribs (subst (cons "NAME" (strcat "Kreisel" (itoa kreisel-nummer))) - (assoc "NAME" attribs) attribs)) - - ;; --- HÖHE BESTIMMEN --- - ;; Priorität 1: Aus basePoint (wenn 3D Punkt mit Z > 0) - ;; Priorität 2: Aus Attribut HOEHE (wenn vorhanden) - ;; Priorität 3: Default 0 - (if (and basePoint (caddr basePoint) (> (caddr basePoint) 0)) - (progn - (setq z-hoehe (caddr basePoint)) - (setq block-hoehe (rtos z-hoehe 2 0)) - (princ (strcat "\n-> Höhe aus Basispunkt übernommen: " block-hoehe)) - ) - (progn - ;; Höhe aus Attributen lesen - (setq block-hoehe (cdr (assoc "HOEHE" attribs))) - (if (or (null block-hoehe) (= block-hoehe "")) - (setq block-hoehe "0") - ) - (setq z-hoehe (atof block-hoehe)) - ) - ) - - ;; Attribut HOEHE aktualisieren - (setq attribs (subst (cons "HOEHE" block-hoehe) - (assoc "HOEHE" attribs) attribs)) - - ;; Abgeleitete Masse - (setq radius (/ *kreisel-durchmesser* 2.0)) - (setq pin-y (- radius *kreisel-pin-abstand*)) - - ;; Blockname Format: KREISEL_1_PIN_2300 oder KREISEL_1_STANDARD_2300 - (setq bname (strcat "KREISEL_" - (itoa kreisel-nummer) "_" - (if is-pin "PIN" "STANDARD") "_" - (rtos abstand 2 0))) - - ;; Blocknamen bereinigen (Punkt durch nichts ersetzen, da wir keine Dezimalstellen wollen) - (setq bname (vl-string-subst "" "." bname)) - - ;; Pruefen ob Block bereits existiert - (setq block-exists (tblsearch "BLOCK" bname)) - - ;; ATTREQ/ATTDIA und OSMODE VOR Sub-Block-Insertions setzen, damit INSERT - ;; nicht nach Attributwerten fragt und OSNAP die Koordinaten nicht verschiebt - (setvar "ATTREQ" 0) - (setvar "ATTDIA" 0) - (setvar "OSMODE" 0) - - ;; --- Geometrie NUR zeichnen, wenn Block noch nicht existiert --- - (if (not block-exists) - (progn - ;; WICHTIG: Vor dem Zeichnen den aktuellen letzten Entity merken - ;; Aber wenn die Zeichnung leer ist, setzen wir lastEnt auf nil - (if (setq lastEnt (entlast)) - (progn - ;; Falls lastEnt ein INSERT mit Attributen ist, muessen wir - ;; bis zum SEQEND navigieren, da entnext sonst in die - ;; ATTRIB-Sub-Entities hineinlaeuft - (if (and (= (cdr (assoc 0 (entget lastEnt))) "INSERT") - (= (cdr (assoc 66 (entget lastEnt))) 1)) - (progn - (setq lastEnt (entnext lastEnt)) - (while (and lastEnt - (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND")) - (setq lastEnt (entnext lastEnt)) - ) - ;; lastEnt ist jetzt SEQEND - entnext darauf gibt das naechste Top-Level-Entity - ) - ) - ) - (setq lastEnt nil) ;; Zeichnung ist leer - ) - - ;; AN8 Kreis (Antriebsstation) bei (radius, 0) - (command "_.INSERT" (strcat block-pfad "AN8.dwg") (list radius 0.0 0.0) 1 1 0) - - ;; SP8 Kreis (Spannstation) bei (radius+abstand, 0) - (command "_.INSERT" (strcat block-pfad "SP8.dwg") (list (+ radius abstand) 0.0 0.0) 1 1 0) - - ;; Tangenten auf Layer S_LP - (ssg-make-layer "S_LP" "7" T) - (if is-pin - (setvar "CECOLOR" "5") - (setvar "CECOLOR" "1") - ) - - ;; Obere Tangente - (command "_.LINE" (list radius radius 0) (list (+ radius abstand) radius 0) "") - ;; Untere Tangente - (command "_.LINE" (list radius (- radius) 0) (list (+ radius abstand) (- radius) 0) "") - - ;; PIN-Linien - (if is-pin - (progn - (ssg-make-layer "pinbereich" "3" T) - (setvar "CECOLOR" "3") - - ;; Obere PIN-Linie - (command "_.LINE" (list *kreisel-durchmesser* pin-y 0) (list (float abstand) pin-y 0) "") - ;; Untere PIN-Linie - (command "_.LINE" (list *kreisel-durchmesser* (- pin-y) 0) (list (float abstand) (- pin-y) 0) "") - ) - ) - - ;; BESCHRIFTUNG einfügen (vor Block-Erzeugung, damit sie im Block ist) - (kreisel-make-label kreisel-nummer abstand (if is-pin "PIN" "STANDARD") ) - - ;; Unsichtbare Attribut-Definitionen erzeugen - (ssg-attrib-make-defs *kreisel-attrib-defs* 50.0) - - ;; --- Neue Entities einsammeln --- - (setq ss (ssadd)) - - ;; Korrekte Behandlung wenn lastEnt nil ist (Zeichnung war leer) - (if (null lastEnt) - (setq e (entnext)) - (setq e (entnext lastEnt)) - ) - - (while e - (ssadd e ss) - (setq e (entnext e)) - ) - - ;; --- Block erzeugen (Entities werden aus Zeichnung entfernt) --- - (if (> (sslength ss) 0) - (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "") - (princ "\nFehler: Keine Entities zum Block erstellen!") - ) - - (princ (strcat "\n-> Neue Blockdefinition: " bname)) - ) - (princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname)) - ) - - ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) --- - ;; ATTREQ/ATTDIA wurden bereits oben gesetzt - - ;; Einfügepunkt: X,Y aus basePoint, Z aus ermittelter Höhe - - (setq insertPoint (list (car basePoint) (cadr basePoint) z-hoehe)) - (command "_.INSERT" bname insertPoint 1 1 rotation) - - ;; --- Attribut-Werte durch direkte Datenbankänderung setzen --- - (setq block-ent (entlast)) - (setq att-entity (entnext block-ent)) - - (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 - (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-> Kreisel #" (itoa kreisel-nummer) " eingefügt: " bname - " (Höhe=" block-hoehe ")")) - (entlast) -) - - -;; ============================================================ -;; TEIL 4: BEFEHLE -;; ============================================================ - -;; -------------------------------------------- -;; KreiselInsert: Manuell Position + Parameter -;; -------------------------------------------- - -;; -------------------------------------------- -;; KreiselInsert: Manuell Position + Parameter -;; -------------------------------------------- -(defun c:KreiselInsert ( / pt abstand typ rotation rotStr hoehe - selectedEnt blockAttribs oldOsmode) - (ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR"))) - - ;; Temporär Osnap für Blockerkennung setzen - (setq oldOsmode (getvar "OSMODE")) - (setvar "OSMODE" (logior oldOsmode 512)) ;; 512 = INS (Block-Einfügepunkt) - - ;; 1. Einfuegepunkt - (setq pt (getpoint "\nBasispunkt (AN-Seite): ")) - (if (null pt) - (progn - (setvar "OSMODE" oldOsmode) - (ssg-end) - (princ "\nBefehl abgebrochen.") - (princ) - (return) - ) - ) - - ;; Osnap zurücksetzen auf den ursprünglichen Wert - (setvar "OSMODE" oldOsmode) - - ;; 2. Prüfen ob ein Block getroffen wurde - (setq selectedEnt (nentselp pt)) - - ;; --- HÖHE BESTIMMEN --- - (cond - ;; Fall 1: Auf einem Kreisel-Block geklickt - ((and selectedEnt - (setq selectedEnt (car selectedEnt)) - (setq blockAttribs (ssg-attrib-read selectedEnt)) - (assoc "HOEHE" blockAttribs)) - (setq hoehe (atof (cdr (assoc "HOEHE" blockAttribs)))) - (princ (strcat "\n-> Höhe von bestehendem Kreisel übernommen: " (rtos hoehe 2 0))) - ) - ;; Fall 2: Punkt hat Z-Koordinate > 0 - ((and (> (length pt) 2) (> (caddr pt) 0)) - (setq hoehe (caddr pt)) - (princ (strcat "\n-> Höhe aus 3D-Punkt übernommen: " (rtos hoehe 2 0))) - ) - ;; Fall 3: Sonst separat abfragen - (t - (setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: "))) - (if (null hoehe) (setq hoehe *kreisel-default-hoehe*)) - ) - ) - - ;; 3. Abstand - (initget 6) - (setq abstand (getdist (list (car pt) (cadr pt)) - (strcat "\nAbstand (Tangentenlaenge) <" - (rtos *kreisel-default-laenge* 2 0) ">: "))) - (if (null abstand) (setq abstand *kreisel-default-laenge*)) - (princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm")) - - ;; 4. Rotation - (setq rotStr (getstring "\nRotation in Grad <0>: ")) - (if (= rotStr "") - (setq rotation 0.0) - (setq rotation (atof rotStr)) - ) - - ;; 5. Kreiselart - (setq typ (kreisel-ask-typ)) - - (princ (strcat "\n-> Rotation: " (rtos rotation 2 1) - " Höhe: " (rtos hoehe 2 0) - " Kreiselart: " typ)) - - ;; 6. Modul einfuegen - (draw-module (list (car pt) (cadr pt) hoehe) abstand rotation - (list (cons "KREISELART" typ) - (cons "HOEHE" (rtos hoehe 2 0)))) - - ;; KEIN weiteres (setvar "OSMODE" ...) mehr nötig! - ;; ssg-end stellt nur CLAYER und CMDECHO wieder her, nicht OSMODE - - (princ "\nKreisel Modul eingefuegt.") - (ssg-end) -) - - -;; ----------------------------------------------- -;; KreiselConnect: Linie zeichnen fuer Kreisel-Platzierung -;; -;; Ablauf: -;; 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 ( / ptStart ptEnd dx dy dist abstand rotation typ hoehe) - - (ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR"))) - - (princ "\n--- Kreisel durch Linie definieren (AN -> SP) ---") - - ;; 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 - (ssg-emsg (strcat "Distanz zu klein! (" - (rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")")) - (ssg-end) - (exit) - ) - ) - - ;; 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 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))) - ) - - ;; 6. Kreiselart abfragen - (setq typ (kreisel-ask-typ)) - - (princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm" - " Rotation: " (rtos rotation 2 1) " Grad" - " Hoehe: " (rtos hoehe 2 0) - " Kreiselart: " typ)) - - ;; 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) -) - - -;; Neue Befehle für Beschriftungs-Einstellungen -(defun c:KreiselLabelPos ( / dx dy) - (setq dx (getreal (strcat "\nX-Abstand von AN8-Mitte <" (rtos *kreisel-beschriftung-abstand-x* 2 0) ">: "))) - (if dx (setq *kreisel-beschriftung-abstand-x* dx)) - (setq dy (getreal (strcat "\nY-Abstand von AN8-Mitte <" (rtos *kreisel-beschriftung-abstand-y* 2 0) ">: "))) - (if dy (setq *kreisel-beschriftung-abstand-y* dy)) - (princ (strcat "\nNeue Beschriftungsposition: X=" (rtos *kreisel-beschriftung-abstand-x* 2 0) - " Y=" (rtos *kreisel-beschriftung-abstand-y* 2 0))) - (princ) -) - -(defun c:KreiselLabelHoehe ( / h) - (setq h (getreal (strcat "\nTexthöhe <" (rtos *kreisel-beschriftung-hoehe* 2 0) ">: "))) - (if h (setq *kreisel-beschriftung-hoehe* h)) - (princ (strcat "\nNeue Texthöhe: " (rtos *kreisel-beschriftung-hoehe* 2 0))) - (princ) -) - -;; ----------------------------------------------- -;; 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" '(("CECOLOR"))) - - ;; 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)))) - - ;; NEU - Höhe aus Attributen lesen und anzeigen: - (princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs)) - " Drehung=" (cdr (assoc "DREHUNG" attribs)) - " Höhe=" (cdr (assoc "HOEHE" attribs)) ;; <-- NEU - " 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)))) - ) - ;; NEU - Neue Höhe abfragen: - (setq newHoehe (getreal (strcat "\nNeue Höhe <" (cdr (assoc "HOEHE" attribs)) ">: "))) - (if (null newHoehe) - (setq newHoehe (atof (cdr (assoc "HOEHE" attribs)))) - ) - ;; 4. Alten Block loeschen - (command "_.ERASE" ent "") - - ;; 5. Neu zeichnen mit bestehenden Attributen + neuem Abstand - (draw-module (list (car basePoint) (cadr basePoint) newHoehe) - newAbstand rotation attribs) - - (princ (strcat "\nKreisel neu gezeichnet. Abstand=" (rtos newAbstand 2 0))) - (ssg-end) -) - - -;; -------------------------------------------- -;; KreiselQuick: Schnell mit Defaults (horizontal) -;; -------------------------------------------- -(defun c:KreiselQuick ( / pt) - (ssg-start "Kreisel Schnell Einfuegen" '(("CECOLOR"))) - (setq pt (getpoint "\nBasispunkt (AN-Seite): ")) - ;; NEU - Höhe abfragen: - (setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <0>: "))) - (if (null hoehe) (setq hoehe 0.0)) - (if pt - ;; NEU - Höhe im Aufruf übergeben: - (draw-module (list (car pt) (cadr pt) hoehe) *kreisel-default-laenge* 0.0 - (list (cons "HOEHE" (rtos hoehe 2 0)))) - ) - (princ "\nSchnell Einfuegen fertig.") - (ssg-end) -) - - -;; ============================================================ -;; TEIL 5: KREISEL BEARBEITEN (DCL-Dialog) -;; ============================================================ - -;; Ausrichtungs-Definitionen: ((Label Rotation) ...) -;; Rotation in Grad: 0=rechts, 90=oben, 180=links, 270=unten -(setq *kreisel-ausrichtungen* - '(("Horizontal MS" 0.0) - ("Horizontal SM" 180.0) - ("Vertikal MS" 90.0) - ("Vertikal SM" 270.0)) -) - -;; Rotation (Grad) -> Ausrichtungs-Index (fuer popup_list) -(defun kreisel-rotation-to-idx (rot / idx i entry diff) - (setq idx 0 i 0) - (foreach entry *kreisel-ausrichtungen* - (setq diff (abs (- (rem (+ rot 360.0) 360.0) - (rem (+ (cadr entry) 360.0) 360.0)))) - (if (< diff 1.0) (setq idx i)) - (setq i (1+ i)) - ) - idx -) - -;; Ausrichtungs-Index -> Rotation (Grad) -(defun kreisel-idx-to-rotation (idx) - (cadr (nth idx *kreisel-ausrichtungen*)) -) - -;; ----------------------------------------------- -;; KreiselEdit: Bestehenden Kreisel per Dialog bearbeiten -;; -;; Ablauf: -;; 1. Kreisel-Block auswaehlen (oder vorselektiert) -;; 2. DCL-Dialog mit aktuellen Werten oeffnen -;; 3. Bei OK: Block loeschen und mit neuen Werten neu zeichnen -;; ----------------------------------------------- -(defun c:KreiselEdit ( / sel ss ent ed attribs basePoint rotation - dcl-pfad dat ergebnis - dlg-name dlg-abstand dlg-hoehe dlg-ausrichtung - dlg-drehrichtung dlg-kreiselart - newAbstand newRotation ausrichtLabels) - - ;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf) - (setq ss (ssget "I")) - (if (and ss (= (sslength ss) 1) - (= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT")) - (setq ent (ssname ss 0)) - ) - - (ssg-start "Kreisel bearbeiten" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) - (setvar "OSMODE" 0) - - ;; 1. Block auswaehlen (falls nicht vorselektiert) - (if (null ent) - (progn - (setq sel (entsel "\nKreisel-Block auswaehlen: ")) - (if sel (setq ent (car sel))) - ) - ) - (if (null ent) (progn (ssg-end) (exit))) - - (setq ed (entget ent)) - (if (/= (cdr (assoc 0 ed)) "INSERT") - (progn (ssg-emsg "Kein Block ausgewaehlt!") (ssg-end) (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)))) - - ;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND) - (if (null (assoc "ABSTAND" attribs)) - (progn - (ssg-emsg "Kein Kreisel-Block! (Attribut ABSTAND fehlt)") - (ssg-end) - (exit) - ) - ) - - ;; Fehlende Attribute mit Defaults auffuellen - (foreach def *kreisel-attrib-defs* - (if (null (assoc (car def) attribs)) - (setq attribs (append attribs (list (cons (car def) (cadr def))))) - ) - ) - - ;; HOEHE immer aus Z-Koordinate des Einfuegepunkts befuellen - (setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1)) - (assoc "HOEHE" attribs) attribs)) - - (princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs)) - " Drehung=" (rtos rotation 2 1) - " Art=" (cdr (assoc "KREISELART" attribs)))) - - ;; 3. DCL-Dialog laden - (setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl")) - (setq dat (load_dialog dcl-pfad)) - (if (not (new_dialog "kreisel_edit" dat)) - (progn (alert (strcat "Dialog nicht verfuegbar: " dcl-pfad)) (ssg-end) (exit)) - ) - - ;; Ausrichtungs-Labels fuer popup_list aufbauen - (setq ausrichtLabels "") - (foreach entry *kreisel-ausrichtungen* - (if (= ausrichtLabels "") - (setq ausrichtLabels (car entry)) - (setq ausrichtLabels (strcat ausrichtLabels "\n" (car entry))) - ) - ) - - ;; Tiles initialisieren - (set_tile "name" (cdr (assoc "NAME" attribs))) - (set_tile "abstand" (cdr (assoc "ABSTAND" attribs))) - (set_tile "hoehe" (cdr (assoc "HOEHE" attribs))) - - (start_list "ausrichtung") - (foreach entry *kreisel-ausrichtungen* - (add_list (car entry)) - ) - (end_list) - (set_tile "ausrichtung" (itoa (kreisel-rotation-to-idx rotation))) - - (start_list "drehrichtung") - (add_list "UZS") - (add_list "GUZ") - (end_list) - (set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0")) - - (start_list "kreiselart") - (add_list "STANDARD") - (add_list "PIN") - (end_list) - (set_tile "kreiselart" (if (equal (cdr (assoc "KREISELART" attribs)) "PIN") "1" "0")) - - ;; Actions - (action_tile "accept" - (strcat - "(setq dlg-name (get_tile \"name\"))" - "(setq dlg-abstand (get_tile \"abstand\"))" - "(setq dlg-hoehe (get_tile \"hoehe\"))" - "(setq dlg-ausrichtung (get_tile \"ausrichtung\"))" - "(setq dlg-drehrichtung (get_tile \"drehrichtung\"))" - "(setq dlg-kreiselart (get_tile \"kreiselart\"))" - "(done_dialog 1)" - ) - ) - (action_tile "cancel" "(done_dialog 0)") - - (setq ergebnis (start_dialog)) - (unload_dialog dat) - - ;; 4. Bei OK: Block loeschen und neu zeichnen - (if (= ergebnis 1) - (progn - ;; Werte aufbereiten - (setq newAbstand (atof dlg-abstand)) - (setq newRotation (kreisel-idx-to-rotation (atoi dlg-ausrichtung))) - - ;; Attribute aktualisieren - (setq attribs (subst (cons "NAME" dlg-name) - (assoc "NAME" attribs) attribs)) - (setq attribs (subst (cons "HOEHE" dlg-hoehe) - (assoc "HOEHE" attribs) attribs)) - (setq attribs (subst (cons "KREISELART" - (if (= dlg-kreiselart "1") "PIN" "STANDARD")) - (assoc "KREISELART" attribs) attribs)) - (setq attribs (subst (cons "DREHRICHTUNG" - (if (= dlg-drehrichtung "1") "GUZ" "UZS")) - (assoc "DREHRICHTUNG" attribs) attribs)) - - ;; Alten Block loeschen - (command "_.ERASE" ent "") - - ;; Neu zeichnen mit Z-Koordinate aus Hoehe-Dialogwert - (draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe)) - newAbstand newRotation attribs) - - (princ (strcat "\nKreisel aktualisiert: " - "Name=" dlg-name - " Abstand=" (rtos newAbstand 2 0) - " Hoehe=" dlg-hoehe - " Rotation=" (rtos newRotation 2 1))) - ) - (princ "\nAbgebrochen.") - ) - - (ssg-end) -) - - -;; -------------------------------------------- -;; KreiselParams: Aktuelle Parameter anzeigen -;; -------------------------------------------- -(defun c:KreiselParams () - (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))) - ;; NEU - Default-Höhe anzeigen: - (princ (strcat "\nDefault-Höhe: " (rtos *kreisel-default-hoehe* 2 0))) - (princ "\nAttribute im Block:") - (foreach def *kreisel-attrib-defs* - (princ (strcat "\n " (car def) " = " (cadr def))) - ) - (princ "\n=========================\n") - (princ) -) - - -;; -------------------------------------------- -;; ILS_Eckrad: Befehl - fragt Eingaben ab und fuegt Eckrad ein -;; -;; Ablauf: -;; 1. Beruehrpunkt anklicken (wo der Kreis tangential anliegen soll) -;; 2. Richtungspunkt anklicken (bestimmt Versatzrichtung zum Kreismittelpunkt) -;; 3. Kreismittelpunkt = Beruehrpunkt + Radius in Richtung des 2. Klicks -;; 4. Hoehe aus Z-Koordinate oder manuell -;; -------------------------------------------- -(defun c:ILS_Eckrad ( / ptTangent ptDir dx dy dist ux uy radius - centerPt rotation hoehe) - (dbgf "c:ILS_Eckrad") - - ;; 1. Beruehrpunkt (Tangentenpunkt) - (setq ptTangent (getpoint "\nBeruehrpunkt Eckrad (Tangente): ")) - (if (null ptTangent) (progn (dbgreturn nil) (exit))) - (dbg 'ptTangent) - - ;; 2. Richtungspunkt (Gummiband vom Beruehrpunkt) - (setq ptDir (getpoint ptTangent "\nRichtung zum Kreismittelpunkt: ")) - (if (null ptDir) (progn (dbgreturn nil) (exit))) - (dbg 'ptDir) - - ;; 3. Winkel und Versatz berechnen - (setq dx (- (car ptDir) (car ptTangent)) - dy (- (cadr ptDir) (cadr ptTangent))) - (setq dist (sqrt (+ (* dx dx) (* dy dy)))) - - (if (<= dist 0.001) - (progn - (princ "\nFehler: Beruehr- und Richtungspunkt sind identisch!") - (dbgreturn nil) - (exit) - ) - ) - - ;; Einheitsvektor in Richtung Beruehrpunkt -> Richtungspunkt - (setq ux (/ dx dist) - uy (/ dy dist)) - - ;; Radius = halber Kreisdurchmesser - (setq radius (/ *kreisel-durchmesser* 2.0)) - - ;; Kreismittelpunkt = Beruehrpunkt + Radius * Richtung - (setq centerPt (list (+ (car ptTangent) (* radius ux)) - (+ (cadr ptTangent) (* radius uy)))) - (dbg 'centerPt) - - ;; Rotation = Winkel der Versatzrichtung - (setq rotation (* (/ 180.0 pi) (atan dy dx))) - (dbg 'rotation) - - ;; 4. Hoehe bestimmen - (if (and (> (length ptTangent) 2) (caddr ptTangent) (> (caddr ptTangent) 0)) - (progn - (setq hoehe (caddr ptTangent)) - (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) - - ;; 5. Einfuegen (centerPt ist der Kreismittelpunkt) - (ils-eckrad-insert (list (car centerPt) (cadr centerPt) hoehe) rotation nil) - (dbgreturn nil) -) - -;; -------------------------------------------- -;; ils-eckrad-insert: Erzeugt Eckrad als Compound-Block mit Attributen -;; Parameter: -;; 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 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") ("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) - - ;; --- 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) - ) - - ;; 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 (entlast)) -) - -;; NEU: KreiselLabelSetup - Hier einfügen! -(defun c:KreiselLabelSetup ( / hoehe farbe abstand schriftart) - (setq hoehe (getreal (strcat "\nSchrifthöhe <" (rtos *kreisel-beschriftung-hoehe* 2 0) ">: "))) - (if hoehe (setq *kreisel-beschriftung-hoehe* hoehe)) - - (setq farbe (getint (strcat "\nSchriftfarbe (1=Rot,2=Gelb,3=Grün,4=Cyan,5=Blau,6=Magenta,7=Weiß) <" (itoa *kreisel-beschriftung-farbe*) ">: "))) - (if farbe (setq *kreisel-beschriftung-farbe* farbe)) - - (setq abstand (getreal (strcat "\nAbstand über Kreisel-Mitte <" (rtos *kreisel-beschriftung-abstand-oben* 2 0) ">: "))) - (if abstand (setq *kreisel-beschriftung-abstand-oben* abstand)) - - (princ (strcat "\nNeue Einstellungen: Höhe=" (rtos *kreisel-beschriftung-hoehe* 2 0) - ", Farbe=" (itoa *kreisel-beschriftung-farbe*) - ", Y-Versatz=" (rtos *kreisel-beschriftung-abstand-oben* 2 0) - ", Schriftart=Arial")) - (princ) -) - -(princ "\nKreiselInsert.lsp geladen (Version 7.0 - Auto-Nummerierung + Beschriftung + Attribute + Redraw + Eckrad)") -(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselEdit, KreiselQuick, KreiselParams, ILS_Eckrad") -(princ) diff --git a/dcl/kreisel_edit.dcl b/dcl/kreisel_edit.dcl deleted file mode 100644 index b715316..0000000 --- a/dcl/kreisel_edit.dcl +++ /dev/null @@ -1,53 +0,0 @@ -// ============================================================ -// 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; -}