s.ayadi
21684101f9
Beim CSV-Export von Mubea trugen Gefaellestrecke/VF/Kreisel und die aus ihnen erzeugten Separator-Kopien dieselbe ID (26 Dubletten 0001-0026), und die ZUORDNUNG der Separatoren zeigte auf den falschen Carrier. ssg-id-check-all: neue Phase 0 ermittelt das globale Maximum der bereits vergebenen IDs, BEVOR die erste neue ID vergeben wird (ausgelagert nach ssg-id-max-in-ss, das auch ssg-id-max nutzt). Bisher wurde max-id erst waehrend Phase 1 mitgezogen (Start 0); da (ssget "X" ...) in BricsCAD die zuletzt erzeugten Entities zuerst liefert, standen die noch ID-losen Separator-Kopien ganz vorne und bekamen 0001, 0002, ... - genau die IDs der weiter hinten liegenden Wrapper-Bloecke. Phase 2 konnte das nicht heilen, weil frisch vergebene IDs nicht in id-map landen. ssg-collect-nested-inserts: fuehrt Position, Z-Drehung und Skalierung jetzt ueber alle Verschachtelungsebenen mit (Records statt nackter Entity-Namen). Vorher gab die Rekursion Entities tieferer Ebenen mit ihrer ROH-Position aus der Zwischen-Blockdefinition zurueck - zwei Separatoren an derselben lokalen Stelle in zwei verschieden platzierten Zwischenbloecken landeten dadurch auf exakt derselben Weltposition. csv:sep-proxies-erzeugen: die Kopie steht jetzt exakt auf Position/Drehung/ Skalierung ihres verpackten Vorbilds; der kosmetische Versatz von 500 mm ist weg (er kippte Separatoren am Kettenende in die Boundingbox des Nachbar- Carriers). Der vla-InsertBlock-Aufruf ist gekapselt, damit ein Sonderfall nur diese eine Kopie ausfallen laesst statt den ganzen Export abzubrechen. csv:sep-proxies-zuordnung-setzen (neu, laeuft NACH ssg-id-check-all, da ein frisch gebauter Wrapper vorher keine ID hat): fuer einen VERPACKTEN Separator ist der Carrier bekannt - es ist der Wrapper, in dem er steckt. ZUORDNUNG wird daher auf die Wrapper-ID gesetzt (Separator in VF 0010 -> ZUORDNUNG 0010) und ueber *cs-sep-fix-by-handle* festgenagelt: cs-zuordnung-lauf uebernimmt sie unveraendert statt sie geometrisch neu zu raten, und csv:block-to-json reicht sie als "zuordnung_fix" an export_csv.py durch. Ohne das ueberschrieb compute_sensor_zuordnung (Prioritaet GF > Foerderer > Kreiselhaelfte) den bekannten Wert - in der Mubea-Zeichnung landeten 26 in VF/GF verpackte Separatoren so bei einer Kreiselhaelfte. export_csv.py: respektiert "zuordnung_fix" und ersetzt eine vorhandene ZUORDNUNG nicht mehr durch "nicht zugeordnet" - nur ein echter Treffer ueberschreibt, wie im Docstring von compute_sensor_zuordnung beschrieben. tests/test_export_ids.py (neu): prueft je tests/output/*_export.csv, dass jede TeileId hoechstens einmal vorkommt und jede Sensor-Zuordnung auf eine existierende TeileId zeigt. Gegen die fehlerhafte Mubea-CSV schlaegt der Test mit allen 26 Dubletten an. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
879 lines
38 KiB
Common Lisp
879 lines
38 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. Die Zuordnung wird bei jedem Lauf rein GEOMETRISCH neu
|
|
;;; bestimmt (Schritte 1-4). Ein bereits gesetztes ZUORDNUNG-
|
|
;;; Attribut wird NICHT mehr blind vertraut: stimmt es mit dem
|
|
;;; geometrischen Ergebnis ueberein, bleibt es unveraendert;
|
|
;;; weicht es ab (eingefrorene Fehl-Zuordnung, nachtraeglich
|
|
;;; verschobener Sensor oder ID eines nicht mehr existierenden
|
|
;;; Carriers), wird es ueberschrieben und die Korrektur in
|
|
;;; *cs-korrekturen* vermerkt (Konsolen-Report, siehe
|
|
;;; sens-korrektur-*). Frueher blieb eine einmal geschriebene
|
|
;;; falsche ZUORDNUNG dauerhaft "kleben" und wurde weiter
|
|
;;; mitgezaehlt - das ist behoben.
|
|
;;; 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.
|
|
;;; 6a. AUSNAHME zu 1-5: Separatoren, deren Entity-Handle in
|
|
;;; *cs-sep-fix-by-handle* steht, werden NICHT geometrisch
|
|
;;; zugeordnet, sondern dem dort genannten Carrier. Das sind die
|
|
;;; temporaeren Kopien der in VF_n/GF_n/KREISEL_n VERPACKTEN
|
|
;;; Separator_SP-Symbole (csv:sep-proxies-erzeugen/-zuordnung-
|
|
;;; setzen, export.lsp): fuer sie ist der Carrier bekannt - es ist
|
|
;;; der Wrapper-Block, in dem sie stecken -, und Raten per
|
|
;;; Boundingbox waere schlechter als die bekannte Wahrheit (am
|
|
;;; Kettenende ueberlappen sich Carrier-Boxen). Existiert der
|
|
;;; genannte Carrier nicht (mehr), greifen wieder 1-5.
|
|
;;; 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")
|
|
|
|
;; Festgenagelte (nicht geometrisch zu ermittelnde) Separator-Zuordnungen:
|
|
;; Assoc-Liste (entity-handle . carrier-id). Wird von csv:sep-proxies-
|
|
;; zuordnung-setzen (export.lsp) fuer die temporaeren Kopien der in
|
|
;; VF_n/GF_n/KREISEL_n VERPACKTEN Separator_SP-Symbole gefuellt - fuer die ist
|
|
;; der Carrier bekannt (es ist der Wrapper, in dem sie stecken) und muss
|
|
;; nicht ueber Boundingbox/Distanz geraten werden. Bei ueberlappenden
|
|
;; Carrier-Boxen (Kettenende an einem Kreisel) wuerde die Geometrie sonst
|
|
;; leicht den Nachbarn treffen. Leer = alles rein geometrisch (Normalfall
|
|
;; beim interaktiven ZAEHLE_SEP_SCAN).
|
|
(if (null *cs-sep-fix-by-handle*) (setq *cs-sep-fix-by-handle* nil))
|
|
|
|
;; 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)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Ordnet einen Sensor-Punkt (Scanner oder Separator) rein
|
|
;;; GEOMETRISCH einem Carrier zu (Reihenfolge siehe Datei-Kopf-
|
|
;;; kommentar Schritte 1-3 = BBox, Schritt 4 = naechster Carrier).
|
|
;;; Ein bereits am Sensor stehendes ZUORDNUNG-Attribut geht hier
|
|
;;; bewusst NICHT mehr ein - der Vergleich Alt/Neu und das
|
|
;;; Ueberschreiben abweichender Werte passiert in cs-zuordnung-lauf
|
|
;;; (Schritt 0 im Kopfkommentar). Dadurch heilt eine einmal falsch
|
|
;;; gesetzte oder verwaiste ZUORDNUNG bei jedem Lauf selbst aus.
|
|
;;; Rueckgabe: (modus rec best-d second-rec second-d)
|
|
;;; modus = 'bbox | 'distance | 'none (keine Carrier vorhanden)
|
|
;;; best-d/second-rec/second-d sind nur bei modus='distance gesetzt.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-resolve-sensor (spt carriers grid / rec nearest)
|
|
(cond
|
|
((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)))
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Carrier-Record ueber seine ID finden (siehe *cs-sep-fix-by-handle*).
|
|
;;; carriers = Liste von Records (ename tagScan tagSep minx miny maxx
|
|
;;; maxy cx cy id label), id an Position 9.
|
|
;;; Rueckgabe: Record oder nil, wenn kein Carrier diese ID traegt.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-carrier-by-id (id carriers / rec treffer)
|
|
(if (and id (/= id ""))
|
|
(foreach rec carriers
|
|
(if (and (null treffer) (= (nth 9 rec) id))
|
|
(setq treffer rec)))
|
|
)
|
|
treffer
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; 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.
|
|
;;; *cs-korrekturen* - Liste (typ-wort sensor-id alt-id
|
|
;;; neu-id) je Sensor, dessen gespeicherte
|
|
;;; ZUORDNUNG nicht zur Geometrie passte
|
|
;;; und ueberschrieben wurde (Report).
|
|
;;; ============================================================
|
|
(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 alt
|
|
s sent spt res mode rec best-d second-rec second-d
|
|
vorgabe-id vorgabe-rec
|
|
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 *cs-korrekturen* 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 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) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
|
|
(t
|
|
(setq scanCounts (cs-bump scanCounts (car rec)))
|
|
;; Abweichende gespeicherte ZUORDNUNG als Korrektur vermerken,
|
|
;; bevor sie unten ueberschrieben wird (Selbstheilung eingefrorener
|
|
;; oder verwaister Zuordnungen).
|
|
(setq alt (cs-get-att-str sent *zuordnung-tag*))
|
|
(if (and alt (/= alt "") (/= alt (nth 9 rec)))
|
|
(setq *cs-korrekturen*
|
|
(cons (list "Scanner" (cs-get-att-str sent "ID") alt (nth 9 rec))
|
|
*cs-korrekturen*)))
|
|
(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))
|
|
;; Festgenagelte Zuordnung (verpackter Separator, Carrier bekannt -
|
|
;; siehe *cs-sep-fix-by-handle*) hat Vorrang vor der Geometrie. Nur
|
|
;; wenn der genannte Carrier gar nicht (mehr) existiert, wird
|
|
;; geometrisch zugeordnet.
|
|
(setq vorgabe-id (cdr (assoc (cdr (assoc 5 (entget sent))) *cs-sep-fix-by-handle*)))
|
|
(setq vorgabe-rec (cs-carrier-by-id vorgabe-id carriers))
|
|
(if vorgabe-rec
|
|
(setq mode 'vorgabe rec vorgabe-rec)
|
|
(progn
|
|
(setq res (cs-resolve-sensor 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) ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
|
|
(t
|
|
(setq sepCounts (cs-bump sepCounts (car rec)))
|
|
;; Abweichung nur bei geometrischer Zuordnung als Korrektur melden -
|
|
;; bei mode 'vorgabe ist der geschriebene Wert die Vorgabe selbst,
|
|
;; keine Korrektur einer Fehl-Zuordnung.
|
|
(setq alt (cs-get-att-str sent *zuordnung-tag*))
|
|
(if (and (not (eq mode 'vorgabe)) alt (/= alt "") (/= alt (nth 9 rec)))
|
|
(setq *cs-korrekturen*
|
|
(cons (list "Separator" (cs-get-att-str sent "ID") alt (nth 9 rec))
|
|
*cs-korrekturen*)))
|
|
(if (member mode '(vorgabe 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)))))
|
|
|
|
;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
|
|
(if *cs-korrekturen*
|
|
(progn
|
|
(setq *cs-korrekturen* (reverse *cs-korrekturen*))
|
|
(princ (ssg-textf "sens-korrektur-header"
|
|
(list label (itoa (length *cs-korrekturen*)))))
|
|
(foreach eintrag *cs-korrekturen*
|
|
(princ (ssg-textf "sens-korrektur-zeile"
|
|
(list (nth 0 eintrag) (nth 1 eintrag)
|
|
(nth 2 eintrag) (nth 3 eintrag)))))
|
|
)
|
|
)
|
|
|
|
(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)
|