1998 lines
77 KiB
Common Lisp
1998 lines
77 KiB
Common Lisp
;; 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)
|
|
)
|
|
|
|
;; DXFM_DIM sicher lesen (type-Guard gegen nicht-String Rueckgabewerte)
|
|
(setq *ki-dxfm-dim* (getenv "DXFM_DIM"))
|
|
(if (not (= (type *ki-dxfm-dim*) 'STR)) (setq *ki-dxfm-dim* "3D"))
|
|
;; Modul-eigener Block-Pfad: seit dem Flach-Refactor liegen alle Bloecke direkt
|
|
;; unter data/ils/ (die Dimension steckt jetzt im Dateinamen, z.B. AN8_2D.dwg).
|
|
;; KI ist DXFM_DIM-abhaengig (*ki-dxfm-dim*); der Dateiname wird an der Einfuege-
|
|
;; stelle mit dem Suffix gebildet.
|
|
(setq *block-path*
|
|
(cond
|
|
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
|
|
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
|
|
"/data/ils/"))
|
|
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
|
|
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
|
|
"/data/ils/"))
|
|
(t
|
|
(princ (ssg-text "kreisel-warn-blockpfad"))
|
|
nil)
|
|
)
|
|
)
|
|
|
|
;; 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 (ssg-text "kreisel-warn-core-fehlt"))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; 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) ...)
|
|
;; Anzeige-/Attributreihenfolge im Block (ID zuerst, dann Bezeichnung,
|
|
;; ARTINR fest 6200, Montage-/Hoehendaten, dann Ausstattung).
|
|
;; NUMMER steht am Ende (wird intern fuer Nummerierung/Blockname
|
|
;; benoetigt; Entfernen erfordert Refactor der Nummernvergabe).
|
|
(setq *kreisel-attrib-defs*
|
|
'(("ID" "")
|
|
("Bezeichnung" "")
|
|
("ARTINR" "6200")
|
|
("MONTAGEHOEHE_m" "0.000")
|
|
("HOEHE" "0")
|
|
("KREISELART" "STANDARD")
|
|
("ABSTAND" "2300")
|
|
("ANZAHL_SEPARATOR" "2")
|
|
("ANZAHL_SCANNER" "0")
|
|
("ANZAHL_RAMPEN" "0")
|
|
("GERUEST_EINZELMODUL" "1")
|
|
("GERUEST_TYP" "Schoenenberger Geruest")
|
|
("DREHRICHTUNG" "UZS")
|
|
("DREHUNG" "0")
|
|
("NUMMER" "0"))
|
|
)
|
|
|
|
;; Eckrad-Einstellungen
|
|
(setq *eckrad-default-hoehe* (ssg-cfg-or "eckrad" "default_hoehe" 2000.0))
|
|
|
|
;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...)
|
|
(setq *eckrad-attrib-defs*
|
|
'(("Bezeichnung" "")
|
|
("DREHRICHTUNG" "UZS")
|
|
("DREHUNG" "0")
|
|
("NUMMER" "0")
|
|
("HOEHE" "0")
|
|
("GERUEST_EINZELMODUL" "1")
|
|
("GERUEST_TYP" "Schoenenberger Geruest")
|
|
("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 (ssg-textf "kreisel-textstil-erstellt" (list style-name)))
|
|
)
|
|
)
|
|
|
|
;; 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 (reiner Kern, in tests/test_unit.lsp getestet):
|
|
;; "KREISEL 1: Pufferkreisel PIN_4000" - mit eigenem Namen
|
|
;; "KREISEL 1: PIN_4000" - Name leer oder Vorgabe "Kreisel1"
|
|
(defun kreisel-label-text (nummer name kreiselart abstand)
|
|
(strcat "KREISEL " (itoa nummer) ": "
|
|
(if (or (null name) (= name "") (= name (strcat "Kreisel" (itoa nummer))))
|
|
""
|
|
(strcat name " "))
|
|
kreiselart "_" (rtos abstand 2 0))
|
|
)
|
|
|
|
;; Beschriftung in einer BESTEHENDEN Blockdefinition auf textStr setzen.
|
|
;; draw-module verwendet eine vorhandene Definition KREISEL_n_TYP_ABSTAND
|
|
;; wieder (Edit/Redraw) - ein geaenderter Name kaeme sonst nie in die
|
|
;; Beschriftung. Wirkt auf alle Referenzen dieser Definition.
|
|
(defun kreisel-label-aktualisieren (bname textStr / e ed)
|
|
(setq e (tblobjname "BLOCK" bname))
|
|
(while (setq e (entnext e))
|
|
(setq ed (entget e))
|
|
(if (and (= (cdr (assoc 0 ed)) "TEXT")
|
|
(/= (cdr (assoc 1 ed)) textStr))
|
|
(entmod (subst (cons 1 textStr) (assoc 1 ed) ed))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Beschriftungstext erzeugen
|
|
(defun kreisel-make-label (nummer abstand kreiselart name / textStr insertPoint radius mitteX mitteY textHoehe lay)
|
|
(setq textStr (kreisel-label-text nummer name kreiselart abstand))
|
|
|
|
;; 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: bevorzugt aus cfg/layer.cfg (Baugruppe
|
|
;; "kreisel_beschriftung"), sonst der bisherige Hartwert.
|
|
(setq lay (ssg-layer-anlegen "kreisel_beschriftung" T))
|
|
(if (null lay)
|
|
(progn
|
|
(setq lay *kreisel-beschriftung-layer*)
|
|
(ssg-make-layer lay (itoa *kreisel-beschriftung-farbe*) T)
|
|
)
|
|
)
|
|
|
|
;; Text mit entmake erstellen (zentriert)
|
|
(entmake (list
|
|
'(0 . "TEXT")
|
|
(cons 8 lay)
|
|
(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 (ssg-textf "kreisel-beschriftung-erzeugt" (list textStr (rtos textHoehe 2 0))))
|
|
textStr
|
|
)
|
|
|
|
;; ... Rest Ihrer Funktionen (kreisel-ask-typ, kreisel-project-point, etc.)
|
|
|
|
;; Kreiselart abfragen. Rueckgabe: "PIN" oder "STANDARD"
|
|
(defun kreisel-ask-typ ( / typNum typ)
|
|
(princ (ssg-text "kreisel-typ-opt-standard"))
|
|
(princ (ssg-text "kreisel-typ-opt-pin"))
|
|
(princ (ssg-textf "kreisel-typ-prompt" (list (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))
|
|
)
|
|
|
|
|
|
;; --- Drehrichtungspfeil (data/ils/Drehrichtungspfeil.dwg) ---
|
|
;; Die DWG ist fuer einen Kreisel Nord -> Sued (AN oben, SP unten, also
|
|
;; Einfuegewinkel 270) und Drehrichtung im Uhrzeigersinn gezeichnet.
|
|
;; Im Block liegt der Kreisel entlang +X (Winkel 0); die Drehung des
|
|
;; Kreisels kommt ueber den Einfuegewinkel des KREISEL_n-Blocks automatisch
|
|
;; dazu. Der Pfeil wird daher im Block um 0 - 270 = 90 Grad gedreht.
|
|
(setq *kreisel-pfeil-block* "Drehrichtungspfeil")
|
|
(setq *kreisel-pfeil-winkel* (ssg-cfg-or "kreisel" "pfeil_winkel" 90.0))
|
|
|
|
;; X-Skalierung des Pfeils: UZS -> 1, GUZ -> -1 (Spiegelung an der eigenen
|
|
;; Y-Achse, die Pfeilspitze zeigt dann in die Gegenrichtung).
|
|
(defun kreisel-pfeil-xskal (drehrichtung)
|
|
(if (equal drehrichtung "GUZ") -1.0 1.0)
|
|
)
|
|
|
|
;; Reiner Kern: Einfuegeparameter beider Pfeile im Block-KS des Kreisels.
|
|
;; Rueckgabe: ((punkt winkel xskal) (punkt winkel xskal)) - AN8, dann SP8
|
|
;; (SP8 um 180 Grad gedreht).
|
|
(defun kreisel-pfeil-params (radius abstand drehrichtung / xs)
|
|
(setq xs (kreisel-pfeil-xskal drehrichtung))
|
|
(list (list (list radius 0.0 0.0) *kreisel-pfeil-winkel* xs)
|
|
(list (list (+ radius abstand) 0.0 0.0)
|
|
(rem (+ *kreisel-pfeil-winkel* 180.0) 360.0) xs))
|
|
)
|
|
|
|
;; Reiner Kern fuers Eckrad: ein Pfeil auf der Radmitte (Block-Ursprung),
|
|
;; ausgerichtet wie der AN8-Pfeil eines Kreisels gleicher Drehung.
|
|
(defun eckrad-pfeil-params (drehrichtung)
|
|
(list (list (list 0.0 0.0 0.0) *kreisel-pfeil-winkel*
|
|
(kreisel-pfeil-xskal drehrichtung)))
|
|
)
|
|
|
|
;; Einen Pfeil einfuegen. Ab dem zweiten Mal per Blockname, damit INSERT
|
|
;; nicht nach dem Neudefinieren der bestehenden Definition fragt.
|
|
(defun kreisel-pfeil-einfuegen (pt winkel xs)
|
|
(command "_.INSERT"
|
|
(if (tblsearch "BLOCK" *kreisel-pfeil-block*)
|
|
*kreisel-pfeil-block*
|
|
(strcat *block-path* *kreisel-pfeil-block* ".dwg"))
|
|
pt xs 1.0 winkel)
|
|
)
|
|
|
|
;; Alle Pfeile einer Parameterliste ((punkt winkel xskal) ...) einfuegen
|
|
;; (beim Aufbau der Blockdefinition). Fehlt die DWG, wird ohne Pfeil gebaut.
|
|
(defun kreisel-pfeile-einfuegen (params)
|
|
(if (findfile (strcat *block-path* *kreisel-pfeil-block* ".dwg"))
|
|
(foreach p params
|
|
(kreisel-pfeil-einfuegen (car p) (cadr p) (caddr p))
|
|
)
|
|
(princ (ssg-textf "kreisel-warn-pfeil-fehlt" (list *kreisel-pfeil-block*)))
|
|
)
|
|
)
|
|
|
|
;; Spiegelung der Pfeile in einer BESTEHENDEN Blockdefinition KREISEL_n_...
|
|
;; nachziehen (Edit/Redraw mit geaenderter DREHRICHTUNG - der Blockname
|
|
;; enthaelt die Drehrichtung nicht, die Definition wird wiederverwendet).
|
|
;; Wirkt wie kreisel-label-aktualisieren auf alle Referenzen der Definition.
|
|
(defun kreisel-pfeil-aktualisieren (bname drehrichtung / e ed xs)
|
|
(setq xs (kreisel-pfeil-xskal drehrichtung))
|
|
(setq e (tblobjname "BLOCK" bname))
|
|
(while (setq e (entnext e))
|
|
(setq ed (entget e))
|
|
(if (and (= (cdr (assoc 0 ed)) "INSERT")
|
|
(= (strcase (cdr (assoc 2 ed))) (strcase *kreisel-pfeil-block*))
|
|
(not (equal (cdr (assoc 41 ed)) xs 1e-9)))
|
|
(entmod (subst (cons 41 xs) (assoc 41 ed) ed))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
;; 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))
|
|
)
|
|
)
|
|
|
|
;; Bezeichnung: eigener Name (KreiselEdit) bleibt erhalten, sonst Vorgabe "KreiselN"
|
|
(if (member (cdr (assoc "Bezeichnung" attribs)) '(nil ""))
|
|
(setq attribs (subst (cons "Bezeichnung" (strcat "Kreisel" (itoa kreisel-nummer)))
|
|
(assoc "Bezeichnung" 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 (ssg-textf "kreisel-hoehe-aus-basispunkt" (list 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))
|
|
|
|
;; Montagehoehe in Metern ableiten (Default = HOEHE / 1000, mm->m).
|
|
;; Bleibt ein normales Attribut und kann vom Benutzer geaendert werden.
|
|
(setq attribs (subst (cons "MONTAGEHOEHE_m" (rtos (/ z-hoehe 1000.0) 2 3))
|
|
(assoc "MONTAGEHOEHE_m" 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
|
|
;; (SEQEND-Schutz fuer INSERT mit Attributen, nil bei leerer Zeichnung)
|
|
(setq lastEnt (ssg-lastent-ohne-attribute))
|
|
|
|
;; AN8 Kreis (Antriebsstation) bei (radius, 0) - Dim-Suffix im Dateinamen
|
|
(command "_.INSERT" (strcat *block-path* "AN8_" *ki-dxfm-dim* ".dwg") (list radius 0.0 0.0) 1 1 0)
|
|
|
|
;; SP8 Kreis (Spannstation) bei (radius+abstand, 0) - Dim-Suffix im Dateinamen
|
|
(command "_.INSERT" (strcat *block-path* "SP8_" *ki-dxfm-dim* ".dwg") (list (+ radius abstand) 0.0 0.0) 1 1 0)
|
|
|
|
;; Drehrichtungspfeile auf AN8- und SP8-Mitte (SP8 um 180 Grad gedreht,
|
|
;; GUZ gespiegelt). Fehlt die DWG, wird der Kreisel ohne Pfeil gebaut.
|
|
(kreisel-pfeile-einfuegen
|
|
(kreisel-pfeil-params radius abstand (cdr (assoc "DREHRICHTUNG" attribs))))
|
|
|
|
;; Tangenten-Layer: bevorzugt aus cfg/layer.cfg (Baugruppe
|
|
;; "kreisel_tangente"), sonst der bisherige Hartwert S_LP.
|
|
(if (null (ssg-layer-anlegen "kreisel_tangente" T))
|
|
(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
|
|
;; PIN-Layer: bevorzugt aus cfg/layer.cfg (Baugruppe
|
|
;; "kreisel_pinbereich"), sonst der bisherige Hartwert pinbereich.
|
|
(if (null (ssg-layer-anlegen "kreisel_pinbereich" T))
|
|
(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")
|
|
(cdr (assoc "Bezeichnung" attribs)))
|
|
|
|
;; 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 (ssg-text "kreisel-fehler-keine-entities"))
|
|
)
|
|
|
|
(princ (ssg-textf "kreisel-neue-blockdef" (list bname)))
|
|
)
|
|
(progn
|
|
(princ (ssg-textf "kreisel-bestehende-blockdef" (list bname)))
|
|
;; Beschriftung der wiederverwendeten Definition an den Namen anpassen
|
|
(kreisel-label-aktualisieren bname
|
|
(kreisel-label-text kreisel-nummer (cdr (assoc "Bezeichnung" attribs))
|
|
(if is-pin "PIN" "STANDARD") abstand))
|
|
;; ebenso die Spiegelung der Drehrichtungspfeile
|
|
(kreisel-pfeil-aktualisieren bname (cdr (assoc "DREHRICHTUNG" attribs)))
|
|
)
|
|
)
|
|
|
|
;; --- 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))
|
|
;; Ziel-Layer der Baugruppe aus cfg/layer.cfg. Wichtig: der Wrapper hing
|
|
;; bisher am CLAYER-Seiteneffekt von ssg-make-layer (S_LP bzw. pinbereich)
|
|
;; und landete bei bereits vorhandener Blockdefinition auf dem aktiven Layer -
|
|
;; jetzt ist er in beiden Faellen gleich. Ohne cfg-Eintrag bleibt es beim
|
|
;; bisherigen Verhalten.
|
|
(ssg-layer-setzen block-ent (if is-pin "kreisel_pin" "kreisel"))
|
|
(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 (ssg-textf "kreisel-eingefuegt" (list (itoa kreisel-nummer) bname block-hoehe)))
|
|
(entlast)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; TEIL 4: BEFEHLE
|
|
;; ============================================================
|
|
|
|
;; --------------------------------------------
|
|
;; KreiselInsert: Manuell Position + Parameter
|
|
;; --------------------------------------------
|
|
|
|
;; Reiner Kern: Abstand und Rotation aus Basispunkt und gezeigtem Punkt der
|
|
;; Abstands-Abfrage (Gummiband-Linie, 2D in der XY-Ebene).
|
|
;; Ohne Punkt (Enter) -> Vorgabe-Abstand, Rotation 0.
|
|
;; Rueckgabe: (abstand rotation-in-grad), Rotation in [0, 360)
|
|
(defun kreisel-insert-richtung (pt p2 vorgabe / a)
|
|
(if (and p2 (> (distance (list (car pt) (cadr pt)) (list (car p2) (cadr p2))) 1e-6))
|
|
(progn
|
|
(setq a (* (/ 180.0 pi) (angle (list (car pt) (cadr pt)) (list (car p2) (cadr p2)))))
|
|
(list (distance (list (car pt) (cadr pt)) (list (car p2) (cadr p2)))
|
|
(if (>= a 359.9999999) 0.0 a))
|
|
)
|
|
(list vorgabe 0.0)
|
|
)
|
|
)
|
|
|
|
;; --------------------------------------------
|
|
;; KreiselInsert: Manuell Position + Parameter
|
|
;; Abfrage: 1. Basispunkt (AN-Seite), 2. Abstand als Gummiband-Linie - die
|
|
;; Richtung der Linie ist zugleich die Rotation (Wert tippen = direkte
|
|
;; Distanzeingabe in Zeigerichtung), 3. Hoehe (Vorgabe aus angeklicktem
|
|
;; Block bzw. Z des Basispunkts), 4. Kreiselart.
|
|
;; --------------------------------------------
|
|
(defun c:KreiselInsert ( / pt p2 erg abstand typ rotation hoehe hoehe-vorgabe
|
|
selectedEnt blockAttribs oldOsmode)
|
|
(ssg-start (ssg-text "kreisel-start-insert") '(("OSMODE") ("CECOLOR")))
|
|
|
|
;; Temporär Osnap für Blockerkennung setzen
|
|
(setq oldOsmode (getvar "OSMODE"))
|
|
(setvar "OSMODE" (logior oldOsmode 512)) ;; 512 = INS (Block-Einfügepunkt)
|
|
|
|
;; 1. Basispunkt (AN-Seite)
|
|
(setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
|
|
|
|
;; Osnap zurücksetzen auf den ursprünglichen Wert
|
|
(setvar "OSMODE" oldOsmode)
|
|
|
|
(if (null pt)
|
|
(princ (ssg-text "kreisel-abbruch-befehl"))
|
|
(progn
|
|
;; Hoehen-Vorgabe: angeklickter Block mit HOEHE, sonst Z des Punkts,
|
|
;; sonst Default (abgefragt wird erst nach dem Abstand)
|
|
(setq selectedEnt (nentselp pt))
|
|
(setq hoehe-vorgabe
|
|
(cond
|
|
((and selectedEnt
|
|
(setq selectedEnt (car selectedEnt))
|
|
(setq blockAttribs (ssg-attrib-read selectedEnt))
|
|
(assoc "HOEHE" blockAttribs))
|
|
(atof (cdr (assoc "HOEHE" blockAttribs))))
|
|
((and (> (length pt) 2) (> (caddr pt) 0))
|
|
(caddr pt))
|
|
(t *kreisel-default-hoehe*)
|
|
)
|
|
)
|
|
|
|
;; 2. Abstand (Tangentenlaenge) - Linie gibt auch den Winkel vor
|
|
(setq p2 (getpoint pt (ssg-textf "kreisel-prompt-abstand"
|
|
(list (rtos *kreisel-default-laenge* 2 0)))))
|
|
(setq erg (kreisel-insert-richtung pt p2 *kreisel-default-laenge*)
|
|
abstand (car erg)
|
|
rotation (cadr erg))
|
|
(princ (ssg-textf "kreisel-abstand-ausgabe" (list (rtos abstand 2 0))))
|
|
|
|
;; 3. Hoehe (Z-Koordinate)
|
|
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos hoehe-vorgabe 2 0)))))
|
|
(if (null hoehe) (setq hoehe hoehe-vorgabe))
|
|
|
|
;; 4. Kreiselart
|
|
(setq typ (kreisel-ask-typ))
|
|
|
|
(princ (ssg-textf "kreisel-insert-zusammenfassung"
|
|
(list (rtos rotation 2 1) (rtos hoehe 2 0) typ)))
|
|
|
|
;; Modul einfuegen
|
|
(draw-module (list (car pt) (cadr pt) hoehe) abstand rotation
|
|
(list (cons "KREISELART" typ)
|
|
(cons "HOEHE" (rtos hoehe 2 0))))
|
|
|
|
(princ (ssg-text "kreisel-insert-fertig"))
|
|
)
|
|
)
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
|
|
;; -----------------------------------------------
|
|
;; 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 (ssg-text "kreisel-start-connect") '(("OSMODE") ("CECOLOR")))
|
|
|
|
(princ (ssg-text "kreisel-connect-header"))
|
|
|
|
;; 1. Startpunkt (aeusserster Punkt AN-Seite)
|
|
(setq ptStart (getpoint (ssg-text "kreisel-prompt-startpunkt")))
|
|
(if (null ptStart)
|
|
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (princ) (exit))
|
|
)
|
|
|
|
;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband
|
|
(setq ptEnd (getpoint ptStart (ssg-text "kreisel-prompt-endpunkt")))
|
|
(if (null ptEnd)
|
|
(progn (ssg-end) (princ (ssg-text "kreisel-abgebrochen")) (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 (ssg-textf "kreisel-emsg-distanz-klein"
|
|
(list (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 (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos *kreisel-default-hoehe* 2 0)))))
|
|
(if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
|
|
)
|
|
(princ (ssg-textf "kreisel-hoehe-aus-startpunkt" (list (rtos hoehe 2 0))))
|
|
)
|
|
|
|
;; 6. Kreiselart abfragen
|
|
(setq typ (kreisel-ask-typ))
|
|
|
|
(princ (ssg-textf "kreisel-connect-zusammenfassung"
|
|
(list (rtos abstand 2 0) (rtos rotation 2 1) (rtos hoehe 2 0) 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 (ssg-text "kreisel-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)
|
|
;; drehrichtung : "GUZ"/"UZS" (optional, nil -> Default aus *kreisel-attrib-defs*)
|
|
;; Rueckgabe: Entity-Name des erzeugten Blocks oder nil
|
|
(defun kreisel-insert-script (pt abstand rotation typ hoehe drehrichtung
|
|
/ z blockEnt attribs)
|
|
(ssg-start (ssg-text "kreisel-start-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 attribs (list (cons "KREISELART" typ)
|
|
(cons "HOEHE" (rtos z 2 0))))
|
|
(if drehrichtung
|
|
(setq attribs (cons (cons "DREHRICHTUNG" drehrichtung) attribs)))
|
|
(setq blockEnt
|
|
(draw-module (list (car pt) (cadr pt) z) abstand rotation attribs))
|
|
(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 (ssg-text "kreisel-start-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 (ssg-textf "kreisel-script-distanz-klein" (list (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 (ssg-textf "kreisel-prompt-x-abstand" (list (rtos *kreisel-beschriftung-abstand-x* 2 0)))))
|
|
(if dx (setq *kreisel-beschriftung-abstand-x* dx))
|
|
(setq dy (getreal (ssg-textf "kreisel-prompt-y-abstand" (list (rtos *kreisel-beschriftung-abstand-y* 2 0)))))
|
|
(if dy (setq *kreisel-beschriftung-abstand-y* dy))
|
|
(princ (ssg-textf "kreisel-neue-beschriftungsposition"
|
|
(list (rtos *kreisel-beschriftung-abstand-x* 2 0) (rtos *kreisel-beschriftung-abstand-y* 2 0))))
|
|
(princ)
|
|
)
|
|
|
|
(defun c:KreiselLabelHoehe ( / h)
|
|
(setq h (getreal (ssg-textf "kreisel-prompt-texthoehe" (list (rtos *kreisel-beschriftung-hoehe* 2 0)))))
|
|
(if h (setq *kreisel-beschriftung-hoehe* h))
|
|
(princ (ssg-textf "kreisel-neue-texthoehe" (list (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 (ssg-text "kreisel-start-redraw") '(("CECOLOR")))
|
|
|
|
;; 1. Bestehenden Kreisel-Block auswaehlen
|
|
(setq sel (entsel (ssg-text "kreisel-prompt-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 (ssg-text "kreisel-emsg-kein-block")) (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 (ssg-textf "kreisel-redraw-bestehend"
|
|
(list (cdr (assoc "ABSTAND" attribs))
|
|
(cdr (assoc "DREHUNG" attribs))
|
|
(cdr (assoc "HOEHE" attribs))
|
|
(cdr (assoc "KREISELART" attribs)))))
|
|
|
|
;; 3. Neuen Abstand abfragen (Enter = beibehalten)
|
|
(initget 6)
|
|
(setq newAbstand (getdist (ssg-textf "kreisel-prompt-neuer-abstand" (list (cdr (assoc "ABSTAND" attribs))))))
|
|
(if (null newAbstand)
|
|
(setq newAbstand (atof (cdr (assoc "ABSTAND" attribs))))
|
|
)
|
|
;; NEU - Neue Höhe abfragen:
|
|
(setq newHoehe (getreal (ssg-textf "kreisel-prompt-neue-hoehe" (list (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 (ssg-textf "kreisel-redraw-fertig" (list (rtos newAbstand 2 0))))
|
|
(ssg-end)
|
|
)
|
|
|
|
|
|
;; --------------------------------------------
|
|
;; KreiselQuick: Schnell mit Defaults (horizontal)
|
|
;; --------------------------------------------
|
|
(defun c:KreiselQuick ( / pt)
|
|
(ssg-start (ssg-text "kreisel-start-quick") '(("CECOLOR")))
|
|
(setq pt (getpoint (ssg-text "kreisel-prompt-basispunkt")))
|
|
;; NEU - Höhe abfragen:
|
|
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list "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 (ssg-text "kreisel-quick-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 dlg-geruest-einzelmodul
|
|
dlg-geruest-typ
|
|
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 (ssg-text "kreisel-start-edit") '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
|
|
(setvar "OSMODE" 0)
|
|
|
|
;; 1. Block auswaehlen (falls nicht vorselektiert)
|
|
(if (null ent)
|
|
(progn
|
|
(setq sel (entsel (ssg-text "kreisel-prompt-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 (ssg-text "kreisel-emsg-kein-block")) (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 (ssg-text "kreisel-emsg-kein-kreisel-block"))
|
|
(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 (ssg-textf "kreisel-edit-bestehend"
|
|
(list (cdr (assoc "ABSTAND" attribs)) (rtos rotation 2 1) (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 (ssg-textf "kreisel-edit-dialog-fehlt" (list 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 "Bezeichnung" 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"))
|
|
|
|
(set_tile "geruest_einzelmodul"
|
|
(if (equal (cdr (assoc "GERUEST_EINZELMODUL" attribs)) "1") "1" "0"))
|
|
|
|
(start_list "geruest_typ")
|
|
(foreach opt *ssg-geruest-optionen* (add_list opt))
|
|
(end_list)
|
|
(set_tile "geruest_typ" (itoa (ssg-geruest-typ-to-idx (cdr (assoc "GERUEST_TYP" attribs)))))
|
|
|
|
;; 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\"))"
|
|
"(setq dlg-geruest-einzelmodul (get_tile \"geruest_einzelmodul\"))"
|
|
"(setq dlg-geruest-typ (get_tile \"geruest_typ\"))"
|
|
"(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 "Bezeichnung" dlg-name)
|
|
(assoc "Bezeichnung" 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))
|
|
(setq attribs (subst (cons "GERUEST_EINZELMODUL" dlg-geruest-einzelmodul)
|
|
(assoc "GERUEST_EINZELMODUL" attribs) attribs))
|
|
(setq attribs (subst (cons "GERUEST_TYP" (ssg-geruest-idx-to-typ (atoi dlg-geruest-typ)))
|
|
(assoc "GERUEST_TYP" 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 (ssg-textf "kreisel-edit-aktualisiert"
|
|
(list dlg-name (rtos newAbstand 2 0) dlg-hoehe (rtos newRotation 2 1))))
|
|
)
|
|
(princ (ssg-text "kreisel-abgebrochen"))
|
|
)
|
|
|
|
(ssg-end)
|
|
)
|
|
|
|
|
|
;; --------------------------------------------
|
|
;; KreiselParams: Aktuelle Parameter anzeigen
|
|
;; --------------------------------------------
|
|
(defun c:KreiselParams ()
|
|
(princ (ssg-text "kreisel-params-header"))
|
|
(princ (ssg-textf "kreisel-params-typ" (list #Kreisel_Typ)))
|
|
(princ (ssg-textf "kreisel-params-durchmesser" (list (rtos *kreisel-durchmesser* 2 0))))
|
|
(princ (ssg-textf "kreisel-params-default-laenge" (list (rtos *kreisel-default-laenge* 2 0))))
|
|
;; NEU - Default-Höhe anzeigen:
|
|
(princ (ssg-textf "kreisel-params-default-hoehe" (list (rtos *kreisel-default-hoehe* 2 0))))
|
|
(princ (ssg-text "kreisel-params-attribute-header"))
|
|
(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 hoehe-aus-z attribs ergebnis
|
|
geruest-einzelmodul geruest-typ)
|
|
(dbgf "c:ILS_Eckrad")
|
|
|
|
;; 1. Beruehrpunkt (Tangentenpunkt)
|
|
(setq ptTangent (getpoint (ssg-text "kreisel-eckrad-beruehrpunkt")))
|
|
(if (null ptTangent) (progn (dbgreturn nil) (exit)))
|
|
(dbg 'ptTangent)
|
|
|
|
;; 2. Richtungspunkt (Gummiband vom Beruehrpunkt)
|
|
(setq ptDir (getpoint ptTangent (ssg-text "kreisel-eckrad-richtung")))
|
|
(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 (ssg-text "kreisel-eckrad-fehler-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 vorbelegen: aus Z des Beruehrpunkts, sonst Default
|
|
(setq hoehe-aus-z (and (> (length ptTangent) 2) (caddr ptTangent) (> (caddr ptTangent) 0)))
|
|
(if hoehe-aus-z
|
|
(progn
|
|
(setq hoehe (caddr ptTangent))
|
|
(princ (ssg-textf "kreisel-hoehe-aus-3dpunkt" (list (rtos hoehe 2 0))))
|
|
)
|
|
(setq hoehe *eckrad-default-hoehe*)
|
|
)
|
|
(dbg 'hoehe)
|
|
|
|
(if (ssg-gui-p)
|
|
;; 5a. Dialog: Bezeichnung, Hoehe, Drehung, Drehrichtung, Geruest
|
|
(progn
|
|
(setq attribs (ssg-attrib-merge (list (cons "HOEHE" (rtos hoehe 2 0)))
|
|
*eckrad-attrib-defs*))
|
|
(setq ergebnis (eckrad-dialog attribs rotation))
|
|
(if (null ergebnis)
|
|
(progn (princ (ssg-text "kreisel-abgebrochen")) (dbgreturn nil) (exit))
|
|
)
|
|
(setq attribs (car ergebnis)
|
|
rotation (cdr ergebnis)
|
|
hoehe (atof (cdr (assoc "HOEHE" attribs))))
|
|
)
|
|
;; 5b. Ohne GUI (Tests): Konsolenabfrage wie bisher
|
|
(progn
|
|
(if (not hoehe-aus-z)
|
|
(progn
|
|
(setq hoehe (getreal (ssg-textf "kreisel-prompt-hoehe-z" (list (rtos *eckrad-default-hoehe* 2 0)))))
|
|
(if (null hoehe) (setq hoehe *eckrad-default-hoehe*))
|
|
)
|
|
)
|
|
(setq geruest-einzelmodul (if (ssg-ques (ssg-text "kreisel-eckrad-geruest-frage") T) "1" "0"))
|
|
(setq geruest-typ (ssg-ask-geruest-typ))
|
|
(setq attribs (list (cons "GERUEST_EINZELMODUL" geruest-einzelmodul)
|
|
(cons "GERUEST_TYP" geruest-typ)))
|
|
)
|
|
)
|
|
|
|
;; 6. Einfuegen (centerPt ist der Kreismittelpunkt)
|
|
(ils-eckrad-insert (list (car centerPt) (cadr centerPt) hoehe) rotation attribs)
|
|
(dbgreturn nil)
|
|
)
|
|
|
|
|
|
;; --------------------------------------------
|
|
;; eckrad-dialog-werte: Dialogeingaben -> (attribs . rotation)
|
|
;; Reiner Kern (ohne DCL/Zeichnung, in tests/test_unit.lsp getestet).
|
|
;; Parameter:
|
|
;; attribs - bisherige Attribut-alist ((TAG . WERT) ...)
|
|
;; name - Bezeichnung (String)
|
|
;; hoehe-str - Hoehe in mm (String aus edit_box)
|
|
;; drehung-str - Drehung in Grad (String aus edit_box)
|
|
;; drehr-idx - popup_list-Index Drehrichtung ("0"=UZS, "1"=GUZ)
|
|
;; einzelmodul - toggle-Wert "0"/"1"
|
|
;; geruest-idx - popup_list-Index in *ssg-geruest-optionen* (String)
|
|
;; Rueckgabe: (attribs-neu . rotation) oder nil bei ungueltiger Zahl.
|
|
;; Drehung wird auf [0, 360) normiert.
|
|
;; --------------------------------------------
|
|
(defun eckrad-dialog-werte (attribs name hoehe-str drehung-str drehr-idx
|
|
einzelmodul geruest-idx / hoehe drehung neu)
|
|
(setq hoehe (distof hoehe-str 2)
|
|
drehung (distof drehung-str 2))
|
|
(if (and hoehe drehung)
|
|
(progn
|
|
(setq drehung (rem (+ (rem drehung 360.0) 360.0) 360.0))
|
|
(setq neu (list (cons "Bezeichnung" name)
|
|
(cons "HOEHE" (rtos hoehe 2 0))
|
|
(cons "DREHUNG" (rtos drehung 2 1))
|
|
(cons "DREHRICHTUNG" (if (= drehr-idx "1") "GUZ" "UZS"))
|
|
(cons "GERUEST_EINZELMODUL" (if (= einzelmodul "1") "1" "0"))
|
|
(cons "GERUEST_TYP" (ssg-geruest-idx-to-typ (atoi geruest-idx)))))
|
|
;; Neue Werte ueber die bestehenden legen (attribs als Default-Schema)
|
|
(cons (ssg-attrib-merge neu (mapcar '(lambda (p) (list (car p) (cdr p))) attribs))
|
|
drehung)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; --------------------------------------------
|
|
;; eckrad-dialog: DCL-Dialog fuer Einfuegen und Bearbeiten
|
|
;; Parameter:
|
|
;; attribs - Attribut-alist zur Vorbelegung (mit *eckrad-attrib-defs* gemergt)
|
|
;; rotation - aktuelle Drehung in Grad
|
|
;; Rueckgabe: (attribs-neu . rotation-neu) oder nil (Abbruch/DCL fehlt)
|
|
;; --------------------------------------------
|
|
(defun eckrad-dialog (attribs rotation / dcl-pfad dat eckrad-dlg-ergebnis)
|
|
(setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*))
|
|
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/eckrad_edit.dcl"))
|
|
(setq dat (load_dialog dcl-pfad))
|
|
(if (or (< dat 0) (not (new_dialog "eckrad_edit" dat)))
|
|
(progn
|
|
(if (>= dat 0) (unload_dialog dat))
|
|
(alert (ssg-textf "kreisel-edit-dialog-fehlt" (list dcl-pfad)))
|
|
nil
|
|
)
|
|
(progn
|
|
(set_tile "name" (cdr (assoc "Bezeichnung" attribs)))
|
|
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
|
|
(set_tile "drehung" (rtos rotation 2 1))
|
|
|
|
(start_list "drehrichtung")
|
|
(add_list "UZS")
|
|
(add_list "GUZ")
|
|
(end_list)
|
|
(set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0"))
|
|
|
|
(set_tile "geruest_einzelmodul"
|
|
(if (equal (cdr (assoc "GERUEST_EINZELMODUL" attribs)) "1") "1" "0"))
|
|
|
|
(start_list "geruest_typ")
|
|
(foreach opt *ssg-geruest-optionen* (add_list opt))
|
|
(end_list)
|
|
(set_tile "geruest_typ" (itoa (ssg-geruest-typ-to-idx (cdr (assoc "GERUEST_TYP" attribs)))))
|
|
|
|
;; OK nur bei gueltigen Zahlen, sonst Fehlerzeile und Dialog bleibt offen
|
|
(action_tile "accept"
|
|
(strcat
|
|
"(setq eckrad-dlg-ergebnis (eckrad-dialog-werte attribs"
|
|
" (get_tile \"name\") (get_tile \"hoehe\") (get_tile \"drehung\")"
|
|
" (get_tile \"drehrichtung\") (get_tile \"geruest_einzelmodul\")"
|
|
" (get_tile \"geruest_typ\")))"
|
|
"(if eckrad-dlg-ergebnis (done_dialog 1)"
|
|
" (set_tile \"error\" (ssg-text \"kreisel-eckrad-ungueltige-zahl\")))"
|
|
)
|
|
)
|
|
(action_tile "cancel" "(setq eckrad-dlg-ergebnis nil) (done_dialog 0)")
|
|
|
|
(start_dialog)
|
|
(unload_dialog dat)
|
|
eckrad-dlg-ergebnis
|
|
)
|
|
)
|
|
)
|
|
|
|
;; -----------------------------------------------
|
|
;; EckradEdit: Bestehendes Eckrad per Dialog bearbeiten
|
|
;; (Doppelklick auf ECKRAD_n ueber SSG_BLOCKEDIT)
|
|
;;
|
|
;; Ablauf:
|
|
;; 1. Eckrad-Block auswaehlen (oder vorselektiert)
|
|
;; 2. Dialog mit aktuellen Werten oeffnen
|
|
;; 3. Bei OK: Block loeschen und mit gleicher Nummer neu einfuegen
|
|
;; -----------------------------------------------
|
|
(defun c:EckradEdit ( / ss sel ent ed attribs basePoint rotation ergebnis)
|
|
|
|
;; 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 (ssg-text "kreisel-start-eckrad-edit") '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
|
|
(setvar "OSMODE" 0)
|
|
|
|
(if (null ent)
|
|
(progn
|
|
(setq sel (entsel (ssg-text "kreisel-prompt-eckrad-auswaehlen")))
|
|
(if sel (setq ent (car sel)))
|
|
)
|
|
)
|
|
(if (null ent) (progn (ssg-end) (exit)))
|
|
|
|
(setq ed (entget ent))
|
|
(if (or (/= (cdr (assoc 0 ed)) "INSERT")
|
|
(not (wcmatch (strcase (cdr (assoc 2 ed))) "ECKRAD_*")))
|
|
(progn (ssg-emsg (ssg-text "kreisel-emsg-kein-eckrad-block")) (ssg-end) (exit))
|
|
)
|
|
|
|
;; Bestehende Werte auslesen, fehlende mit Defaults auffuellen
|
|
(setq attribs (ssg-attrib-merge (ssg-attrib-read ent) *eckrad-attrib-defs*))
|
|
(setq basePoint (cdr (assoc 10 ed)))
|
|
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
|
|
|
|
;; HOEHE immer aus Z-Koordinate des Einfuegepunkts
|
|
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 0))
|
|
(assoc "HOEHE" attribs) attribs))
|
|
|
|
(setq ergebnis (eckrad-dialog attribs rotation))
|
|
(if ergebnis
|
|
(progn
|
|
(setq attribs (car ergebnis)
|
|
rotation (cdr ergebnis))
|
|
(command "_.ERASE" ent "")
|
|
(ils-eckrad-insert (list (car basePoint) (cadr basePoint)
|
|
(atof (cdr (assoc "HOEHE" attribs))))
|
|
rotation attribs)
|
|
(princ (ssg-textf "kreisel-eckrad-edit-aktualisiert"
|
|
(list (cdr (assoc "Bezeichnung" attribs))
|
|
(cdr (assoc "HOEHE" attribs))
|
|
(rtos rotation 2 1))))
|
|
)
|
|
(princ (ssg-text "kreisel-abgebrochen"))
|
|
)
|
|
|
|
(ssg-end)
|
|
)
|
|
|
|
;; --------------------------------------------
|
|
;; 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 (ssg-text "kreisel-start-eckrad") '(("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)
|
|
|
|
;; NUMMER: Bestehende beibehalten (EckradEdit), sonst neue vergeben -
|
|
;; so behaelt ein bearbeitetes Eckrad seinen Blocknamen ECKRAD_n
|
|
(setq eckrad-nummer (atoi (cdr (assoc "NUMMER" attribs))))
|
|
(if (<= eckrad-nummer 0)
|
|
(progn
|
|
(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)
|
|
(setq lastEnt (ssg-lastent-ohne-attribute))
|
|
(if lastEnt
|
|
(dbgp (strcat "lastEnt Typ=" (cdr (assoc 0 (entget lastEnt))))))
|
|
|
|
;; AN8 Block einfuegen bei (0,0) - Eckrad ist ein einzelner Kreis (Dim-Suffix im Dateinamen)
|
|
(dbgp (strcat "INSERT Block: " *block-path* "AN8_" *ki-dxfm-dim* ".dwg"))
|
|
(command "_.INSERT" (strcat *block-path* "AN8_" *ki-dxfm-dim* ".dwg") (list 0.0 0.0 0.0) 1 1 0)
|
|
|
|
;; Drehrichtungspfeil auf die Radmitte (GUZ gespiegelt)
|
|
(kreisel-pfeile-einfuegen (eckrad-pfeil-params (cdr (assoc "DREHRICHTUNG" attribs))))
|
|
|
|
;; 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 (ssg-text "kreisel-fehler-keine-entities"))
|
|
(dbgp "FEHLER: Keine Entities fuer Block!")
|
|
)
|
|
)
|
|
(princ (ssg-textf "kreisel-neue-blockdef" (list bname)))
|
|
)
|
|
(progn
|
|
(princ (ssg-textf "kreisel-bestehende-blockdef" (list bname)))
|
|
(dbgp (strcat "Verwende bestehende Blockdefinition: " bname))
|
|
;; EckradEdit behaelt ECKRAD_n - Spiegelung des Pfeils nachziehen
|
|
(kreisel-pfeil-aktualisieren bname (cdr (assoc "DREHRICHTUNG" attribs)))
|
|
)
|
|
)
|
|
|
|
;; 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))
|
|
;; Ziel-Layer der Baugruppe aus cfg/layer.cfg (der Eckrad-Zweig setzte bisher
|
|
;; gar keinen Layer, das ECKRAD_n landete also immer auf Layer "0").
|
|
(ssg-layer-setzen block-ent "eckrad")
|
|
(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 (ssg-textf "kreisel-eckrad-eingefuegt"
|
|
(list (itoa eckrad-nummer) bname (rtos (car pt) 2 1) (rtos (cadr pt) 2 1)
|
|
(rtos rotation 2 1) block-hoehe)))
|
|
(ssg-end)
|
|
(dbgreturn (entlast))
|
|
)
|
|
|
|
;; NEU: KreiselLabelSetup - Hier einfügen!
|
|
(defun c:KreiselLabelSetup ( / hoehe farbe abstand schriftart)
|
|
(setq hoehe (getreal (ssg-textf "kreisel-prompt-schrifthoehe" (list (rtos *kreisel-beschriftung-hoehe* 2 0)))))
|
|
(if hoehe (setq *kreisel-beschriftung-hoehe* hoehe))
|
|
|
|
(setq farbe (getint (ssg-textf "kreisel-prompt-schriftfarbe" (list (itoa *kreisel-beschriftung-farbe*)))))
|
|
(if farbe (setq *kreisel-beschriftung-farbe* farbe))
|
|
|
|
(setq abstand (getreal (ssg-textf "kreisel-prompt-abstand-oben" (list (rtos *kreisel-beschriftung-abstand-oben* 2 0)))))
|
|
(if abstand (setq *kreisel-beschriftung-abstand-oben* abstand))
|
|
|
|
(princ (ssg-textf "kreisel-labelsetup-fertig"
|
|
(list (rtos *kreisel-beschriftung-hoehe* 2 0)
|
|
(itoa *kreisel-beschriftung-farbe*)
|
|
(rtos *kreisel-beschriftung-abstand-oben* 2 0))))
|
|
(princ)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; TEIL 5: BERUEHRPUNKTE / WEICHEN ZWISCHEN KREISELN UND ECKRAEDERN
|
|
;; ============================================================
|
|
;; Ermittelt, wo sich Kreisel (KREISEL_n) und Eckraeder (ECKRAD_n) gleicher
|
|
;; Hoehe beruehren - dort sitzt eine ILS-Weiche. Gerechnet wird NUR aus den
|
|
;; Blockparametern (Einfuegepunkt, Drehung, ABSTAND), nicht aus der
|
|
;; gezeichneten Geometrie - dasselbe Modell wie draw-module:
|
|
;; Kreisel: Rad AN8 bei P+R(r,0), Rad SP8 bei P+R(r+abstand,0), Laufprofile
|
|
;; = die beiden Tangenten bei lokal y=+-r. Frei ist je Rad nur der
|
|
;; aeussere Halbkreis (die "drei freien Seiten": vorn + beide
|
|
;; Flanken), die innere Haelfte liegt zwischen den Laufprofilen.
|
|
;; Eckrad: Vollkreis um P, ganz frei, kein Laufprofil.
|
|
;; Paar-Logik:
|
|
;; - Mindestabstand der Achsen (Kapsel-Modell) < 2r - tol -> KOLLISION
|
|
;; (Rad ragt hinein, Laufprofile kreuzen sich) - keine Weiche.
|
|
;; - Sonst je Rad: Rad/Rad mit |Abstand - 2r| <= tol bzw. Rad/Laufprofil
|
|
;; mit |Lot - r| <= tol, Beruehrpunkt auf einer freien Radseite ->
|
|
;; BERUEHRUNG ("Kreis/Kreis" bzw. "Kreis/Tangente", Namen wie im Python-
|
|
;; Export export_neighbors.compute_kreisel_touch_switches).
|
|
;; - Beruehren sich nur Laufprofile (Kreisel liegen Seite an Seite) ->
|
|
;; KOLLISION "Tangente/Tangente". Rad/Rad an beiden Flanken zaehlt nur bei
|
|
;; GLEICH ausgerichteten Raedern als Seite an Seite; in Gegenrichtung
|
|
;; (Kreisel seitlich versetzt Ende an Ende) ist es eine Weiche.
|
|
;; - Toleranz (toleranz_beruehrung, Standard 10 mm) faengt Zeichenungenauig-
|
|
;; keiten ab - gilt fuer Spalt UND Ueberlappung.
|
|
;; Die reinen Kerne (kreisel-bp-element/-paar/-berechnen) laufen ohne
|
|
;; Zeichnung und sind in tests/test_unit.lsp getestet.
|
|
|
|
(setq *kreisel-bp-app* "SSG_KR_WEICHE")
|
|
|
|
;; --- 2D-Vektorhelfer (Punkte als (x y)) ---
|
|
(defun kreisel-bp-plus (a b) (list (+ (car a) (car b)) (+ (cadr a) (cadr b))))
|
|
(defun kreisel-bp-minus (a b) (list (- (car a) (car b)) (- (cadr a) (cadr b))))
|
|
(defun kreisel-bp-mal (a s) (list (* (car a) s) (* (cadr a) s)))
|
|
(defun kreisel-bp-dot (a b) (+ (* (car a) (car b)) (* (cadr a) (cadr b))))
|
|
(defun kreisel-bp-abst (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
|
|
(defun kreisel-bp-mitte (a b) (kreisel-bp-mal (kreisel-bp-plus a b) 0.5))
|
|
|
|
;; Element-Record aus Blockparametern (reiner Kern).
|
|
;; typ "KREISEL" oder "ECKRAD"
|
|
;; p Einfuegepunkt (x y [z]) - Kreisel: AN-seitige Tangente, Eckrad: Mitte
|
|
;; z Hoehe (Einfuege-Z)
|
|
;; rot Drehung in Grad
|
|
;; abstand Achsabstand AN8->SP8 (Kreisel), beim Eckrad ignoriert
|
|
;; r Radradius
|
|
;; id/handle/name nur zur Ausgabe/Zuordnung
|
|
;; Rueckgabe: alist mit "raeder" ((label mitte freie-richtung|nil) ...),
|
|
;; "profile" ((p1 p2) (p1 p2)) und "achse" (a b) fuer den Kapsel-Abstand.
|
|
(defun kreisel-bp-element (typ p z rot abstand r id handle name / u n p2 a b)
|
|
(setq u (list (cos (* pi (/ rot 180.0))) (sin (* pi (/ rot 180.0))))
|
|
n (list (- (cadr u)) (car u))
|
|
p2 (list (car p) (cadr p)))
|
|
(if (= typ "KREISEL")
|
|
(progn
|
|
(setq a (kreisel-bp-plus p2 (kreisel-bp-mal u r))
|
|
b (kreisel-bp-plus p2 (kreisel-bp-mal u (+ r abstand))))
|
|
(list (cons "typ" typ) (cons "id" id) (cons "handle" handle) (cons "name" name)
|
|
(cons "z" z) (cons "r" r)
|
|
(cons "achse" (list a b))
|
|
(cons "raeder" (list (list "AN8" a (kreisel-bp-mal u -1.0))
|
|
(list "SP8" b u)))
|
|
(cons "profile" (list (list (kreisel-bp-plus a (kreisel-bp-mal n r))
|
|
(kreisel-bp-plus b (kreisel-bp-mal n r)))
|
|
(list (kreisel-bp-minus a (kreisel-bp-mal n r))
|
|
(kreisel-bp-minus b (kreisel-bp-mal n r)))))))
|
|
(list (cons "typ" typ) (cons "id" id) (cons "handle" handle) (cons "name" name)
|
|
(cons "z" z) (cons "r" r)
|
|
(cons "achse" (list p2 p2))
|
|
(cons "raeder" (list (list "ECKRAD" p2 nil)))
|
|
(cons "profile" nil)))
|
|
)
|
|
|
|
(defun kreisel-bp-get (key elem) (cdr (assoc key elem)))
|
|
|
|
;; Naechstgelegene Punkte zweier Strecken [p1,q1] und [p2,q2] (Ericson,
|
|
;; Real-Time Collision Detection - wie export_neighbors._closest_pts_segments).
|
|
;; Rueckgabe (c1 c2).
|
|
(defun kreisel-bp-naechste-punkte (p1 q1 p2 q2 / eps d1 d2 rr a e f c b den s tt)
|
|
(setq eps 1e-9
|
|
d1 (kreisel-bp-minus q1 p1)
|
|
d2 (kreisel-bp-minus q2 p2)
|
|
rr (kreisel-bp-minus p1 p2)
|
|
a (kreisel-bp-dot d1 d1)
|
|
e (kreisel-bp-dot d2 d2)
|
|
f (kreisel-bp-dot d2 rr))
|
|
(cond
|
|
((and (<= a eps) (<= e eps)) (setq s 0.0 tt 0.0))
|
|
((<= a eps) (setq s 0.0 tt (max 0.0 (min 1.0 (/ f e)))))
|
|
(t
|
|
(setq c (kreisel-bp-dot d1 rr))
|
|
(if (<= e eps)
|
|
(setq tt 0.0 s (max 0.0 (min 1.0 (/ (- c) a))))
|
|
(progn
|
|
(setq b (kreisel-bp-dot d1 d2)
|
|
den (- (* a e) (* b b)))
|
|
(setq s (if (> den eps) (max 0.0 (min 1.0 (/ (- (* b f) (* c e)) den))) 0.0))
|
|
(setq tt (/ (+ (* b s) f) e))
|
|
(cond
|
|
((< tt 0.0) (setq tt 0.0 s (max 0.0 (min 1.0 (/ (- c) a)))))
|
|
((> tt 1.0) (setq tt 1.0 s (max 0.0 (min 1.0 (/ (- b c) a)))))
|
|
)
|
|
)
|
|
))
|
|
)
|
|
(list (kreisel-bp-plus p1 (kreisel-bp-mal d1 s))
|
|
(kreisel-bp-plus p2 (kreisel-bp-mal d2 tt)))
|
|
)
|
|
|
|
;; Liegt Punkt pt auf der freien Seite des Rades (label mitte richtung)?
|
|
;; Richtung nil = Vollkreis (Eckrad). Die Flanken (90 Grad) zaehlen mit.
|
|
(defun kreisel-bp-frei-p (rad pt tol)
|
|
(or (null (caddr rad))
|
|
(>= (kreisel-bp-dot (kreisel-bp-minus pt (cadr rad)) (caddr rad)) (- tol)))
|
|
)
|
|
|
|
;; Liegt pt genau auf einer Flanke (90 Grad zur Achse) eines Kreiselrades?
|
|
;; Dort beginnt das eigene Laufprofil - eine Beruehrung NUR an der Flanke
|
|
;; bedeutet parallel aneinanderliegende Kreisel, keine Weiche.
|
|
(defun kreisel-bp-flanke-p (rad pt tol)
|
|
(and (caddr rad)
|
|
(<= (abs (kreisel-bp-dot (kreisel-bp-minus pt (cadr rad)) (caddr rad))) tol))
|
|
)
|
|
|
|
;; Lotfusspunkt von c auf die Strecke (p1 p2). Rueckgabe (t fusspunkt), t
|
|
;; unbegrenzt (0 = p1, 1 = p2).
|
|
(defun kreisel-bp-lot (c p1 p2 / d l2 tt)
|
|
(setq d (kreisel-bp-minus p2 p1)
|
|
l2 (kreisel-bp-dot d d))
|
|
(setq tt (if (> l2 1e-12) (/ (kreisel-bp-dot (kreisel-bp-minus c p1) d) l2) 0.0))
|
|
(list tt (kreisel-bp-plus p1 (kreisel-bp-mal d tt)))
|
|
)
|
|
|
|
;; Ergebnis-Record (reiner Kern)
|
|
(defun kreisel-bp-treffer (status art ea eb pt rad-elem rad detail)
|
|
(list (cons "status" status) (cons "art" art)
|
|
(cons "a" ea) (cons "b" eb)
|
|
(cons "p" pt)
|
|
(cons "z" (/ (+ (kreisel-bp-get "z" ea) (kreisel-bp-get "z" eb)) 2.0))
|
|
(cons "achse_von" rad-elem)
|
|
;; Ausrichtung der Weiche: Radiale vom beruehrenden Rad zum Punkt
|
|
(cons "achse_rot" (if rad (* (/ 180.0 pi) (angle (cadr rad) pt)) 0.0))
|
|
(cons "detail" detail))
|
|
)
|
|
|
|
;; Alle Beruehrungen eines Rades von ew mit Raedern/Profilen von eo.
|
|
;; Rueckgabe: Liste von (pt art rad detail).
|
|
(defun kreisel-bp-rad-kontakte (ew eo tol / r res d pt lot tt l)
|
|
(setq r (kreisel-bp-get "r" ew))
|
|
(foreach rad (kreisel-bp-get "raeder" ew)
|
|
;; Rad/Rad
|
|
(foreach rad2 (kreisel-bp-get "raeder" eo)
|
|
(setq d (kreisel-bp-abst (cadr rad) (cadr rad2)))
|
|
(if (<= (abs (- d (+ r (kreisel-bp-get "r" eo)))) tol)
|
|
(progn
|
|
(setq pt (kreisel-bp-mitte (cadr rad) (cadr rad2)))
|
|
;; Beide Kreiselraeder nur an der Flanke UND gleich ausgerichtet =
|
|
;; Kreisel Seite an Seite. Zeigen die Raeder in Gegenrichtung, stossen
|
|
;; die Kreisel seitlich versetzt Ende an Ende (Raeder liegen nebeneinander,
|
|
;; die Laufprofile treffen sich nur in einem Punkt) - das ist eine Weiche.
|
|
(if (and (kreisel-bp-frei-p rad pt tol) (kreisel-bp-frei-p rad2 pt tol)
|
|
(not (and (kreisel-bp-flanke-p rad pt tol)
|
|
(kreisel-bp-flanke-p rad2 pt tol)
|
|
(> (kreisel-bp-dot (caddr rad) (caddr rad2)) 0.0))))
|
|
(setq res (cons (list pt "Kreis/Kreis" rad
|
|
(strcat (car rad) "/" (car rad2)))
|
|
res))))))
|
|
;; Rad/Laufprofil
|
|
(foreach pr (kreisel-bp-get "profile" eo)
|
|
(setq lot (kreisel-bp-lot (cadr rad) (car pr) (cadr pr))
|
|
tt (car lot)
|
|
pt (cadr lot)
|
|
l (kreisel-bp-abst (car pr) (cadr pr)))
|
|
(if (and (> l 0.0)
|
|
(>= tt (- (/ tol l))) (<= tt (+ 1.0 (/ tol l)))
|
|
(<= (abs (- (kreisel-bp-abst (cadr rad) pt) r)) tol)
|
|
(kreisel-bp-frei-p rad pt tol)
|
|
;; Flanke an Laufprofil = Profile liegen parallel aufeinander
|
|
(not (kreisel-bp-flanke-p rad pt tol)))
|
|
(setq res (cons (list pt "Kreis/Tangente" rad (strcat (car rad) "/Profil")) res))))
|
|
)
|
|
(reverse res)
|
|
)
|
|
|
|
;; Ein Paar pruefen (reiner Kern). Rueckgabe: Liste von Treffer-Records
|
|
;; (leer = kein Kontakt). Unterschiedliche Hoehe wird VORHER ausgefiltert.
|
|
(defun kreisel-bp-paar (ea eb tol / ac bc cp dmin soll res kont pt doppelt)
|
|
(setq ac (kreisel-bp-get "achse" ea)
|
|
bc (kreisel-bp-get "achse" eb)
|
|
cp (kreisel-bp-naechste-punkte (car ac) (cadr ac) (car bc) (cadr bc))
|
|
dmin (kreisel-bp-abst (car cp) (cadr cp))
|
|
soll (+ (kreisel-bp-get "r" ea) (kreisel-bp-get "r" eb)))
|
|
(cond
|
|
;; Weit auseinander - nichts
|
|
((> dmin (+ soll tol)) nil)
|
|
;; Ueberschneidung - Kollision, keine Weiche
|
|
((< dmin (- soll tol))
|
|
(list (kreisel-bp-treffer "kollision" "Ueberschneidung" ea eb
|
|
(kreisel-bp-mitte (car cp) (cadr cp)) (kreisel-bp-get "id" ea) nil
|
|
(strcat "Achsabstand " (rtos dmin 2 1)))))
|
|
;; Beruehrung innerhalb Toleranz - Kontaktpunkte aufzaehlen
|
|
(t
|
|
(foreach k (append
|
|
(mapcar '(lambda (x) (cons ea x)) (kreisel-bp-rad-kontakte ea eb tol))
|
|
(mapcar '(lambda (x) (cons eb x)) (kreisel-bp-rad-kontakte eb ea tol)))
|
|
;; k = (elem pt art rad detail); Dubletten (gleicher Punkt) verwerfen
|
|
(setq pt (cadr k) doppelt nil)
|
|
(foreach t2 res
|
|
(if (<= (kreisel-bp-abst pt (kreisel-bp-get "p" t2)) (+ (* 2.0 tol) 1.0))
|
|
(setq doppelt T)))
|
|
(if (not doppelt)
|
|
(setq res (append res
|
|
(list (kreisel-bp-treffer "beruehrung" (nth 2 k) ea eb pt
|
|
(kreisel-bp-get "id" (car k)) (nth 3 k) (nth 4 k)))))))
|
|
(if res
|
|
res
|
|
;; Nur Laufprofile liegen aneinander (Seite an Seite) - keine Weiche
|
|
(list (kreisel-bp-treffer "kollision" "Tangente/Tangente" ea eb
|
|
(kreisel-bp-mitte (car cp) (cadr cp)) (kreisel-bp-get "id" ea) nil
|
|
"Laufprofile liegen aneinander"))))
|
|
)
|
|
)
|
|
|
|
;; Alle Paare auswerten (reiner Kern).
|
|
;; elemente = Liste von kreisel-bp-element-Records
|
|
;; Rueckgabe: (beruehrungen kollisionen)
|
|
(defun kreisel-bp-berechnen (elemente tol tol-z / rest ea ber kol)
|
|
(setq rest elemente)
|
|
(while rest
|
|
(setq ea (car rest) rest (cdr rest))
|
|
(foreach eb rest
|
|
(if (<= (abs (- (kreisel-bp-get "z" ea) (kreisel-bp-get "z" eb))) tol-z)
|
|
(foreach tr (kreisel-bp-paar ea eb tol)
|
|
(if (= (kreisel-bp-get "status" tr) "kollision")
|
|
(setq kol (cons tr kol))
|
|
(setq ber (cons tr ber)))))))
|
|
(list (reverse ber) (reverse kol))
|
|
)
|
|
|
|
;; ABSTAND eines Kreisels: Attribut, sonst letzter Token des Blocknamens
|
|
;; KREISEL_n_TYP_ABSTAND (reiner Kern).
|
|
(defun kreisel-bp-abstand (attr-wert bname / pos)
|
|
(cond
|
|
((and attr-wert (> (atof attr-wert) 0.0)) (atof attr-wert))
|
|
((setq pos (vl-string-position (ascii "_") bname 0 T))
|
|
(atof (substr bname (+ pos 2))))
|
|
(t 0.0))
|
|
)
|
|
|
|
;; Toleranzen aus data/json/component_defaults.json (Sektion kreisel)
|
|
(defun kreisel-bp-toleranz () (float (ssg-cfg-or "kreisel" "toleranz_beruehrung" 10.0)))
|
|
(defun kreisel-bp-toleranz-z () (float (ssg-cfg-or "kreisel" "toleranz_hoehe" 1.0)))
|
|
|
|
;; Alle KREISEL_n/ECKRAD_n im Modellbereich als Element-Records sammeln.
|
|
;; Bloecke auf gefrorenen Layern bleiben aussen vor (wie im Export).
|
|
(defun kreisel-bp-elemente-sammeln ( / ss i ent ed bname typ attribs p r res)
|
|
(setq r (/ *kreisel-durchmesser* 2.0))
|
|
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KREISEL_*,ECKRAD_*") (410 . "Model"))))
|
|
(progn
|
|
(setq i 0)
|
|
(while (setq ent (ssname ss i))
|
|
(setq ed (entget ent)
|
|
bname (strcase (cdr (assoc 2 ed)))
|
|
typ (if (wcmatch bname "KREISEL_*") "KREISEL" "ECKRAD"))
|
|
(if (not (and (car (atoms-family 1 '("SSG-ENT-LAYER-GEFROREN-P")))
|
|
(ssg-ent-layer-gefroren-p ent)))
|
|
(progn
|
|
(setq attribs (ssg-attrib-read ent)
|
|
p (cdr (assoc 10 ed)))
|
|
(setq res (cons (kreisel-bp-element typ p (if (caddr p) (caddr p) 0.0)
|
|
(* (/ 180.0 pi) (cdr (assoc 50 ed)))
|
|
(if (= typ "KREISEL")
|
|
(kreisel-bp-abstand (cdr (assoc "ABSTAND" attribs)) bname)
|
|
0.0)
|
|
r
|
|
(cond ((cdr (assoc "ID" attribs))) (""))
|
|
(cdr (assoc 5 ed))
|
|
(cond ((cdr (assoc "Bezeichnung" attribs))
|
|
(if (= (cdr (assoc "Bezeichnung" attribs)) "")
|
|
bname (cdr (assoc "Bezeichnung" attribs))))
|
|
(bname)))
|
|
res))))
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
(reverse res)
|
|
)
|
|
|
|
;; Einstieg fuer Befehl UND Export: (beruehrungen kollisionen) der Zeichnung
|
|
(defun kreisel-bp-ermitteln ()
|
|
(kreisel-bp-berechnen (kreisel-bp-elemente-sammeln)
|
|
(kreisel-bp-toleranz) (kreisel-bp-toleranz-z))
|
|
)
|
|
|
|
;; Anzeigetext eines Elements: "Kreisel3 (ID 0007)" bzw. ohne ID mit Handle
|
|
(defun kreisel-bp-elem-text (e)
|
|
(strcat (kreisel-bp-get "name" e)
|
|
(if (/= (kreisel-bp-get "id" e) "")
|
|
(strcat " (ID " (kreisel-bp-get "id" e) ")")
|
|
(strcat " (#" (kreisel-bp-get "handle" e) ")")))
|
|
)
|
|
|
|
;; Alte Marker (Kreise mit XDATA *kreisel-bp-app*) entfernen. Rueckgabe: Anzahl
|
|
(defun kreisel-bp-marker-loeschen ( / ss i n)
|
|
(setq n 0)
|
|
(if (setq ss (ssget "_X" (list '(0 . "CIRCLE") (list -3 (list *kreisel-bp-app*)))))
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(entdel (ssname ss i))
|
|
(setq i (1+ i) n (1+ n)))))
|
|
n
|
|
)
|
|
|
|
;; Marker-Kreis fuer einen Treffer zeichnen
|
|
(defun kreisel-bp-marker (tr lay radius)
|
|
(if (not (tblsearch "APPID" *kreisel-bp-app*)) (regapp *kreisel-bp-app*))
|
|
(entmake (list '(0 . "CIRCLE") (cons 8 lay)
|
|
(list 10 (car (kreisel-bp-get "p" tr)) (cadr (kreisel-bp-get "p" tr))
|
|
(kreisel-bp-get "z" tr))
|
|
(cons 40 radius)
|
|
(list -3 (list *kreisel-bp-app*
|
|
(cons 1000 (kreisel-bp-get "status" tr))
|
|
(cons 1000 (kreisel-bp-get "art" tr))))))
|
|
)
|
|
|
|
;; Layer fuer Marker: cfg/layer.cfg [allgemein] key, sonst Rueckfall
|
|
(defun kreisel-bp-layer (key fallback farbe / lay)
|
|
(if (null (setq lay (ssg-layer-anlegen key nil)))
|
|
(progn (ssg-make-layer fallback farbe nil) (setq lay fallback)))
|
|
lay
|
|
)
|
|
|
|
;; Konsolenzeile fuer einen Treffer
|
|
(defun kreisel-bp-zeile (key nr tr)
|
|
(princ (ssg-textf key
|
|
(list nr
|
|
(kreisel-bp-elem-text (kreisel-bp-get "a" tr))
|
|
(kreisel-bp-elem-text (kreisel-bp-get "b" tr))
|
|
(strcat (kreisel-bp-get "art" tr) ", " (kreisel-bp-get "detail" tr))
|
|
(rtos (car (kreisel-bp-get "p" tr)) 2 1)
|
|
(rtos (cadr (kreisel-bp-get "p" tr)) 2 1)
|
|
(rtos (kreisel-bp-get "z" tr) 2 1))))
|
|
)
|
|
|
|
;; --------------------------------------------
|
|
;; KREISEL_WEICHEN: Beruehrpunkte (Weichen) und Kollisionen aller Kreisel/
|
|
;; Eckraeder ermitteln, in der Konsole auflisten und als Kreise markieren.
|
|
;; Ein erneuter Aufruf ersetzt die Marker des vorigen Laufs.
|
|
;; --------------------------------------------
|
|
(defun c:KREISEL_WEICHEN ( / erg ber kol nr lay-w lay-k radius)
|
|
(ssg-start (ssg-text "kreisel-bp-start") nil)
|
|
(setq erg (kreisel-bp-ermitteln)
|
|
ber (car erg)
|
|
kol (cadr erg))
|
|
(dbgmsg (strcat "KREISEL_WEICHEN: " (itoa (length ber)) " Beruehrungen, "
|
|
(itoa (length kol)) " Kollisionen"))
|
|
(kreisel-bp-marker-loeschen)
|
|
(princ (ssg-textf "kreisel-bp-summe"
|
|
(list (itoa (length ber)) (itoa (length kol)) (rtos (kreisel-bp-toleranz) 2 1))))
|
|
(setq radius (float (ssg-cfg-or "kreisel" "weiche_marker_radius" 50.0)))
|
|
(if ber
|
|
(setq lay-w (kreisel-bp-layer "kreisel_weiche" "ZZ_Kreisel_Weichen" "4")))
|
|
(if kol
|
|
(setq lay-k (kreisel-bp-layer "kreisel_kollision" "ZZ_Kreisel_Kollision" "1")))
|
|
(setq nr 0)
|
|
(foreach tr ber
|
|
(setq nr (1+ nr))
|
|
(kreisel-bp-zeile "kreisel-bp-zeile" (itoa nr) tr)
|
|
(kreisel-bp-marker tr lay-w radius))
|
|
(setq nr 0)
|
|
(foreach tr kol
|
|
(setq nr (1+ nr))
|
|
(kreisel-bp-zeile "kreisel-bp-kollision" (itoa nr) tr)
|
|
(kreisel-bp-marker tr lay-k (* 2.0 radius)))
|
|
(if (or ber kol)
|
|
(princ (ssg-textf "kreisel-bp-marker"
|
|
(list (itoa (+ (length ber) (length kol)))
|
|
(cond (lay-w) (lay-k))))))
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
(princ "\n>>> KreiselInsert geladen")
|
|
(princ)
|