Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d408f3eea747424fba3dc8ab773597f40f121c36
dxfmakros/Lisp/KreiselInsert.lsp
T

1288 lines
45 KiB
Common Lisp
Raw Blame History

;; 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 immer data/ils/2D/ (Kreisel/Eckrad Bloecke nur 2D vorhanden)
(setq block-pfad
(cond
((getenv "DXFM_DATA")
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA")) "/ils/2D/"))
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/2D/"))
(t
(princ "\n[KreiselInsert] WARNUNG: Block-Pfad nicht ermittelbar!")
nil)
)
)
(setq *block-path* block-pfad)
(if block-pfad (princ (strcat "\nBlock-Pfad: " block-pfad)))
;; ssg_core laden falls noch nicht geschehen (Schutz bei direktem Laden ohne ssg-ensure)
(if (null (car (atoms-family 1 '("SSG-CFG-OR"))))
(progn
(setq *ssg-core-datei*
(cond
((getenv "DXFM_LISP")
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
((findfile "ssg_core.lsp")
(findfile "ssg_core.lsp"))
(t nil)
)
)
(if *ssg-core-datei*
(progn
(load *ssg-core-datei*)
(if (car (atoms-family 1 '("SSG-LOAD-CONFIG"))) (ssg-load-config))
(princ (strcat "\n[KreiselInsert] ssg_core geladen: " *ssg-core-datei*))
)
(progn
(defun ssg-cfg-or (sektion schluessel standard) standard)
(defun ssg-cfg (sektion schluessel) nil)
(defun ssg-load-config () nil)
(princ "\n[KreiselInsert] WARNUNG: ssg_core.lsp nicht gefunden - Standardwerte.")
)
)
)
)
;; Kreisel-Geometrie-Konstanten (aus Config oder Fallback)
(setq *kreisel-durchmesser* (ssg-cfg-or "kreisel" "durchmesser" 800.0))
(setq *kreisel-pin-abstand* (ssg-cfg-or "kreisel" "pin_abstand" 100.0))
(setq *kreisel-default-laenge* (ssg-cfg-or "kreisel" "default_laenge" 2300.0))
(setq *kreisel-default-hoehe* (ssg-cfg-or "kreisel" "default_hoehe" 2000.0))
;; 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")
("ID" ""))
)
;; Eckrad-Einstellungen
(setq *eckrad-default-hoehe* (ssg-cfg-or "eckrad" "default_hoehe" 2000.0))
;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *eckrad-attrib-defs*
'(("NAME" "")
("DREHRICHTUNG" "UZS")
("DREHUNG" "0")
("NUMMER" "0")
("HOEHE" "0")
("ID" ""))
)
;; 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* (ssg-cfg-or "kreisel" "label_hoehe" 100.0))
(setq *kreisel-beschriftung-farbe* (ssg-cfg-or "kreisel" "label_farbe" 7))
(setq *kreisel-beschriftung-abstand-oben* (ssg-cfg-or "kreisel" "label_abstand_oben" 0.0))
(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)) (ssg-cfg-or "kreisel" "toleranz_kollinear" 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" (itoa (ssg-cfg-or "kreisel" "color_linie_1" 5)))
(setvar "CECOLOR" (itoa (ssg-cfg-or "kreisel" "color_linie_2" 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" (itoa (ssg-cfg-or "kreisel" "color_pin" 3)) T)
(setvar "CECOLOR" (itoa (ssg-cfg-or "kreisel" "color_pin" 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)
;; Eindeutige ID zuweisen
(if (atoms-family 1 '("ssg-id-generate"))
(ssg-id-generate 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)
)
;; ============================================================
;; Script-Funktionen (ohne User-Interaktion, fuer Tests)
;; ============================================================
;; Kreisel per Script einfuegen (Insert)
;; pt : Einfuegepunkt (x y z)
;; abstand : Abstand in mm
;; rotation : Drehwinkel in Grad
;; typ : Kreiselart ("STANDARD", "PIN", ...)
;; hoehe : Hoehe in mm (oder nil fuer Z aus pt)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-insert-script (pt abstand rotation typ hoehe / z blockEnt)
(ssg-start "Kreisel Script Insert" '(("OSMODE") ("CECOLOR")))
(if (null typ) (setq typ "STANDARD"))
(setq z (if hoehe hoehe
(if (and pt (caddr pt)) (caddr pt) *kreisel-default-hoehe*)))
(setq blockEnt
(draw-module (list (car pt) (cadr pt) z) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos z 2 0)))))
(ssg-end)
blockEnt
)
;; Kreisel per Script einfuegen (Connect: Start- zu Endpunkt)
;; ptStart : Startpunkt (x y z)
;; ptEnd : Endpunkt (x y z)
;; typ : Kreiselart ("STANDARD", "PIN", ...)
;; hoehe : Hoehe in mm (oder nil fuer Z aus ptStart)
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
(defun kreisel-connect-script (ptStart ptEnd typ hoehe / dx dy dist abstand rotation z blockEnt)
(ssg-start "Kreisel Script Connect" '(("OSMODE") ("CECOLOR")))
(if (null typ) (setq typ "STANDARD"))
(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 (princ (strcat "\n[Connect] Distanz zu klein: " (rtos dist 2 0)))
(ssg-end) nil)
(progn
(setq rotation (* (/ 180.0 pi) (atan dy dx)))
(setq z (if hoehe hoehe
(if (and ptStart (caddr ptStart)) (caddr ptStart) *kreisel-default-hoehe*)))
(setq blockEnt
(draw-module (list (car ptStart) (cadr ptStart) z) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos z 2 0)))))
(ssg-end) blockEnt))
)
;; Ende kreisel-connect-script
;; 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 (ssg-cfg-or "kreisel" "toleranz_winkel" 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 (ssg-cfg-or "kreisel" "toleranz_min_distanz" 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)
Reference in New Issue View Git Blame Copy Permalink