;; 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 Kreisel-Nummerierung (wird in Zeichnung gespeichert) (if (null #Kreisel_LetzteNr) (setq #Kreisel_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")) ) ;; 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 ) ;; Nächste freie Kreisel-Nummer ermitteln (defun kreisel-next-number ( / maxNr tag val ss i ent attribs) (setq maxNr 0) (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KREISEL_*")))) (progn (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)) ) ) ) (if (= maxNr 0) (setq maxNr #Kreisel_LetzteNr) ) (setq #Kreisel_LetzteNr (1+ maxNr)) #Kreisel_LetzteNr ) ;; 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")) ;; AUTOMATISCHE NUMMER VERGEBEN (setq kreisel-nummer (kreisel-next-number)) (setq attribs (subst (cons "NUMMER" (itoa kreisel-nummer)) (assoc "NUMMER" 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)) ;; --- 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)) (princ) ;; Letzte Entity existiert (setq lastEnt nil) ;; Zeichnung ist leer ) ;; AN8 Kreis (Antriebsstation) bei (radius, 0) (command "_.INSERT" (strcat block-pfad "AN8.dwg") (list radius 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) 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) --- ;; basePoint kann 2D oder 3D sein; INSERT uebernimmt die Z-Koordinate ;; ATTREQ/ATTDIA werden durch ssg-start/ssg-end der Aufrufer gesichert (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) ;; 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" '(("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: 2 parallele Linien anklicken ;; ;; 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. ;; ----------------------------------------------- (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) (ssg-start "Kreisel Smart Connect" '(("CECOLOR"))) (setq ok T msg nil) (princ "\n--- Kreisel zwischen zwei parallelen Linien ---") ;; 1. Erste Linie anklicken (AN-Seite) (if ok (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!")) ) ) ) ;; 2. Zweite Linie anklicken (SP-Seite) (if ok (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!")) ) ) ) ;; 3. Geometrie auswerten (if ok (progn (setq ent1 (car sel1) pt1 (cadr sel1)) (setq ent2 (car sel2) pt2 (cadr sel2)) ;; 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)) ;; 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.")) ) (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: Einzelnen AN8-Block einfuegen ;; ;; Fuegt den Block AN8.dwg an einem gewaehlten Punkt ;; mit waehlbarer Rotation ein (Eckrad / Umlenkrad). ;; -------------------------------------------- (defun c:ILS_Eckrad ( / pt rotStr rotation) (ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA"))) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) ;; 1. Einfuegepunkt (setq pt (getpoint "\nEinfuegepunkt Eckrad: ")) (if (null pt) (progn (ssg-end) (exit))) ;; 2. Rotation (setq rotStr (getstring "\nRotation in Grad <0>: ")) (if (= rotStr "") (setq rotation 0.0) (setq rotation (atof rotStr)) ) ;; 3. AN8 einfuegen (command "_.INSERT" (strcat *block-path* "AN8.dwg") pt 1 1 rotation) (princ (strcat "\nEckrad eingefuegt bei " (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1) " Rotation=" (rtos rotation 2 1))) (ssg-end) ) ;; 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)