Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

[FIX] Export: Schnittpunkte zwischen Kreiseln werden erkannt und Weichen entsprechend gezählt und als Teil mit Merkmalen im Export befüllt - nur Kreisel mit gleicher Höhe können einen Schnittpunkt für Weiche bilden - Funktion der Weichenzählung manuell aufrufbar; [FIX] Eckrad nun korrekt angelegt und exportiert

Browse Source
This commit is contained in:
Simon Hensch
2026-10-14 07:42:08 +02:00
parent 6044c35957
commit 8039251bb8
18 changed files with 1452 additions and 481 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/KreiselInsert.lsp
+376
View File
@@ -1524,5 +1524,381 @@
(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".
;; 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 = Kreisel Seite an Seite
(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))))
(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" 1.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)