502 lines
20 KiB
Common Lisp
502 lines
20 KiB
Common Lisp
;;; ============================================================
|
|
;;; count_sep_scan.lsp - Eigenstaendiges Zaehl-Werkzeug
|
|
;;; ------------------------------------------------------------
|
|
;;; Zaehlt die manuell platzierten Bloecke "Scanner" und
|
|
;;; "Separator_SP" je ILS-Block (Kreisel / VarioFoerderer /
|
|
;;; Gefaellestrecke) und schreibt die Anzahlen in die Attribute
|
|
;;; des jeweiligen ILS-Blocks. Anschliessend QSAVE.
|
|
;;;
|
|
;;; Zuordnung eines Sensors zu einem ILS-Block (Z wird ignoriert):
|
|
;;; - Scanner: der Einfuegepunkt (X/Y) muss in der Bounding-Box
|
|
;;; des ILS-Blocks liegen. Die 3D-Geometrie des Scanners kann
|
|
;;; weit vom Einfuegepunkt entfernt sein, daher zaehlt hier der
|
|
;;; Einfuegepunkt (dort klickt der Benutzer auf den Block).
|
|
;;; - Separator: der geometrische Mittelpunkt (Zentrum der eigenen
|
|
;;; Bounding-Box, unabhaengig vom $INSBASE) muss in der
|
|
;;; Bounding-Box des ILS-Blocks liegen.
|
|
;;; - Liegt der Punkt in mehreren Boxen (Ueberlappung), wird
|
|
;;; der ILS-Block mit dem naechstgelegenen Box-Zentrum gewaehlt.
|
|
;;; - Ein optionaler Toleranzrand (*senstol*) vergroessert die
|
|
;;; Box, damit Sensoren knapp am Rand noch erfasst werden.
|
|
;;;
|
|
;;; Zusaetzlich:
|
|
;;; - Bei zugeordneten Sensoren wird die Bezeichnung des ILS-Blocks
|
|
;;; (Attribut "Bezeichnung", Fallback Blockname) in das Sensor-
|
|
;;; Attribut *zuordnung-tag* geschrieben.
|
|
;;; - Nicht zugeordnete Sensoren werden mit einem Kreis auf dem
|
|
;;; Layer *mark-layer* markiert (zentriert auf den Sensor).
|
|
;;; - Der Befehl ist wiederholbar: alte Markierungskreise werden
|
|
;;; zu Beginn entfernt.
|
|
;;;
|
|
;;; Aufruf: ZAEHLE_SEP_SCAN
|
|
;;; Laden: per APPLOAD oder (load "count_sep_scan")
|
|
;;; ============================================================
|
|
|
|
(vl-load-com)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; KONFIGURATION (bei Bedarf anpassen)
|
|
;;; ------------------------------------------------------------
|
|
|
|
;; Toleranzrand um die ILS-Block-Box in Zeichnungseinheiten (mm).
|
|
;; 0.0 = exakte Box. Groesserer Wert = Sensoren knapp ausserhalb
|
|
;; werden noch dem ILS-Block zugerechnet.
|
|
(if (null *senstol*) (setq *senstol* 0.0))
|
|
|
|
;; Blockname-Muster (wcmatch, Grossschreibung) fuer die manuell
|
|
;; platzierten Sensoren.
|
|
(setq *scanner-pattern* "SCANNER,SCANNER_*")
|
|
(setq *separator-pattern* "SEPARATOR_SP,SEPARATOR_SP_*")
|
|
|
|
;; Blockname-Muster fuer die INTERN im ILS-Block (in der Kette)
|
|
;; gezeichneten Separatoren. Diese bilden die Basis fuer
|
|
;; ANZAHL_SEPARATOR und werden bei jedem Lauf frisch gezaehlt.
|
|
(setq *intern-separator-pattern* "STAUSTRECKE_SEPARATOR_SP*")
|
|
|
|
;; Attribut-Tag im Scanner-/Separator-Block, in das die Bezeichnung
|
|
;; des zugeordneten ILS-Blocks geschrieben wird (Gross/Klein egal).
|
|
(setq *zuordnung-tag* "zuordnung")
|
|
|
|
;; Markierung nicht zugeordneter Sensoren: 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))
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; ILS-Block-Erkennung und zugehoerige Attribut-Tags
|
|
;;; Alle ILS-Bloecke (Kreisel / VF / GF) verwenden einheitlich
|
|
;;; ANZAHL_SCANNER und ANZAHL_SEPARATOR.
|
|
;;; Rueckgabe: (scanner-tag separator-tag) oder nil
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-carrier-tags (nm / up)
|
|
(setq up (strcase nm))
|
|
(if (or (wcmatch up "KREISEL_*")
|
|
(wcmatch up "VF_*")
|
|
(wcmatch up "GF_*"))
|
|
(list "ANZAHL_SCANNER" "ANZAHL_SEPARATOR")
|
|
nil
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Sensor-Erkennung
|
|
;;; Rueckgabe: 'scanner | 'separator | nil
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-sensor-kind (nm / up)
|
|
(setq up (strcase nm))
|
|
(cond
|
|
((wcmatch up *scanner-pattern*) 'scanner)
|
|
((wcmatch up *separator-pattern*) 'separator)
|
|
(t nil)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Punkt-Rueckgabe von vla-getboundingbox in eine Liste wandeln.
|
|
;;; BricsCAD liefert ein Safearray, AutoCAD ein Variant mit
|
|
;;; Safearray - beide Faelle werden hier abgedeckt.
|
|
;;; ------------------------------------------------------------
|
|
(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)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; 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-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 ILS-Block-Record rec (mit Toleranz)?
|
|
;;; rec = (ename tagScan tagSep minx miny maxx maxy cx cy)
|
|
;;; ------------------------------------------------------------
|
|
(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*)))
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Sensor-Punkt einem ILS-Block zuordnen.
|
|
;;; Rueckgabe: ILS-Block-Record oder nil (keine Zuordnung).
|
|
;;; Bei mehreren Treffern: naechstes Box-Zentrum (X/Y).
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-assign (pt carriers / matches best bestd d)
|
|
(setq matches nil)
|
|
(foreach rec carriers
|
|
(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)
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; 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
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Zaehlt rekursiv, wie oft ein Block (Muster pat) in der
|
|
;;; Definition des Blocks bname verwendet wird - inklusive
|
|
;;; verschachtelter Unterbloecke. Damit wird die interne Anzahl
|
|
;;; der Kette-Separatoren aus der Geometrie ermittelt.
|
|
;;; ------------------------------------------------------------
|
|
(defun cs-count-nested (bname pat / e ed nm n stop)
|
|
(setq n 0 stop nil)
|
|
(setq e (tblobjname "BLOCK" bname))
|
|
(if e
|
|
(progn
|
|
(setq e (entnext e))
|
|
(while (and e (not stop))
|
|
(setq ed (entget e))
|
|
(cond
|
|
((= (cdr (assoc 0 ed)) "ENDBLK") (setq stop t))
|
|
((= (cdr (assoc 0 ed)) "INSERT")
|
|
(setq nm (cdr (assoc 2 ed)))
|
|
(if (wcmatch (strcase nm) pat)
|
|
(setq n (1+ n))
|
|
(setq n (+ n (cs-count-nested nm pat)))))
|
|
)
|
|
(if (not stop) (setq e (entnext e)))
|
|
)
|
|
)
|
|
)
|
|
n
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; 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 ILS-Blocks ermitteln: Attribut "Bezeichnung",
|
|
;;; Fallback auf den Blocknamen.
|
|
;;; ------------------------------------------------------------
|
|
(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")))
|
|
)
|
|
)
|
|
|
|
;;; ------------------------------------------------------------
|
|
;;; Nicht zugeordneten Sensor 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)))
|
|
)
|
|
|
|
;;; ============================================================
|
|
;;; HAUPTBEFEHL
|
|
;;; ============================================================
|
|
(defun c:ZAEHLE_SEP_SCAN ( / ss i ent ed nm tags bb cx cy label
|
|
carriers scanlist seplist kind pt
|
|
scanCounts sepCounts
|
|
rec en nm2 ns nsep internSep newS newP
|
|
s sent spt
|
|
n-scan-unassigned n-sep-unassigned
|
|
n-zuordnung-fehlt mss
|
|
okS okP)
|
|
(setq carriers nil scanlist nil seplist nil n-zuordnung-fehlt 0)
|
|
|
|
;; Alte Markierungskreise entfernen (Idempotenz)
|
|
(setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
|
|
(if mss (command "_.ERASE" mss ""))
|
|
|
|
;; Vor der Extents-Berechnung einmal regenerieren, damit
|
|
;; vla-getboundingbox verlaessliche Werte liefert.
|
|
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
|
|
|
|
;; --- 1. Alle INSERTs sammeln und klassifizieren ---
|
|
(setq ss (ssget "_X" '((0 . "INSERT"))))
|
|
(if (null ss)
|
|
(progn (princ "\n>>> Keine Bloecke in der Zeichnung gefunden.") (princ))
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq ent (ssname ss i))
|
|
(setq ed (entget ent))
|
|
(setq nm (cdr (assoc 2 ed)))
|
|
(setq tags (cs-carrier-tags nm))
|
|
(cond
|
|
;; --- ILS-Block ---
|
|
(tags
|
|
(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 label (cs-carrier-label ent nm))
|
|
(setq carriers
|
|
(cons (list ent (car tags) (cadr tags)
|
|
(nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb)
|
|
cx cy label)
|
|
carriers)))
|
|
(princ (strcat "\n! Bounding-Box fehlgeschlagen fuer ILS-Block '" nm "'"
|
|
(if *cs-last-error*
|
|
(strcat " (" *cs-last-error* ")") "")))
|
|
)
|
|
)
|
|
;; --- Sensor (Entity + Referenzpunkt merken) ---
|
|
(t
|
|
(setq kind (cs-sensor-kind nm))
|
|
(if kind
|
|
(progn
|
|
(setq pt (cs-sensor-point ent ed kind))
|
|
(if (eq kind 'scanner)
|
|
(setq scanlist (cons (list ent pt) scanlist))
|
|
(setq seplist (cons (list ent pt) seplist)))))
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
|
|
;; --- 2. Sensoren zuordnen: zuordnung schreiben bzw. markieren ---
|
|
(setq scanCounts nil sepCounts nil
|
|
n-scan-unassigned 0 n-sep-unassigned 0)
|
|
|
|
(foreach s scanlist
|
|
(setq sent (car s) spt (cadr s))
|
|
(setq rec (cs-assign spt carriers))
|
|
(if rec
|
|
(progn
|
|
(setq scanCounts (cs-bump scanCounts (car rec)))
|
|
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
|
|
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
|
|
(progn
|
|
(setq n-scan-unassigned (1+ n-scan-unassigned))
|
|
(cs-set-att sent *zuordnung-tag* "")
|
|
(cs-mark-unassigned sent))))
|
|
|
|
(foreach s seplist
|
|
(setq sent (car s) spt (cadr s))
|
|
(setq rec (cs-assign spt carriers))
|
|
(if rec
|
|
(progn
|
|
(setq sepCounts (cs-bump sepCounts (car rec)))
|
|
(if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
|
|
(setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
|
|
(progn
|
|
(setq n-sep-unassigned (1+ n-sep-unassigned))
|
|
(cs-set-att sent *zuordnung-tag* "")
|
|
(cs-mark-unassigned sent))))
|
|
|
|
;; --- 3. ANZAHL-Attribute setzen und Bericht ausgeben ---
|
|
(princ "\n============================================")
|
|
(princ "\n Sensor-Zaehlung je ILS-Block")
|
|
(princ "\n============================================")
|
|
(if (null carriers)
|
|
(princ "\n (Keine ILS-Bloecke KREISEL_/VF_/GF_ gefunden)")
|
|
(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)))
|
|
;; interne Kette-Separatoren frisch aus der Blockdefinition zaehlen
|
|
(setq internSep (cs-count-nested nm2 *intern-separator-pattern*))
|
|
;; Scanner = nur neu zugeordnete
|
|
;; Separator = interne Kette-Separatoren + neu zugeordnete
|
|
(setq newS ns)
|
|
(setq newP (+ internSep nsep))
|
|
;; gefundene Anzahlen melden (mit Bezeichnung/Label)
|
|
(princ (strcat "\n " nm2 " [" (nth 9 rec) "]"
|
|
": Scanner(neu)=" (itoa ns)
|
|
", Separator intern=" (itoa internSep)
|
|
" + manuell=" (itoa nsep)))
|
|
;; Werte schreiben und Ergebnis bestaetigen
|
|
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
|
|
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
|
|
(if (and okS okP)
|
|
(princ (strcat "\n -> geschrieben: "
|
|
"ANZAHL_SCANNER=" (itoa newS)
|
|
", ANZAHL_SEPARATOR=" (itoa newP)))
|
|
(princ (strcat "\n -> FEHLER beim Schreiben: "
|
|
(if okS "" "ANZAHL_SCANNER fehlt ")
|
|
(if okP "" "ANZAHL_SEPARATOR fehlt"))))
|
|
)
|
|
)
|
|
(princ (strcat "\n--------------------------------------------"
|
|
"\n ILS-Bloecke gesamt: " (itoa (length carriers))
|
|
"\n Scanner gesamt: " (itoa (length scanlist))
|
|
" (nicht zugeordnet: " (itoa n-scan-unassigned) ")"
|
|
"\n Separator gesamt: " (itoa (length seplist))
|
|
" (nicht zugeordnet: " (itoa n-sep-unassigned) ")"))
|
|
(if (> (+ n-scan-unassigned n-sep-unassigned) 0)
|
|
(princ (strcat "\n " (itoa (+ n-scan-unassigned n-sep-unassigned))
|
|
" nicht zugeordnete(r) Sensor(en) mit Kreis markiert"
|
|
" (Layer '" *mark-layer* "').")))
|
|
(if (> n-zuordnung-fehlt 0)
|
|
(princ (strcat "\n WARNUNG: " (itoa n-zuordnung-fehlt)
|
|
" zugeordnete(r) Sensor(en) ohne Attribut '"
|
|
*zuordnung-tag* "' - Bezeichnung nicht schreibbar.")))
|
|
|
|
;; --- 4. Zeichnung speichern ---
|
|
(princ "\n--------------------------------------------")
|
|
(princ "\n Speichere Zeichnung (QSAVE) ...")
|
|
(command "_.QSAVE")
|
|
(princ "\n>>> Fertig.")
|
|
(princ)
|
|
)
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
(princ "\n>>> count_sep_scan.lsp geladen. Befehl: ZAEHLE_SEP_SCAN")
|
|
(princ)
|