m.stangl
fe3adc7e59
Der intern in der GF/VF-Kette gezeichnete 300-mm-Block Staustrecke_Separator_SP ist ein Foerder-/Uebergabestueck, kein eigenstaendiger Separator. Er wurde bisher als Separator mitgezaehlt (ANZAHL_SEPARATOR = intern + platzierte Symbole), wodurch eine GF mit einem darauf gelegten S-LP-Symbol faelschlich 2 statt 1 ergab. count_sep_scan.lsp: ANZAHL_SEPARATOR zaehlt jetzt nur noch die platzierten Separator_SP/S-LP-Symbole (newP = nsep). Schnelltest cs-zuordnung-noetig-p entsprechend auf reine Symbolzahl je Carrier umgestellt. Die interne Zaehlung (cs-count-nested, *intern-separator-pattern*, internSep) entfaellt. Gefaellestrecke.lsp: GF-Bau setzt ANZAHL_SEPARATOR beim Erstellen mit 0 vor (interne Kettenseparatoren zaehlen nicht) - die echte Anzahl fuellt der Export aus den platzierten Symbolen. Label "Sep=N" entfernt (waere sonst immer 0 bzw. widerspraeche dem Export). n-bogen-gf/gf-make-label entsprechend bereinigt. Hinweis: tests/reference/gefaellestrecke_tests_export.csv (Anzahl_Separator=1 ohne platzierte Symbole) wird dadurch stale -> per TEST_EXPORT_ALL in BricsCAD neu erzeugen. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
795 lines
34 KiB
Common Lisp
795 lines
34 KiB
Common Lisp
;;; ============================================================
|
|
;;; count_sep_scan.lsp - Separator-/Scanner-Zuordnung
|
|
;;; ------------------------------------------------------------
|
|
;;; Zaehlt die manuell platzierten Bloecke "Scanner" und
|
|
;;; "Separator_SP" (Muster siehe cfg/export.cfg [blockpattern]
|
|
;;; pattern_scanner/pattern_separator) je Carrier (Kreisel/Eckrad,
|
|
;;; VarioFoerderer-Streckengruppe VF_*, Gefaellestrecke GF_* -
|
|
;;; Muster pattern_kreisel/pattern_variofoerderer/
|
|
;;; pattern_gefaellestrecke) und schreibt die Anzahlen in die
|
|
;;; Attribute ANZAHL_SCANNER/ANZAHL_SEPARATOR des jeweiligen
|
|
;;; Carrier-Blocks.
|
|
;;;
|
|
;;; WICHTIG: Gezaehlt werden ausschliesslich die eigenstaendig
|
|
;;; platzierten Sensor-Symbole. Der intern in der GF/VF-Kette
|
|
;;; gezeichnete 300-mm-Block Staustrecke_Separator_SP ist nur ein
|
|
;;; Ketten-/Uebergabestueck (kein eigenstaendiger Separator) und wird
|
|
;;; NICHT mitgezaehlt - wer einen Separator gezaehlt haben will, setzt
|
|
;;; ein Separator_SP/S-LP-Symbol.
|
|
;;;
|
|
;;; Zuordnung eines Sensors zu einem Carrier (Z wird ignoriert):
|
|
;;; 0. Traegt der Sensor bereits ein ZUORDNUNG-Attribut, wird das
|
|
;;; respektiert (nicht ueberschrieben) - er zaehlt mit, wenn die
|
|
;;; dort stehende ID zu einem bekannten Carrier passt.
|
|
;;; 1. Scanner: der Einfuegepunkt (X/Y) muss in der Bounding-Box
|
|
;;; des Carriers liegen. Die 3D-Geometrie des Scanners kann
|
|
;;; weit vom Einfuegepunkt entfernt sein, daher zaehlt hier der
|
|
;;; Einfuegepunkt (dort klickt der Benutzer auf den Block).
|
|
;;; 2. Separator: der geometrische Mittelpunkt (Zentrum der eigenen
|
|
;;; Bounding-Box, unabhaengig vom $INSBASE) muss in der
|
|
;;; Bounding-Box des Carriers liegen.
|
|
;;; 3. Liegt der Punkt in mehreren Boxen (Ueberlappung), wird der
|
|
;;; Carrier mit dem naechstgelegenen Box-Zentrum gewaehlt.
|
|
;;; 4. Liegt der Punkt in KEINER Carrier-Box (Scanner koennen
|
|
;;; durchaus ausserhalb der Kreisel-BBox montiert sein), wird der
|
|
;;; raeumlich naechstgelegene Carrier ueber alle Kreisel/Strecken
|
|
;;; hinweg gewaehlt (cs-nearest-two). Ist der Abstand zum
|
|
;;; zweitnaechsten Carrier fast gleich gross (Differenz <=
|
|
;;; cs-strittig-diff-mm, siehe cfg/export.cfg [Sensorzuordnung]
|
|
;;; strittig_diff_mm), gilt die Zuordnung als "strittig": sie
|
|
;;; wird trotzdem geschrieben, aber zusaetzlich in
|
|
;;; *cs-scanner-ergaenzt* (Report-Liste) und
|
|
;;; *cs-scanner-warnung-by-handle* (Key = Entity-Handle, Wert =
|
|
;;; Warnungstext) vermerkt. csv:block-to-json (export.lsp) liest
|
|
;;; *cs-scanner-warnung-by-handle* aus und haengt den Text als
|
|
;;; "warnung"-Feld an den JSON-Block des betroffenen Scanners an
|
|
;;; - export_csv.py gibt ihn in der CSV-Spalte "Warnungen" aus.
|
|
;;; *cs-scanner-ergaenzt* sammelt ALLE per Abstand (nicht per
|
|
;;; BBox) zugeordneten Scanner, nicht nur die strittigen -
|
|
;;; cs-zuordnung-lauf gibt diese Liste auf der Konsole aus.
|
|
;;; 5. Ein optionaler Toleranzrand (cs-senstol, siehe
|
|
;;; cfg/export.cfg [Sensorzuordnung] senstol_mm) vergroessert die
|
|
;;; Box, damit Sensoren knapp am Rand noch erfasst werden.
|
|
;;; 6. Bei zugeordneten Sensoren wird die ID des Carriers (Attribut
|
|
;;; "ID") in das Sensor-Attribut ZUORDNUNG geschrieben.
|
|
;;; 7. Sensoren, zu denen ueberhaupt kein Carrier existiert (leere
|
|
;;; Zeichnung), werden mit einem Kreis auf dem Layer *mark-layer*
|
|
;;; markiert (zentriert auf den Sensor).
|
|
;;;
|
|
;;; cs-zuordnung-lauf ist die wiederverwendbare Engine (siehe unten):
|
|
;;; sie wird sowohl vom interaktiven Befehl ZAEHLE_SEP_SCAN als auch
|
|
;;; automatisch vor jedem CSV-/Sivas-Export aufgerufen (Lisp/export.lsp,
|
|
;;; csv:run-export) - dort OHNE QSAVE und ohne die ausfuehrliche
|
|
;;; Detailzeile je Carrier (verbose=nil), damit die Konsolenausgabe
|
|
;;; beim normalen Export kompakt bleibt.
|
|
;;;
|
|
;;; Aufruf (interaktiv): ZAEHLE_SEP_SCAN
|
|
;;; Laden: per APPLOAD oder (ssg-ensure "count_sep_scan")
|
|
;;; ============================================================
|
|
|
|
(vl-load-com)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; KONFIGURATION
|
|
;;; ------------------------------------------------------------
|
|
|
|
;; Toleranzrand um die Carrier-Box in Zeichnungseinheiten (mm), aus
|
|
;; cfg/export.cfg [Sensorzuordnung] senstol_mm (Default 0.0 = exakte
|
|
;; Box). Wird von cs-zuordnung-lauf bei jedem Lauf frisch gelesen und
|
|
;; hier nur mit einem Startwert vorbelegt, damit cs-in-box/cs-grid-add
|
|
;; auch ausserhalb eines Laufs referenzierbar bleiben.
|
|
(if (null *senstol*) (setq *senstol* 0.0))
|
|
|
|
;; Attribut-Tag im Scanner-/Separator-Block, in das die ID des
|
|
;; zugeordneten Carriers geschrieben wird.
|
|
(setq *zuordnung-tag* "ZUORDNUNG")
|
|
|
|
;; Markierung von Sensoren ohne jeglichen Carrier: Kreis auf eigenem Layer.
|
|
(setq *mark-layer* "S_SENSOR_UNZUGEORDNET")
|
|
(setq *mark-color* 2) ;; 2 = Gelb
|
|
;; Kreisradius = Faktor * halbe XY-Diagonale der Sensor-Box,
|
|
;; mindestens *mark-radius-min* (mm).
|
|
(if (null *mark-radius-factor*) (setq *mark-radius-factor* 1.5))
|
|
(if (null *mark-radius-min*) (setq *mark-radius-min* 500.0))
|
|
|
|
;; --- Toleranzrand (mm) aus cfg/export.cfg [Sensorzuordnung] senstol_mm ---
|
|
(defun cs-senstol ()
|
|
(atof (export:cfg "Sensorzuordnung" "senstol_mm" "0"))
|
|
)
|
|
|
|
;; --- "Strittig"-Schwelle (mm) aus cfg/export.cfg [Sensorzuordnung] ---
|
|
;; Differenz zwischen dem Abstand zum naechsten und zweitnaechsten
|
|
;; Carrier, unterhalb derer eine Distanz-Zuordnung als unsicher gilt.
|
|
(defun cs-strittig-diff-mm ()
|
|
(atof (export:cfg "Sensorzuordnung" "strittig_diff_mm" "500"))
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Carrier-/Sensor-Erkennung ueber die gemeinsamen Muster aus
|
|
;;; cfg/export.cfg [blockpattern] (export:pattern, siehe export.lsp) -
|
|
;;; dieselben Muster wie csv:collect-export-blocks/export_csv.py.
|
|
;;; ------------------------------------------------------------
|
|
|
|
;; --- Ist nm ein Kreisel/Eckrad-, VarioFoerderer- oder Gefaellestrecke-
|
|
;; Compound-Block? Alle drei fuehren einheitlich die Attribute
|
|
;; ANZAHL_SCANNER/ANZAHL_SEPARATOR. ---
|
|
(defun cs-carrier-p (nm / up)
|
|
(setq up (strcase nm))
|
|
(or (wcmatch up (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*"))
|
|
(wcmatch up (export:pattern "pattern_variofoerderer" "VF_*"))
|
|
(wcmatch up (export:pattern "pattern_gefaellestrecke" "GF_*"))
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Sensor-Erkennung
|
|
;;; Rueckgabe: 'scanner | 'separator | nil
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-sensor-kind (nm / up)
|
|
(setq up (strcase nm))
|
|
(cond
|
|
((wcmatch up (strcase (export:pattern "pattern_scanner" "Scanner*"))) 'scanner)
|
|
((wcmatch up (strcase (export:pattern "pattern_separator" "Separator_SP*,S-LP*"))) 'separator)
|
|
(t nil)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Bounding-Box eines INSERT holen (WCS, achsparallel).
|
|
;;; Erzwingt vorher ein vla-update (Regen des Objekts), da
|
|
;;; vla-getboundingbox sonst auf nicht-regenerierten oder auf
|
|
;;; eingefrorenen Layern liegenden Bloecken scheitert.
|
|
;;; Rueckgabe: (minx miny maxx maxy) oder nil bei Fehler.
|
|
;;; *cs-last-error* enthaelt bei Fehler den echten COM-Fehlertext.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-pt->list (v)
|
|
(cond
|
|
((= (type v) 'variant) (vlax-safearray->list (vlax-variant-value v)))
|
|
((= (type v) 'safearray) (vlax-safearray->list v))
|
|
((listp v) v)
|
|
(t nil)
|
|
)
|
|
)
|
|
|
|
(defun cs-bbox (ent / obj res)
|
|
(setq *cs-last-error* nil)
|
|
(setq obj (vlax-ename->vla-object ent))
|
|
;; Objekt regenerieren (Fehler ignorieren)
|
|
(vl-catch-all-apply 'vla-update (list obj))
|
|
(setq res
|
|
(vl-catch-all-apply
|
|
'(lambda ( / ll ur)
|
|
(vla-getboundingbox obj 'll 'ur)
|
|
(list (cs-pt->list ll) (cs-pt->list ur)))))
|
|
(if (vl-catch-all-error-p res)
|
|
(progn
|
|
(setq *cs-last-error* (vl-catch-all-error-message res))
|
|
nil)
|
|
(list (car (car res)) (cadr (car res)) ;; minx miny
|
|
(car (cadr res)) (cadr (cadr res))) ;; maxx maxy
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Referenzpunkt eines Sensors (X/Y), je nach Typ:
|
|
;;; - Scanner : Einfuegepunkt (DXF-Gruppe 10).
|
|
;;; - Separator : geometrischer Mittelpunkt seiner eigenen
|
|
;;; Bounding-Box (unabhaengig vom $INSBASE),
|
|
;;; Fallback auf den Einfuegepunkt.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-sensor-point (ent ed kind / bb)
|
|
(if (eq kind 'scanner)
|
|
(cdr (assoc 10 ed))
|
|
(progn
|
|
(setq bb (cs-bbox ent))
|
|
(if bb
|
|
(list (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
|
|
(/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
|
|
(cdr (assoc 10 ed))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Liegt Punkt pt (X/Y) in Carrier-Record rec (mit Toleranz)?
|
|
;;; rec = (ename tagScan tagSep minx miny maxx maxy cx cy id)
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-in-box (pt rec / x y)
|
|
(setq x (car pt) y (cadr pt))
|
|
(and (>= x (- (nth 3 rec) *senstol*))
|
|
(<= x (+ (nth 5 rec) *senstol*))
|
|
(>= y (- (nth 4 rec) *senstol*))
|
|
(<= y (+ (nth 6 rec) *senstol*)))
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Raeumliches Grid (Vorsortierung nach Zellen) ueber die
|
|
;;; Carrier-Boxen, damit cs-assign nicht mehr linear ueber ALLE
|
|
;;; Carrier laufen muss, sondern nur ueber die Kandidaten der
|
|
;;; eigenen Zelle. Aufloesung ~ sqrt(Anzahl Carrier).
|
|
;;; Ein Carrier wird in JEDE Zelle eingetragen, die seine
|
|
;;; (toleranzerweiterte) Box beruehrt - dadurch kann kein
|
|
;;; Treffer verloren gehen (kein false negative), die exakte
|
|
;;; Pruefung (cs-in-box) bleibt unveraendert auf den Kandidaten.
|
|
;;; Rueckgabe von cs-grid-build: (gxmin gymin cellw cellh gridn buckets)
|
|
;;; buckets: Assoc-Liste (zellindex . (rec rec ...))
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-grid-cellidx (val minv cellsize gridn / idx)
|
|
(setq idx (fix (/ (- val minv) cellsize)))
|
|
(cond ((< idx 0) 0) ((> idx (1- gridn)) (1- gridn)) (t idx))
|
|
)
|
|
|
|
(defun cs-grid-bump (buckets key rec / pair)
|
|
(setq pair (assoc key buckets))
|
|
(if pair
|
|
(subst (cons key (cons rec (cdr pair))) pair buckets)
|
|
(cons (cons key (list rec)) buckets))
|
|
)
|
|
|
|
(defun cs-grid-add (buckets rec gxmin gymin cellw cellh gridn / cx0 cx1 cy0 cy1 cx cy)
|
|
(setq cx0 (cs-grid-cellidx (- (nth 3 rec) *senstol*) gxmin cellw gridn))
|
|
(setq cx1 (cs-grid-cellidx (+ (nth 5 rec) *senstol*) gxmin cellw gridn))
|
|
(setq cy0 (cs-grid-cellidx (- (nth 4 rec) *senstol*) gymin cellh gridn))
|
|
(setq cy1 (cs-grid-cellidx (+ (nth 6 rec) *senstol*) gymin cellh gridn))
|
|
(setq cy cy0)
|
|
(while (<= cy cy1)
|
|
(setq cx cx0)
|
|
(while (<= cx cx1)
|
|
(setq buckets (cs-grid-bump buckets (+ (* cx gridn) cy) rec))
|
|
(setq cx (1+ cx))
|
|
)
|
|
(setq cy (1+ cy))
|
|
)
|
|
buckets
|
|
)
|
|
|
|
(defun cs-grid-build (carriers / n gridn gxmin gymin gxmax gymax cellw cellh buckets)
|
|
(setq n (length carriers))
|
|
(if (= n 0)
|
|
(list 0.0 0.0 1.0 1.0 1 nil)
|
|
(progn
|
|
(setq gxmin (- (nth 3 (car carriers)) *senstol*)
|
|
gymin (- (nth 4 (car carriers)) *senstol*)
|
|
gxmax (+ (nth 5 (car carriers)) *senstol*)
|
|
gymax (+ (nth 6 (car carriers)) *senstol*))
|
|
(foreach rec (cdr carriers)
|
|
(if (< (- (nth 3 rec) *senstol*) gxmin) (setq gxmin (- (nth 3 rec) *senstol*)))
|
|
(if (< (- (nth 4 rec) *senstol*) gymin) (setq gymin (- (nth 4 rec) *senstol*)))
|
|
(if (> (+ (nth 5 rec) *senstol*) gxmax) (setq gxmax (+ (nth 5 rec) *senstol*)))
|
|
(if (> (+ (nth 6 rec) *senstol*) gymax) (setq gymax (+ (nth 6 rec) *senstol*)))
|
|
)
|
|
(setq gridn (max 1 (fix (sqrt n))))
|
|
(setq cellw (/ (max 1.0 (- gxmax gxmin)) gridn))
|
|
(setq cellh (/ (max 1.0 (- gymax gymin)) gridn))
|
|
(setq buckets nil)
|
|
(foreach rec carriers
|
|
(setq buckets (cs-grid-add buckets rec gxmin gymin cellw cellh gridn)))
|
|
(list gxmin gymin cellw cellh gridn buckets)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun cs-grid-candidates (grid pt / gxmin gymin cellw cellh gridn buckets cx cy pair)
|
|
(setq gxmin (nth 0 grid) gymin (nth 1 grid)
|
|
cellw (nth 2 grid) cellh (nth 3 grid)
|
|
gridn (nth 4 grid) buckets (nth 5 grid))
|
|
(setq cx (cs-grid-cellidx (car pt) gxmin cellw gridn))
|
|
(setq cy (cs-grid-cellidx (cadr pt) gymin cellh gridn))
|
|
(setq pair (assoc (+ (* cx gridn) cy) buckets))
|
|
(if pair (cdr pair) nil)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Sensor-Punkt einem Carrier per BBox zuordnen (Schritt 1-3 oben).
|
|
;;; Rueckgabe: Carrier-Record oder nil (kein BBox-Treffer).
|
|
;;; Bei mehreren Treffern: naechstes Box-Zentrum (X/Y).
|
|
;;; grid = Vorsortierung aus cs-grid-build (statt aller Carrier
|
|
;;; wird nur die Kandidatenliste der eigenen Zelle geprueft).
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-assign (pt grid / matches best bestd d rec)
|
|
(setq matches nil)
|
|
(foreach rec (cs-grid-candidates grid pt)
|
|
(if (cs-in-box pt rec) (setq matches (cons rec matches))))
|
|
(cond
|
|
((null matches) nil)
|
|
((= (length matches) 1) (car matches))
|
|
(t
|
|
(setq best nil bestd nil)
|
|
(foreach rec matches
|
|
(setq d (distance (list (car pt) (cadr pt))
|
|
(list (nth 7 rec) (nth 8 rec))))
|
|
(if (or (null bestd) (< d bestd))
|
|
(setq bestd d best rec)))
|
|
best)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Die beiden dem Punkt pt (X/Y) naechstgelegenen Carrier, sortiert
|
|
;;; nach Abstand zum Box-Mittelpunkt (gleicher Massstab wie der
|
|
;;; Ueberlappungs-Tiebreak in cs-assign). carriers darf nicht leer
|
|
;;; sein - siehe cs-resolve-sensor.
|
|
;;; Rueckgabe: (best-rec best-dist second-rec-oder-nil second-dist-oder-nil)
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-nearest-two (pt carriers / paare sortiert rec)
|
|
(setq paare nil)
|
|
(foreach rec carriers
|
|
(setq paare (cons (cons (distance (list (car pt) (cadr pt))
|
|
(list (nth 7 rec) (nth 8 rec)))
|
|
rec)
|
|
paare))
|
|
)
|
|
(setq sortiert (vl-sort paare (function (lambda (a b) (< (car a) (car b))))))
|
|
(list
|
|
(cdr (nth 0 sortiert))
|
|
(car (nth 0 sortiert))
|
|
(if (cdr sortiert) (cdr (nth 1 sortiert)) nil)
|
|
(if (cdr sortiert) (car (nth 1 sortiert)) nil)
|
|
)
|
|
)
|
|
|
|
;;; --- Carrier-Record mit gegebener ID aus carriers heraussuchen ---
|
|
(defun cs-find-carrier-by-id (carriers id / found rec)
|
|
(setq found nil)
|
|
(foreach rec carriers
|
|
(if (and (not found) (= (nth 9 rec) id)) (setq found rec))
|
|
)
|
|
found
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Ordnet einen Sensor-Punkt (Scanner oder Separator) einem Carrier
|
|
;;; zu (Reihenfolge siehe Datei-Kopfkommentar Schritte 0/1-3/4).
|
|
;;; Rueckgabe: (modus rec best-d second-rec second-d)
|
|
;;; modus = 'manual | 'bbox | 'distance | 'none (keine Carrier vorhanden)
|
|
;;; best-d/second-rec/second-d sind nur bei modus='distance gesetzt.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-resolve-sensor (sent spt carriers grid / existing rec nearest)
|
|
(setq existing (cs-get-att-str sent *zuordnung-tag*))
|
|
(cond
|
|
((and existing (/= existing ""))
|
|
(list 'manual (cs-find-carrier-by-id carriers existing) nil nil nil))
|
|
((setq rec (cs-assign spt grid))
|
|
(list 'bbox rec nil nil nil))
|
|
((null carriers)
|
|
(list 'none nil nil nil nil))
|
|
(t
|
|
(setq nearest (cs-nearest-two spt carriers))
|
|
(list 'distance (nth 0 nearest) (nth 1 nearest) (nth 2 nearest) (nth 3 nearest)))
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Zaehler in einer Assoc-Liste (Schluessel = ename) erhoehen.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-bump (alist key / pair)
|
|
(setq pair (assoc key alist))
|
|
(if pair
|
|
(subst (cons key (1+ (cdr pair))) pair alist)
|
|
(cons (cons key 1) alist))
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Attributwert an einem INSERT setzen (Tag ohne Gross/Klein).
|
|
;;; Rueckgabe: T wenn Tag gefunden und gesetzt, sonst nil.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-set-att (ins tag val / e ed done ok)
|
|
(setq done nil ok nil)
|
|
;; Nur iterieren, wenn der INSERT ueberhaupt Attribute fuehrt (66=1),
|
|
;; sonst wuerde entnext in fremde Objekte weiterlaufen.
|
|
(if (= (cdr (assoc 66 (entget ins))) 1)
|
|
(progn
|
|
(setq e (entnext ins))
|
|
(while (and e (not done))
|
|
(setq ed (entget e))
|
|
(cond
|
|
((= (cdr (assoc 0 ed)) "ATTRIB")
|
|
(if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
|
|
(progn
|
|
(entmod (subst (cons 1 val) (assoc 1 ed) ed))
|
|
(entupd e)
|
|
(setq ok t))))
|
|
((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
|
|
)
|
|
(setq e (entnext e))
|
|
)
|
|
)
|
|
)
|
|
ok
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Attributwert (String) an einem INSERT lesen. "" wenn nicht
|
|
;;; vorhanden. Tag ohne Gross/Klein-Unterscheidung.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-get-att-str (ins tag / e ed done val)
|
|
(setq done nil val "")
|
|
(if (= (cdr (assoc 66 (entget ins))) 1)
|
|
(progn
|
|
(setq e (entnext ins))
|
|
(while (and e (not done))
|
|
(setq ed (entget e))
|
|
(cond
|
|
((= (cdr (assoc 0 ed)) "ATTRIB")
|
|
(if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
|
|
(progn (setq val (cdr (assoc 1 ed))) (setq done t))))
|
|
((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
|
|
)
|
|
(setq e (entnext e))
|
|
)
|
|
)
|
|
)
|
|
val
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Bezeichnung eines Carriers ermitteln: Attribut "Bezeichnung",
|
|
;;; Fallback auf den Blocknamen. Nur fuer Konsolen-/Fehlermeldungen -
|
|
;;; die eigentliche Verknuepfung (ZUORDNUNG) laeuft ueber die ID.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-carrier-label (ent nm / bez)
|
|
(setq bez (cs-get-att-str ent "Bezeichnung"))
|
|
(if (and bez (/= bez "")) bez nm)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Layer anlegen (falls fehlend), ohne den aktuellen Layer zu aendern.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-ensure-layer (name color / lay ed)
|
|
(if (tblsearch "LAYER" name)
|
|
;; Layer existiert bereits: Standardfarbe angleichen
|
|
(progn
|
|
(setq lay (tblobjname "LAYER" name))
|
|
(setq ed (entget lay))
|
|
(if (assoc 62 ed)
|
|
(entmod (subst (cons 62 color) (assoc 62 ed) ed)))
|
|
)
|
|
;; Layer neu anlegen
|
|
(entmake (list '(0 . "LAYER")
|
|
'(100 . "AcDbSymbolTableRecord")
|
|
'(100 . "AcDbLayerTableRecord")
|
|
(cons 2 name)
|
|
(cons 70 0)
|
|
(cons 62 color)
|
|
(cons 6 "Continuous")))
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Sensor ohne jeglichen Carrier mit einem Kreis markieren, zentriert
|
|
;;; auf die Sensor-Geometrie. Radius aus der XY-Box des Sensors
|
|
;;; (Faktor), mindestens *mark-radius-min*.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-mark-unassigned (ent / bb ipt cx cy cz r)
|
|
(setq bb (cs-bbox ent))
|
|
(setq ipt (cdr (assoc 10 (entget ent))))
|
|
(setq cz (if (and ipt (caddr ipt)) (caddr ipt) 0.0))
|
|
(if bb
|
|
(progn
|
|
(setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
|
|
cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
|
|
(setq r (* *mark-radius-factor*
|
|
(/ (distance (list (nth 0 bb) (nth 1 bb))
|
|
(list (nth 2 bb) (nth 3 bb))) 2.0)))
|
|
(if (< r *mark-radius-min*) (setq r *mark-radius-min*)))
|
|
(progn
|
|
(setq cx (car ipt) cy (cadr ipt) r *mark-radius-min*))
|
|
)
|
|
(cs-ensure-layer *mark-layer* *mark-color*)
|
|
(entmake (list '(0 . "CIRCLE")
|
|
(cons 8 *mark-layer*)
|
|
(cons 10 (list cx cy cz))
|
|
(cons 40 r)))
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Schnelltest: Ist ein vollstaendiger cs-zuordnung-lauf ueberhaupt
|
|
;;; noetig? Der eigentliche Lauf ist teuer (vla-getboundingbox + Regen
|
|
;;; je Carrier UND je Sensor). Diese Vorpruefung kommt ohne jede
|
|
;;; Bounding-Box aus - sie liest nur Attribute (entget).
|
|
;;;
|
|
;;; Rueckgabe T (Lauf noetig), wenn EINE der Bedingungen zutrifft:
|
|
;;; a) Ein Scanner-/Separator-Symbol hat ein leeres ZUORDNUNG-Attribut
|
|
;;; (noch nicht zugeordnet) oder ein ZUORDNUNG, das auf keinen
|
|
;;; (mehr) existierenden Carrier zeigt.
|
|
;;; b) An einem Carrier passt ANZAHL_SCANNER nicht zur Anzahl der ihm
|
|
;;; per ZUORDNUNG zugeschriebenen Scanner-Symbole.
|
|
;;; c) An einem Carrier passt ANZAHL_SEPARATOR nicht zur Anzahl der ihm
|
|
;;; per ZUORDNUNG zugeschriebenen Separator-Symbole (nur platzierte
|
|
;;; Symbole zaehlen - dieselbe Regel wie newP im eigentlichen Lauf;
|
|
;;; der interne Staustrecke_Separator_SP zaehlt nicht mit).
|
|
;;; Sonst nil - die gespeicherten Attribute sind konsistent, der teure
|
|
;;; Lauf wird uebersprungen.
|
|
;;;
|
|
;;; Die Zuordnung Symbol->Carrier wird hier billig ueber das bereits
|
|
;;; gesetzte ZUORDNUNG-Attribut rekonstruiert (Carrier-ID), OHNE die
|
|
;;; teure Boundingbox-/Distanz-Rechnung des eigentlichen Laufs. Dadurch
|
|
;;; erkennt der Test - anders als eine reine Gesamtsummen-Pruefung - auch
|
|
;;; das Verschieben eines Sensors von einem Carrier zu einem anderen
|
|
;;; (die Per-Carrier-Zahl kippt, ZUORDNUNG zeigt aber noch auf den alten).
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-zuordnung-noetig-p ( / ss i ent ed nm sk zuord id
|
|
carriers carrier-ids sensors s
|
|
sepByCarrier scanByCarrier
|
|
noetig expScan expSep rec)
|
|
(setq noetig nil carriers nil carrier-ids nil sensors nil
|
|
sepByCarrier nil scanByCarrier nil)
|
|
(setq ss (ssget "_X" '((0 . "INSERT"))))
|
|
(if (null ss)
|
|
nil ;; keine Bloecke -> nichts zu tun
|
|
(progn
|
|
;; Pass 1: Carrier (ename . id) und Sensor-Symbole (kind . ZUORDNUNG)
|
|
;; sammeln - die ssget-Reihenfolge ist beliebig, daher erst sammeln,
|
|
;; dann auswerten.
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq ent (ssname ss i) ed (entget ent) nm (cdr (assoc 2 ed)))
|
|
(cond
|
|
((cs-carrier-p nm)
|
|
(setq id (cs-get-att-str ent "ID"))
|
|
(setq carriers (cons (cons ent id) carriers))
|
|
(setq carrier-ids (cons id carrier-ids)))
|
|
(t
|
|
(setq sk (cs-sensor-kind nm))
|
|
(if sk
|
|
(setq sensors
|
|
(cons (cons sk (cs-get-att-str ent *zuordnung-tag*)) sensors))))
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
;; Pass 2: Symbole ueber ZUORDNUNG je Carrier-ID zaehlen. Leeres
|
|
;; ZUORDNUNG oder ZUORDNUNG auf einen nicht (mehr) existierenden
|
|
;; Carrier -> Lauf noetig.
|
|
(foreach s sensors
|
|
(setq sk (car s) zuord (cdr s))
|
|
(cond
|
|
((or (null zuord) (= zuord "")) (setq noetig T))
|
|
((not (member zuord carrier-ids)) (setq noetig T))
|
|
((eq sk 'scanner) (setq scanByCarrier (cs-bump scanByCarrier zuord)))
|
|
(t (setq sepByCarrier (cs-bump sepByCarrier zuord)))
|
|
)
|
|
)
|
|
;; Pass 3: je Carrier Soll (= zugeschriebene Symbole) gegen die
|
|
;; gespeicherten Attribute pruefen.
|
|
(if (not noetig)
|
|
(foreach rec carriers
|
|
(setq id (cdr rec)) ;; rec = (ename . carrier-id)
|
|
(setq expScan (cond ((assoc id scanByCarrier) (cdr (assoc id scanByCarrier))) (t 0)))
|
|
(setq expSep (cond ((assoc id sepByCarrier) (cdr (assoc id sepByCarrier))) (t 0)))
|
|
(if (or (/= (atoi (cs-get-att-str (car rec) "ANZAHL_SCANNER")) expScan)
|
|
(/= (atoi (cs-get-att-str (car rec) "ANZAHL_SEPARATOR")) expSep))
|
|
(setq noetig T))
|
|
)
|
|
)
|
|
noetig
|
|
)
|
|
)
|
|
)
|
|
|
|
;;; ============================================================
|
|
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
|
|
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
|
|
;;; csv:run-export).
|
|
;;;
|
|
;;; label = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
|
|
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
|
|
;;; (nur fuer den interaktiven Befehl sinnvoll - der
|
|
;;; automatische Aufruf aus csv:run-export laesst dies aus,
|
|
;;; damit die Export-Konsole kompakt bleibt).
|
|
;;;
|
|
;;; Setzt als Nebenwirkung:
|
|
;;; *cs-scanner-ergaenzt* - Liste (scanner-id carrier-id
|
|
;;; distanz-mm strittig-p
|
|
;;; zweiter-carrier-id zweite-distanz-mm)
|
|
;;; je per Abstand (nicht per BBox)
|
|
;;; zugeordnetem Scanner.
|
|
;;; *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
|
|
;;; fuer strittige Scanner-Zuordnungen,
|
|
;;; von csv:block-to-json ausgelesen.
|
|
;;; ============================================================
|
|
(defun cs-zuordnung-lauf (label verbose /
|
|
mss ss i ent ed nm bb cx cy lbl carrier-id
|
|
carriers grid scanlist seplist sk pt
|
|
scanCounts sepCounts n-scan-unassigned n-sep-unassigned
|
|
n-strittig n-zuordnung-fehlt
|
|
s sent spt res mode rec best-d second-rec second-d
|
|
scanner-id contested handle
|
|
en nm2 ns nsep newS newP okS okP eintrag)
|
|
(setq carriers nil scanlist nil seplist nil
|
|
n-zuordnung-fehlt 0 n-scan-unassigned 0 n-sep-unassigned 0 n-strittig 0)
|
|
(setq *cs-scanner-ergaenzt* nil)
|
|
(setq *cs-scanner-warnung-by-handle* nil)
|
|
(setq *senstol* (cs-senstol))
|
|
|
|
;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
|
|
;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
|
|
;; Carrier bekommen haben oder umgekehrt).
|
|
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
|
|
(if mss (command "_.ERASE" mss ""))
|
|
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
|
|
|
|
(princ (ssg-textf "sens-start" (list label)))
|
|
|
|
(setq ss (ssget "_X" '((0 . "INSERT"))))
|
|
(if (null ss)
|
|
(princ (ssg-textf "sens-no-inserts" (list label)))
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq ent (ssname ss i))
|
|
(setq ed (entget ent))
|
|
(setq nm (cdr (assoc 2 ed)))
|
|
(cond
|
|
((cs-carrier-p nm)
|
|
(setq bb (cs-bbox ent))
|
|
(if bb
|
|
(progn
|
|
(setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0))
|
|
(setq cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
|
|
(setq lbl (cs-carrier-label ent nm))
|
|
(setq carrier-id (cs-get-att-str ent "ID"))
|
|
(setq carriers
|
|
(cons (list ent "ANZAHL_SCANNER" "ANZAHL_SEPARATOR"
|
|
(nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb)
|
|
cx cy carrier-id lbl)
|
|
carriers)))
|
|
(princ (ssg-textf "sens-bbox-fehler" (list nm)))
|
|
)
|
|
)
|
|
(t
|
|
(setq sk (cs-sensor-kind nm))
|
|
(if sk
|
|
(progn
|
|
(setq pt (cs-sensor-point ent ed sk))
|
|
(if (eq sk 'scanner)
|
|
(setq scanlist (cons (list ent pt) scanlist))
|
|
(setq seplist (cons (list ent pt) seplist)))))
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
|
|
(setq grid (cs-grid-build carriers))
|
|
(setq scanCounts nil sepCounts nil)
|
|
|
|
;; --- Scanner zuordnen (inkl. Distanz-Fallback + Strittig-Erkennung) ---
|
|
(foreach s scanlist
|
|
(setq sent (car s) spt (cadr s))
|
|
(setq res (cs-resolve-sensor sent spt carriers grid))
|
|
(setq mode (nth 0 res) rec (nth 1 res)
|
|
best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
|
|
(cond
|
|
((eq mode 'none)
|
|
(setq n-scan-unassigned (1+ n-scan-unassigned))
|
|
(cs-mark-unassigned sent))
|
|
((null rec) nil) ;; manuell zugeordnet, ID unbekannt -> unangetastet
|
|
(t
|
|
(setq scanCounts (cs-bump scanCounts (car rec)))
|
|
(if (member mode '(bbox distance))
|
|
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
|
|
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
|
|
(if (eq mode 'distance)
|
|
(progn
|
|
(setq scanner-id (cs-get-att-str sent "ID"))
|
|
(setq contested (and second-rec
|
|
(<= (- second-d best-d) (cs-strittig-diff-mm))))
|
|
(setq *cs-scanner-ergaenzt*
|
|
(cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
|
|
contested
|
|
(if contested (nth 9 second-rec) nil)
|
|
(if contested (fix (+ second-d 0.5)) nil))
|
|
*cs-scanner-ergaenzt*))
|
|
(if contested
|
|
(progn
|
|
(setq n-strittig (1+ n-strittig))
|
|
(setq handle (cdr (assoc 5 (entget sent))))
|
|
(setq *cs-scanner-warnung-by-handle*
|
|
(cons (cons handle
|
|
(strcat "Distanz-Zuordnung unsicher: "
|
|
(nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
|
|
(nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
|
|
*cs-scanner-warnung-by-handle*))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))
|
|
|
|
;; --- Separatoren zuordnen (gleiche Logik, ohne Strittig-Report -
|
|
;; der Distanz-Fallback stellt hier nur sicher, dass die
|
|
;; ANZAHL_SEPARATOR-Summe auch bei Sonderfaellen stimmt). ---
|
|
(foreach s seplist
|
|
(setq sent (car s) spt (cadr s))
|
|
(setq res (cs-resolve-sensor sent spt carriers grid))
|
|
(setq mode (nth 0 res) rec (nth 1 res))
|
|
(cond
|
|
((eq mode 'none)
|
|
(setq n-sep-unassigned (1+ n-sep-unassigned))
|
|
(cs-mark-unassigned sent))
|
|
((null rec) nil)
|
|
(t
|
|
(setq sepCounts (cs-bump sepCounts (car rec)))
|
|
(if (member mode '(bbox distance))
|
|
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
|
|
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; --- ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben ---
|
|
(foreach rec carriers
|
|
(setq en (car rec))
|
|
(setq nm2 (cdr (assoc 2 (entget en))))
|
|
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
|
|
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
|
|
(setq newS ns)
|
|
;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
|
|
;; Symbole (Separator_SP/S-LP), die diesem Carrier zugeordnet sind.
|
|
;; Der intern in der GF/VF-Kette gezeichnete 300-mm-Block
|
|
;; Staustrecke_Separator_SP ist nur ein Kettenglied (Foerder-/
|
|
;; Uebergabestueck), KEIN eigenstaendiger Separator - er wird bewusst
|
|
;; NICHT mitgezaehlt (Entscheidung: nur platzierte Symbole zaehlen).
|
|
(setq newP nsep)
|
|
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
|
|
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
|
|
(if verbose
|
|
(princ (ssg-textf "sens-carrier-zeile"
|
|
(list nm2 (nth 9 rec) (itoa newS) (itoa newP)))))
|
|
(if (not (and okS okP))
|
|
(princ (ssg-textf "sens-carrier-fehler" (list nm2))))
|
|
)
|
|
|
|
;; --- Zusammenfassung ---
|
|
(princ (ssg-textf "sens-summary"
|
|
(list label (itoa (length carriers))
|
|
(itoa (length scanlist)) (itoa n-scan-unassigned)
|
|
(itoa (length seplist)) (itoa n-sep-unassigned))))
|
|
|
|
(if *cs-scanner-ergaenzt*
|
|
(progn
|
|
(princ (ssg-textf "sens-ergaenzt-header"
|
|
(list label (itoa (length *cs-scanner-ergaenzt*)))))
|
|
(foreach eintrag *cs-scanner-ergaenzt*
|
|
(princ (ssg-textf "sens-ergaenzt-zeile"
|
|
(list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
|
|
(if (nth 3 eintrag)
|
|
(princ (ssg-textf "sens-strittig-suffix"
|
|
(list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
|
|
)
|
|
)
|
|
)
|
|
(if (> n-strittig 0)
|
|
(princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))
|
|
|
|
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
|
|
(princ (ssg-textf "sens-unassigned-marked"
|
|
(list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
|
|
(if (> n-zuordnung-fehlt 0)
|
|
(princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
|
|
)
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
;;; ============================================================
|
|
;;; BEFEHL: ZAEHLE_SEP_SCAN - interaktiver Aufruf mit vollem Bericht
|
|
;;; (verbose) und abschliessendem QSAVE. Der automatische Aufruf vor
|
|
;;; jedem CSV-/Sivas-Export (csv:run-export in export.lsp) nutzt
|
|
;;; dieselbe Engine (cs-zuordnung-lauf) direkt, ohne QSAVE.
|
|
;;; ============================================================
|
|
(defun c:ZAEHLE_SEP_SCAN ()
|
|
(cs-zuordnung-lauf "ZAEHLE_SEP_SCAN" T)
|
|
(princ "\n--------------------------------------------")
|
|
(princ "\n Speichere Zeichnung (QSAVE) ...")
|
|
(command "_.QSAVE")
|
|
(princ "\n>>> Fertig.")
|
|
(princ)
|
|
)
|
|
|
|
(princ "\n>>> count_sep_scan.lsp geladen. Befehl: ZAEHLE_SEP_SCAN")
|
|
(princ)
|