Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f18a038ff5ccaf25fa875f924343e8c33a2e114c
dxfmakros/Lisp/KreiselInsert.lsp
T
m.stangl f18a038ff5 Eckrad Erzeugung dazu
2026-05-17 23:55:26 +02:00

514 lines
17 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
;; ============================================================
(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
;; 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
;; ============================================================
;; 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)
;; 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"))
;; Abgeleitete Masse
(setq radius (/ *kreisel-durchmesser* 2.0))
(setq pin-y (- radius *kreisel-pin-abstand*))
;; Letzte Entity vor dem Zeichnen merken
(setq lastEnt (entlast))
;; --- Geometrie bei Ursprung (0,0) zeichnen ---
;; AN8 Kreis (Antriebsstation) bei (radius, 0)
(command "_.INSERT" (strcat block-pfad "AN8.dwg") (list radius 0.0) 1 1 0)
;; SP8 Kreis (Spannstation) bei (radius+abstand, 0)
(command "_.INSERT" (strcat block-pfad "SP8.dwg") (list (+ radius abstand) 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) (list (+ radius abstand) radius) "")
;; Untere Tangente
(command "_.LINE" (list radius (- radius)) (list (+ radius abstand) (- radius)) "")
;; 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 *kreisel-durchmesser* pin-y) (list (float abstand) pin-y) "")
;; Untere PIN-Linie
(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)
)
;; ============================================================
;; TEIL 4: BEFEHLE
;; ============================================================
;; --------------------------------------------
;; KreiselInsert: Manuell Position + Parameter
;; --------------------------------------------
(defun c:KreiselInsert ( / pt abstand typ rotation rotStr)
(ssg-start "Kreisel Modul einfuegen" '(("OSMODE") ("CECOLOR")))
(setvar "OSMODE" 0)
;; 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))
)
;; 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=== 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)
)
;; --------------------------------------------
;; 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)
Reference in New Issue View Git Blame Copy Permalink