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

457 lines
15 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) (ex ey))
(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 (list (car p10) (cadr p10))
(list (car p11) (cadr 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) 0.0))))
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) ---
(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
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!")
)
)
)
;; 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
(draw-module snap1 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)
)
(princ "\nKreiselInsert.lsp geladen (Version 6.0 - Attribute + Redraw)")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselParams")
(princ)
Reference in New Issue View Git Blame Copy Permalink