Compare commits

...

4 Commits

3 changed files with 515 additions and 239 deletions
+443 -238
View File
@@ -1,6 +1,7 @@
;; ModulInsert.lsp
;; Kreisel Modul-Einfügesystem + Smart Connect
;; Version: 4.1 (mit DXFM_BLOCKS Unterstützung)
;; KreiselInsert.lsp
;; Kreisel Modul-Einfuegesystem mit Compound-Block + Attribute
;; Version: 6.0 (Attribute, Redraw, 2-Linien-Connect)
;; Setzt ssg_core.lsp voraus.
;; ============================================
;; ============================================================
@@ -11,298 +12,502 @@
(if (or (null block-pfad) (= block-pfad ""))
(progn
(setq block-pfad "C:/Users/y.wang/Documents/dxfmakros/Blocks/") ;; Fallback oder manuell
(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))
(princ (strcat "\nBlock-Pfad aktiv: " block-pfad))
;; Standardwerte initialisieren
(if (null #Kreisel_Abstand) (setq #Kreisel_Abstand 2300.0))
(if (null #Kreisel_Typ) (setq #Kreisel_Typ "PIN"))
;; 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
;; Attribut-Definitionen: ((TAG DEFAULT) ...)
;; Reihenfolge = Reihenfolge der ATTDEFs im Block
(setq *kreisel-attrib-defs*
'(("DREHRICHTUNG" "UZS")
("N_SEPARATOREN" "2")
("KREISELART" "STANDARD")
("N_SCANNER" "0")
("N_RAMPEN" "0")
("DREHUNG" "0")
("ABSTAND" "2300"))
)
;; Letzter gewaehlter Typ (gespeichert zwischen Aufrufen)
(if (null #Kreisel_Typ) (setq #Kreisel_Typ "STANDARD"))
;; ============================================================
;; TEIL 2: HILFSFUNKTIONEN
;; ============================================================
;; ============================================
;; Haupt-Einfügebefehl (Position manuell angeben)
;; ============================================
(defun c:KreiselInsert ( / pt x y abstand typ abstandStr typNum)
(ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
(princ "Basispunkt = linke Kreistangente (links Mitte)\n")
;; 1. Einfügepunkt abfragen
(setq pt (getpoint "\nBasispunkt (linke Kreistangente): "))
(if (null pt) (setq pt '(0 0 0)))
(setq x (car pt) y (cadr pt))
;; 2. Abstand abfragen
(princ (strcat "\nAbstand <" (rtos #Kreisel_Abstand 2 0) ">: "))
(setq abstandStr (getstring ""))
(if (= abstandStr "")
(setq abstand #Kreisel_Abstand)
(setq abstand (atof abstandStr))
)
(setq #Kreisel_Abstand abstand)
;; 3. Typ abfragen
(princ "\n[1] Kreisel mit PIN")
(princ "\n[2] Kreisel ohne PIN")
(princ (strcat "\nBitte wählen <" (if (= #Kreisel_Typ "PIN") "1" "2") ">: "))
;; 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 "OhnePIN"))
(t (setq typ "PIN"))
((= typNum "2") (setq typ "PIN"))
(t (setq typ "STANDARD"))
)
(setq #Kreisel_Typ typ)
(princ (strcat "\n→ Modus: " typ))
;; Modul zeichnen
(draw-module x y abstand typ)
(princ "\n✅ Kreisel Modul erfolgreich eingefügt")
(ssg-end)
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)
)
;; ============================================
;; Smart-Connect-Einfügebefehl
;; ============================================
(defun c:KreiselConnect ( / existingObj pickPoint connectionType newX newY abstand typ abstandStr typNum newBasePoint)
(ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
;; 1. Bestehendes Modul auswählen
(setq existingObj (car (entsel "\nBestehendes Modul wählen: ")))
(if (null existingObj) (exit))
;; 2. Verbindungspunkt abfragen (Benutzer-Klickposition)
(setq pickPoint (getpoint "\nVerbindungspunkt wählen (auf Tangente klicken): "))
(if (null pickPoint) (exit))
;; 3. Verbindungspunkt-Typ erkennen
(setq connectionType (identify-connection-point existingObj pickPoint))
(princ (strcat "\n→ Verbindungspunkt: " connectionType))
;; 4. Parameter des neuen Moduls abfragen
(princ (strcat "\nAbstand <" (rtos #Kreisel_Abstand 2 0) ">: "))
(setq abstandStr (getstring ""))
(if (= abstandStr "")
(setq abstand #Kreisel_Abstand)
(setq abstand (atof abstandStr))
)
(princ "\n[1] Kreisel mit PIN")
(princ "\n[2] Kreisel ohne PIN")
(princ (strcat "\nBitte wählen <" (if (= #Kreisel_Typ "PIN") "1" "2") ">: "))
(setq typNum (getstring ""))
(cond
((= typNum "2") (setq typ "OhnePIN"))
(t (setq typ "PIN"))
)
;; 5. Basispunkt des neuen Moduls anhand der Verbindungsregeln berechnen
(setq newBasePoint (calculate-new-basepoint existingObj pickPoint connectionType abstand))
(if newBasePoint
(progn
(princ (strcat "\n→ Neue Basis: (" (rtos (car newBasePoint) 2 0) "," (rtos (cadr newBasePoint) 2 0) ")"))
(draw-module (car newBasePoint) (cadr newBasePoint) abstand typ)
(princ "\n✅ Smart Connect erfolgreich!")
)
(princ "\n❌ Verbindung nicht möglich!")
)
(ssg-end)
)
;; Attribut-Funktionen: ssg-attrib-read, ssg-attrib-merge,
;; ssg-attrib-defaults, ssg-attrib-make-defs aus ssg_core.lsp
;; ============================================
;; Verbindungspunkt-Typ erkennen
;; ============================================
(defun identify-connection-point (obj pickPoint / x y abstand insertPoint pickX pickY tolerance type)
;; Basispunkt des Moduls ermitteln (aus Einfügepunkt berechnen)
(setq insertPoint (cdr (assoc 10 (entget obj))))
(setq x (car insertPoint) y (cadr insertPoint))
;; Abstand ermitteln (sollte aus Modulattributen gelesen werden, vorerst globale Variable)
(setq abstand #Kreisel_Abstand)
(setq pickX (car pickPoint) pickY (cadr pickPoint))
(setq tolerance 50.0) ;; Toleranz 50mm
;; Verbindungspunkte pruefen
(cond
;; T_O (Mittelpunkt obere Tangente)
((and (<= (abs (- pickX (+ x 400.0 (/ abstand 2.0)))) tolerance)
(<= (abs (- pickY (+ y 400.0))) tolerance))
(setq type "T_O"))
;; ============================================================
;; TEIL 3: COMPOUND BLOCK ERZEUGEN UND EINFUEGEN
;; ============================================================
;; T_U (Mittelpunkt untere Tangente)
((and (<= (abs (- pickX (+ x 400.0 (/ abstand 2.0)))) tolerance)
(<= (abs (- pickY (- y 400.0))) tolerance))
(setq type "T_U"))
;; 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
;; M_O (Linker Kreis, oberer Rand)
((and (<= (abs (- pickX (+ x 400.0))) tolerance)
(<= (abs (- pickY (+ y 400.0))) tolerance))
(setq type "M_O"))
(defun draw-module (basePoint abstand rotation attribs / lastEnt ss e bname
radius pin-y is-pin
oldAttreq oldAttdia)
;; M_U (Linker Kreis, unterer Rand)
((and (<= (abs (- pickX (+ x 400.0))) tolerance)
(<= (abs (- pickY (- y 400.0))) tolerance))
(setq type "M_U"))
;; Attribute vorbereiten
(setq attribs (ssg-attrib-merge attribs *kreisel-attrib-defs*))
(setq attribs (subst (cons "ABSTAND" (rtos abstand 2 0))
(assoc "ABSTAND" attribs) attribs))
(setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1))
(assoc "DREHUNG" attribs) attribs))
(setq is-pin (equal (cdr (assoc "KREISELART" attribs)) "PIN"))
;; M_L (Linker Kreis, linker Rand)
((and (<= (abs (- pickX x)) tolerance)
(<= (abs (- pickY y)) tolerance))
(setq type "M_L"))
;; Abgeleitete Masse
(setq radius (/ *kreisel-durchmesser* 2.0))
(setq pin-y (- radius *kreisel-pin-abstand*))
;; S_O (Rechter Kreis, oberer Rand)
((and (<= (abs (- pickX (+ x 400.0 abstand))) tolerance)
(<= (abs (- pickY (+ y 400.0))) tolerance))
(setq type "S_O"))
;; Letzte Entity vor dem Zeichnen merken
(setq lastEnt (entlast))
;; S_U (Rechter Kreis, unterer Rand)
((and (<= (abs (- pickX (+ x 400.0 abstand))) tolerance)
(<= (abs (- pickY (- y 400.0))) tolerance))
(setq type "S_U"))
;; --- Geometrie bei Ursprung (0,0) zeichnen ---
;; S_R (Rechter Kreis, rechter Rand)
((and (<= (abs (- pickX (+ x 800.0 abstand))) tolerance)
(<= (abs (- pickY y)) tolerance))
(setq type "S_R"))
;; AN8 Kreis (Antriebsstation) bei (radius, 0)
(command "_.INSERT" (strcat block-pfad "AN8.dwg") (list radius 0.0) 1 1 0)
(t (setq type "UNKNOWN"))
)
type
)
;; SP8 Kreis (Spannstation) bei (radius+abstand, 0)
(command "_.INSERT" (strcat block-pfad "SP8.dwg") (list (+ radius abstand) 0.0) 1 1 0)
;; ============================================
;; Basispunkt des neuen Moduls berechnen
;; ============================================
(defun calculate-new-basepoint (obj pickPoint connectionType abstand / x y newX newY insertPoint)
(setq insertPoint (cdr (assoc 10 (entget obj))))
(setq x (car insertPoint) y (cadr insertPoint))
(cond
;; T_O / T_U / M_O / S_O / M_U / S_U → Verbindung nach oben oder unten, neues Modul mit S_R
((member connectionType '("T_O" "T_U" "M_O" "S_O" "M_U" "S_U"))
(princ "\n→ Richtung: nach oben/unten")
;; Bestimmen ob nach oben oder unten
(if (> (cadr pickPoint) y)
(setq newX x newY (+ y 800.0 abstand)) ;; nach oben
(setq newX x newY (- y 800.0 abstand)) ;; nach unten
)
)
;; M_L → Verbindung nach links, neues Modul mit S_R
((= connectionType "M_L")
(princ "\n→ Richtung: nach links")
(setq newX (- x 800.0 abstand) newY y)
)
;; S_R → Verbindung nach rechts, neues Modul mit M_L
((= connectionType "S_R")
(princ "\n→ Richtung: nach rechts")
(setq newX (+ x 800.0 abstand) newY y)
)
(t (setq newX nil newY nil))
)
(if (and newX newY) (list newX newY) nil)
)
;; ============================================
;; Komplettes Modul zeichnen
;; ============================================
(defun draw-module (x y abstand typ)
;; Linken Kreisblock einfügen
(command "_.INSERT" (strcat block-pfad "AN8.dwg") (list (+ x 400.0) y) 1 1 0)
;; Rechten Kreisblock einfügen
(command "_.INSERT" (strcat block-pfad "SP8.dwg") (list (+ x 400.0 abstand) y) 1 1 0)
;; Tangenten zeichnen
;; Tangenten auf Layer S_LP
(ssg-make-layer "S_LP" "7" T)
(if (= typ "PIN")
(if is-pin
(setvar "CECOLOR" "5")
(setvar "CECOLOR" "1")
)
;; Obere Tangente
(command "_.LINE"
(list (+ x 400.0) (+ y 400.0))
(list (+ x 400.0 abstand) (+ y 400.0))
"")
(command "_.LINE" (list radius radius) (list (+ radius abstand) radius) "")
;; Untere Tangente
(command "_.LINE"
(list (+ x 400.0) (- y 400.0))
(list (+ x 400.0 abstand) (- y 400.0))
"")
(command "_.LINE" (list radius (- radius)) (list (+ radius abstand) (- radius)) "")
;; PIN-Linien zeichnen
(if (= typ "PIN")
;; PIN-Linien
(if is-pin
(progn
(ssg-make-layer "pinbereich" "3" T)
(command "_LAYER" "_LT" "2punkt" "pinbereich" "")
(setvar "CECOLOR" "3")
;; Obere PIN-Linie
(command "_.LINE"
(list (+ x 800.0) (+ y 300.0))
(list (+ x abstand) (+ y 300.0))
"")
(command "_.LINE" (list *kreisel-durchmesser* pin-y) (list (float abstand) pin-y) "")
;; Untere PIN-Linie
(command "_.LINE"
(list (+ x 800.0) (- y 300.0))
(list (+ x abstand) (- y 300.0))
"")
(command "_.LINE" (list *kreisel-durchmesser* (- pin-y)) (list (float abstand) (- pin-y)) "")
)
)
;; Unsichtbare Attribut-Definitionen erzeugen
(ssg-attrib-make-defs *kreisel-attrib-defs* 50.0)
;; --- Neue Entities einsammeln ---
(setq ss (ssadd))
(setq e (entnext lastEnt))
(while e
(ssadd e ss)
(setq e (entnext e))
)
;; --- Block erzeugen (Entities werden aus Zeichnung entfernt) ---
(setq bname (strcat "KR_" (ssg-make-blockname
(list (car basePoint) (cadr basePoint)
(if (caddr basePoint) (caddr basePoint) 0.0)))))
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) ---
;; basePoint kann 2D oder 3D sein; INSERT uebernimmt die Z-Koordinate
(setq oldAttreq (getvar "ATTREQ"))
(setq oldAttdia (getvar "ATTDIA"))
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(command "_.INSERT" bname basePoint 1 1 rotation)
(setvar "ATTREQ" oldAttreq)
(setvar "ATTDIA" oldAttdia)
;; --- Attribut-Werte setzen ---
(ssg-attrib-set-many attribs)
(entlast)
)
;; ============================================
;; Hilfsbefehle
;; ============================================
;; ============================================================
;; TEIL 4: BEFEHLE
;; ============================================================
(defun c:KreiselQuick ( / pt)
(ssg-start "Kreisel Schnell Einfuegen" '(("OSMODE") ("CECOLOR")))
;; --------------------------------------------
;; KreiselInsert: Manuell Position + Parameter
;; --------------------------------------------
(defun c:KreiselInsert ( / pt abstand typ rotation rotStr)
(ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
(setq pt (getpoint "\nBasispunkt (linke Kreistangente): "))
(if pt
(draw-module (car pt) (cadr pt) #Kreisel_Abstand #Kreisel_Typ)
;; 1. Einfuegepunkt
(setq pt (getpoint "\nBasispunkt (AN-Seite): "))
(if (null pt) (exit))
;; 2. Abstand (zeigen oder tippen)
(initget 6)
(setq abstand (getdist pt (strcat "\nAbstand (Tangentenlaenge) zeigen oder eingeben <"
(rtos *kreisel-default-laenge* 2 0) ">: ")))
(if (null abstand) (setq abstand *kreisel-default-laenge*))
;; 3. Rotation
(setq rotStr (getstring "\nRotation in Grad <0>: "))
(if (= rotStr "")
(setq rotation 0.0)
(setq rotation (atof rotStr))
)
(princ "\n✅ Schnell Einfügen fertig")
;; 4. Kreiselart
(setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0)
" Rotation: " (rtos rotation 2 1)
" Kreiselart: " typ))
;; 5. Modul einfuegen (Attribute = Defaults + KREISELART)
(draw-module (list (car pt) (cadr pt)) abstand rotation
(list (cons "KREISELART" typ)))
(princ "\nKreisel Modul eingefuegt.")
(ssg-end)
)
;; -----------------------------------------------
;; 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
z1s z1e z2s z2e zCoord zTol
ok msg)
(ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
(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)))
;; 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"
" Kreiselart: " typ))
;; Modul als Compound-Block einfuegen (mit Z-Koordinate)
(draw-module (list (car snap1) (cadr snap1) zCoord)
abstand rotation
(list (cons "KREISELART" typ)))
(princ "\nKreisel Connect erfolgreich!")
)
;; Fehlerfall
(if msg (ssg-emsg msg) (princ "\nAbgebrochen."))
)
(ssg-end)
)
;; -----------------------------------------------
;; KreiselRedraw: Bestehenden Kreisel neu zeichnen
;;
;; Liest Attribute aus dem bestehenden Block,
;; loescht ihn, und zeichnet ihn mit (optional
;; geaendertem) Abstand neu. Alle Attribute bleiben
;; erhalten.
;; -----------------------------------------------
(defun c:KreiselRedraw ( / sel ent ed attribs basePoint rotation newAbstand)
(ssg-start "Kreisel Neu Zeichnen" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
;; 1. Bestehenden Kreisel-Block auswaehlen
(setq sel (entsel "\nKreisel-Block auswaehlen: "))
(if (null sel) (exit))
(setq ent (car sel))
(setq ed (entget ent))
;; Pruefen ob INSERT
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (exit))
)
;; 2. Bestehende Werte auslesen
(setq attribs (ssg-attrib-read ent))
(setq basePoint (cdr (assoc 10 ed)))
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs))
" Drehung=" (cdr (assoc "DREHUNG" attribs))
" Art=" (cdr (assoc "KREISELART" attribs))))
;; 3. Neuen Abstand abfragen (Enter = beibehalten)
(initget 6)
(setq newAbstand (getdist (strcat "\nNeuer Abstand <" (cdr (assoc "ABSTAND" attribs)) ">: ")))
(if (null newAbstand)
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
)
;; 4. Alten Block loeschen
(command "_.ERASE" ent "")
;; 5. Neu zeichnen mit bestehenden Attributen + neuem Abstand
(draw-module (list (car basePoint) (cadr basePoint))
newAbstand rotation attribs)
(princ (strcat "\nKreisel neu gezeichnet. Abstand=" (rtos newAbstand 2 0)))
(ssg-end)
)
;; --------------------------------------------
;; KreiselQuick: Schnell mit Defaults (horizontal)
;; --------------------------------------------
(defun c:KreiselQuick ( / pt)
(ssg-start "Kreisel Schnell Einfuegen" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
(setq pt (getpoint "\nBasispunkt (AN-Seite): "))
(if pt
(draw-module (list (car pt) (cadr pt)) *kreisel-default-laenge* 0.0 nil)
)
(princ "\nSchnell Einfuegen fertig.")
(ssg-end)
)
;; --------------------------------------------
;; KreiselParams: Aktuelle Parameter anzeigen
;; --------------------------------------------
(defun c:KreiselParams ()
(princ "\n=== Aktuelle Kreisel Parameter ===")
(princ (strcat "\nAbstand: " (rtos #Kreisel_Abstand 2 0) " mm"))
(princ (strcat "\nTyp: " #Kreisel_Typ))
(princ "\nBasispunkt: linke Kreistangente (links Mitte)")
(princ "\n===================================\n")
(princ "\n=== Kreisel Parameter ===")
(princ (strcat "\nKreiselart: " #Kreisel_Typ))
(princ (strcat "\nDurchmesser: " (rtos *kreisel-durchmesser* 2 0)))
(princ (strcat "\nDefault-Laenge: " (rtos *kreisel-default-laenge* 2 0)))
(princ "\nAttribute im Block:")
(foreach def *kreisel-attrib-defs*
(princ (strcat "\n " (car def) " = " (cadr def)))
)
(princ "\n=========================\n")
(princ)
)
(princ "\nKreiselInsert.lsp geladen (Version 4.2 - SSG-Lib Integration)!")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselQuick, KreiselParams")
;; --------------------------------------------
;; 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" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(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)
)
(princ "\nKreiselInsert.lsp geladen (Version 6.0 - Attribute + Redraw + Eckrad)")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselParams, ILS_Eckrad")
(princ)
+70
View File
@@ -277,6 +277,76 @@
)
)
;; Alle Attribute eines INSERT-Entity als Assoziationsliste lesen.
;; ent = Entity-Name eines INSERT mit Attributen.
;; Rueckgabe: (("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) oder nil
(defun ssg-attrib-read (ent / e ed result)
(setq e (entnext ent))
(while e
(setq ed (entget e))
(if (equal (cdr (assoc 0 ed)) "SEQEND")
(setq e nil)
(progn
(if (equal (cdr (assoc 0 ed)) "ATTRIB")
(setq result (cons (cons (cdr (assoc 2 ed)) (cdr (assoc 1 ed))) result))
)
(setq e (entnext e))
)
)
)
(reverse result)
)
;; Default-Attribute aus einer Definitionsliste erzeugen.
;; attrib-defs = Liste von (TAG DEFAULT) Paaren, z.B. '(("TYP" "A") ("NR" "0"))
;; Rueckgabe: Assoziationsliste (("TYP" . "A") ("NR" . "0") ...)
(defun ssg-attrib-defaults (attrib-defs / result)
(foreach def attrib-defs
(setq result (cons (cons (car def) (cadr def)) result))
)
(reverse result)
)
;; Gegebene Attribute mit Defaults zusammenfuehren.
;; given = alist mit Ueberschreibungen (darf nil sein)
;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...)
;; Rueckgabe: vollstaendige alist mit allen Tags
(defun ssg-attrib-merge (given attrib-defs / defaults pair existing)
(setq defaults (ssg-attrib-defaults attrib-defs))
(if given
(foreach pair given
(setq existing (assoc (car pair) defaults))
(if existing
(setq defaults (subst pair existing defaults))
(setq defaults (append defaults (list pair)))
)
)
)
defaults
)
;; Unsichtbare ATTDEF-Entities bei (0,0) erzeugen.
;; Muss VOR dem _BLOCK-Befehl aufgerufen werden, damit die ATTDEFs
;; Teil der Blockdefinition werden.
;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...)
;; text-height = Texthoehe der ATTDEFs (z.B. 50.0)
(defun ssg-attrib-make-defs (attrib-defs text-height / ypos)
(setq ypos 0.0)
(foreach def attrib-defs
(entmake (list
'(0 . "ATTDEF")
'(8 . "0")
(cons 10 (list 0.0 ypos 0.0))
(cons 40 text-height)
(cons 1 (cadr def))
(cons 3 (car def))
(cons 2 (car def))
'(70 . 1)
))
(setq ypos (- ypos (* text-height 2.0)))
)
)
;; Attribut eines Blocks anhand seines Handle suchen und aendern
;; handle = Entity-Handle (String) des INSERT
;; tag = Attributbezeichner
+2 -1
View File
@@ -4,7 +4,8 @@
[SSG_LIB]
[->ILS]
[->Kreisel-Module]
[Kreisel]^C^CKreiselInsert
[Einfuegen]^C^CKreiselInsert
[Verbinden]^C^CKreiselConnect
[<-Eckrad]^C^CILS_Eckrad
[->Zusatzmodul]
[BTMT-Beladung]^C^CILS_BTMT_Beladung