Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
tro-edit-slots
dxfmakros/Lisp/Tro_Edit.lsp
T
s.ayadi 56c926cc07 TRO_EDIT/TRO_INSERT: ein Dialog mit Slot-Liste fuer alle TRO-Typen 
- tro_edit.dcl: Kennung, Typ, Liste der Slots des Typs (aus *TRO-SLOTS*
  in tro_types.lsp) mit TeileId je Slot, Edit-Zeile, "Im Plan waehlen <"
  (naechstes Bauteil passender Art aus dem XRECORD SPS_SKEL_PARTS),
  +/- fuer Lagerlinien, Warnzeile (leer/doppelt/in anderem Marker)
- Typwechsel behaelt gleichnamige Slots; gespeichert im Attribut SLOTS
- TRO_INSERT nutzt denselben Dialog (Enter = Mitte der Bauteile),
  tro_insert.dcl entfaellt
- tro_types.lsp neu erzeugt (sps_skel tro_annotate --emit-lisp)
- Rueckweg nach sps_skel: tro_annotate --read-tros

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-26 14:35:19 +01:00

741 lines
25 KiB
Common Lisp
Raw Permalink Blame History

;; ============================================================
;; TRO_EDIT.LSP - TRO-Marker einfuegen und bearbeiten
;;
;; Verwaltet die Attribute eines TRO_*-Blocks. Die Marker werden in der
;; Regel von sps_skel (lib/tro_annotate.py) in eine Kopie der Zeichnung
;; eingefuegt; ein Marker ist ein Block TRO_SYM_<Typ> mit den Attributen
;; ID, TYPE sichtbar
;; FB_BLOCK sichtbar (nur wenn mit --fb beschriftet)
;; UID, ITEMS, CONFIDENCE unsichtbar, reine Daten
;; KEY unsichtbar, Schluessel fuer sps_skel (ID der
;; ID-Datei); leer bei einem mit TRO_INSERT gesetzten
;; SLOTS unsichtbar, Bauteil (TeileId) je Slot:
;; "separator1=0010;switch1=0061;lines=0066,0069"
;;
;; Ein Dialog fuer alle Typen (dcl/tro_edit.dcl): die Slot-Liste kommt aus
;; dem Typ (*TRO-SLOTS*), nicht aus einer eigenen Maske je Typ. Bei einem
;; Typwechsel behalten gleichnamige Slots ihr Bauteil. Typen mit
;; Lagerlinien (PinStore_Auto, EmptyCarrBuffer) bekommen +/- fuer die
;; Linien. "Im Plan waehlen <" schliesst den Dialog, nimmt einen Punkt und
;; setzt das naechste Bauteil der passenden Art aus der Bauteiltabelle
;; (XRECORD SPS_SKEL_PARTS, von tro_annotate.py in die Zeichnung gelegt).
;; Leere Separatoren und Bauteile, die schon in einem anderen Marker
;; stecken, zeigt der Dialog als Warnung - speichern geht trotzdem.
;;
;; Aufruf TRO_INSERT (neuen Marker einfuegen):
;; - Menue SSG_LIB > TRO > Marker einfuegen
;; - direkt: TRO_INSERT
;; Fuegt eine bestehende TRO_SYM_<Typ>-Blockdefinition ein - die Form
;; entsteht nur ueber tro_annotate.py, TRO_INSERT zeichnet keine neue.
;; Enter beim Einfuegepunkt setzt den Marker in die Mitte seiner Bauteile.
;;
;; Aufruf TRO_EDIT (bestehenden Marker aendern):
;; - Doppelklick auf den Marker -> ***DOUBLECLICK [INSERT] -> SSG_BLOCKEDIT
;; - EATTEDIT -> c:EATTEDIT -> SSG_BLOCKEDIT
;; - Menue SSG_LIB > TRO > Marker bearbeiten
;; - direkt: TRO_EDIT
;; Der Dispatcher SSG_BLOCKEDIT (SSG_LIB_Commands.lsp) leitet Blocknamen
;; "TRO_*" hierher.
;;
;; Zurueck nach sps_skel: Zeichnung als DXF speichern, dann
;; tro_annotate --file <csv> --read-tros
;; schreibt die Aenderungen (auch geloeschte Marker) nach
;; cfg/tro_overrides.ini; tro_flow wendet sie beim naechsten Lauf an.
;;
;; Typliste, Slots je Typ und Bauteilarten je Slot kommen aus tro_types.lsp,
;; die sps_skel mit
;; lib/tro_annotate.py --emit-lisp
;; nach DXFM_LISP schreibt. Fehlt die Datei, bleibt bei TRO_EDIT nur der
;; aktuelle Typ mit den Slots des Markers; TRO_INSERT bricht dann ab (siehe
;; tro-insert-kein-typ).
;;
;; Grenze: die *Form* des Markers gehoert zur Blockdefinition des Typs und
;; FB_BLOCK ist aus dem Typ abgeleitet; beides passt erst nach einem neuen
;; Lauf von tro_annotate.py wieder.
;;
;; Setzt ssg_core.lsp (ssg-start/ssg-end, ssg-attrib-*, ssg-join) und
;; ssg_lang.lsp voraus.
;; ============================================================
(setq *tro-block-prefix* "TRO_SYM_")
(setq *tro-parts-xrecord* "SPS_SKEL_PARTS")
;; Umkreis (Zeichnungseinheiten = mm), in dem "Im Plan waehlen" ein Bauteil sucht
(setq *tro-pick-radius* 1000.0)
;; ------------------------------------------------------------
;; Gueltige TRO-Typen laden (aus tro_types.lsp, erzeugt aus dem Katalog)
;; ------------------------------------------------------------
(defun tro-typen-laden ( / datei)
(if (null *TRO-TYPES*)
(progn
(setq datei
(cond
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*
(findfile (strcat *ssg-lisp-pfad* "/tro_types.lsp")))
(strcat *ssg-lisp-pfad* "/tro_types.lsp"))
((getenv "DXFM_LISP")
(findfile (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP"))
"/tro_types.lsp")))
(t (findfile "tro_types.lsp"))
)
)
(if datei (load datei))
)
)
*TRO-TYPES*
)
;; ------------------------------------------------------------
;; Position eines Elements in einer Liste (nil wenn nicht enthalten)
;; ------------------------------------------------------------
(defun tro-index (item lst / i pos)
(setq i 0 pos nil)
(foreach x lst
(if (and (null pos) (= (strcase x) (strcase item))) (setq pos i))
(setq i (1+ i))
)
pos
)
;; ------------------------------------------------------------
;; Auswahlliste aufbauen: Katalogtypen, der aktuelle Typ immer enthalten
;; ------------------------------------------------------------
(defun tro-typliste (aktueller / liste)
(setq liste (tro-typen-laden))
(if (and aktueller (/= aktueller "") (null (tro-index aktueller liste)))
(setq liste (append liste (list aktueller)))
)
(if liste liste (list (if aktueller aktueller "")))
)
;; ------------------------------------------------------------
;; Zahl mit fuehrenden Nullen auf gegebene Breite auffuellen
;; ------------------------------------------------------------
(defun tro-id-format (n breite / s)
(setq s (itoa n))
(while (< (strlen s) breite) (setq s (strcat "0" s)))
(strcat "TRO" s)
)
;; ------------------------------------------------------------
;; Naechste freie TRO-Kennung vorschlagen.
;; Sucht ueber alle TRO_*-Blockinstanzen die hoechste Zahl hinter "TRO"
;; (Format wie in sps_skel, lib/tro_flow.py: "TRO" + Zahl) und schlaegt die
;; naechste vor, in derselben Stellenbreite wie der bisherige Bestand
;; (Default 2-stellig, wenn noch keine TROs in der Zeichnung sind).
;; ------------------------------------------------------------
(defun tro-naechste-id ( / ss i ent attribs id-val rest num maxnum breite)
(setq maxnum 0 breite 2)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "TRO_*"))))
(progn
(setq i 0)
(while (setq ent (ssname ss i))
(setq attribs (ssg-attrib-read ent))
(setq id-val (cdr (assoc "ID" attribs)))
(if (and id-val (>= (strlen id-val) 4)
(= (strcase (substr id-val 1 3)) "TRO"))
(progn
(setq rest (substr id-val 4))
(setq num (atoi rest))
(if (> num maxnum) (setq maxnum num))
(if (> (strlen rest) breite) (setq breite (strlen rest)))
)
)
(setq i (1+ i))
)
)
)
(tro-id-format (1+ maxnum) breite)
)
;; ------------------------------------------------------------
;; Layer fuer einen neuen Marker ermitteln.
;; Uebernimmt den Layer einer bereits vorhandenen Instanz desselben Blocks
;; (Farbgruppen-Layer stammen aus tro_annotate.py/build_layers), sonst der
;; aktuell aktive Layer.
;; ------------------------------------------------------------
(defun tro-marker-layer (bname / ss)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))
(cdr (assoc 8 (entget (ssname ss 0))))
(getvar "CLAYER")
)
)
;; ============================================================
;; SLOTS - Bauteile je Slot
;; Ein Slot-Zustand ist eine Assoziationsliste (("separator1" . "0010")
;; ("switch1" . "") ("line1" . "0066") ...); "" = Slot leer.
;; ============================================================
;; Text an einem Trennzeichen zerlegen: (tro-split "a;b;" ";") -> ("a" "b" "")
(defun tro-split (text sep / pos res)
(while (setq pos (vl-string-search sep text))
(setq res (cons (substr text 1 pos) res)
text (substr text (+ pos 1 (strlen sep))))
)
(reverse (cons text res))
)
;; Slot-Art ohne Nummer: "separator2" -> "separator", "line17" -> "line"
(defun tro-slot-art (slot)
(vl-string-right-trim "0123456789" slot)
)
(defun tro-ist-linie (slot)
(= (tro-slot-art slot) "line")
)
;; Definition eines Typs aus *TRO-SLOTS*: (Linien-Vorgabe "separator1" ...)
(defun tro-slot-def (typ)
(if (and (boundp '*TRO-SLOTS*) *TRO-SLOTS*)
(cdr (assoc typ *TRO-SLOTS*))
)
)
(defun tro-linien-vorgabe (typ / def)
(setq def (tro-slot-def typ))
(if def (car def) 0)
)
(defun tro-linien-zahl (slots / n)
(setq n 0)
(foreach p slots (if (tro-ist-linie (car p)) (setq n (1+ n))))
n
)
;; Attribut SLOTS lesen: "separator1=0010;lines=0066,0069" -> Slot-Zustand
(defun tro-slots-lesen (text / pos k v n res)
(foreach teil (tro-split (if text text "") ";")
(if (setq pos (vl-string-search "=" teil))
(progn
(setq k (strcase (vl-string-trim " " (substr teil 1 pos)) T)
v (vl-string-trim " " (substr teil (+ pos 2))))
(if (= k "lines")
(progn
(setq n 0)
(foreach x (tro-split v ",")
(setq x (vl-string-trim " " x))
(if (/= x "")
(setq n (1+ n)
res (cons (cons (strcat "line" (itoa n)) x) res))
)
)
)
(setq res (cons (cons k v) res))
)
)
)
)
(reverse res)
)
;; Slot-Zustand -> Attribut SLOTS. Nie leer ("-"), weil ssg-attrib-set-on
;; leere Werte nicht schreibt.
(defun tro-slots-text (slots / teile linien)
(foreach p slots
(if (tro-ist-linie (car p))
(if (/= (cdr p) "") (setq linien (cons (cdr p) linien)))
(setq teile (cons (strcat (car p) "=" (cdr p)) teile))
)
)
(setq teile (reverse teile))
(if linien
(setq teile (append teile (list (strcat "lines=" (ssg-join (reverse linien) ",")))))
)
(if teile (ssg-join teile ";") "-")
)
;; Lagerlinien fortlaufend nummerieren (nach + / -)
(defun tro-linien-nummerieren (slots / n res)
(setq n 0)
(foreach p slots
(if (tro-ist-linie (car p))
(setq n (1+ n)
res (cons (cons (strcat "line" (itoa n)) (cdr p)) res))
(setq res (cons p res))
)
)
(reverse res)
)
;; Slots eines Typs aufbauen; gleichnamige Slots behalten ihr Bauteil aus
;; `alt`, Lagerlinien bleiben. Hat der Typ Lagerlinien und `alt` keine,
;; kommt die Vorgabe des Katalogs als leere Linien dazu. Ohne tro_types.lsp
;; bleibt `alt` unveraendert.
(defun tro-slots-fuer-typ (typ alt / def res linien n)
(setq def (tro-slot-def typ))
(if (null def)
alt
(progn
(foreach s (cdr def)
(setq res (cons (cons s (if (assoc s alt) (cdr (assoc s alt)) "")) res))
)
(if (> (car def) 0)
(progn
(foreach p alt (if (tro-ist-linie (car p)) (setq linien (cons p linien))))
(if linien
(setq res (append (reverse linien) res))
(progn
(setq n 0)
(repeat (car def)
(setq n (1+ n)
res (cons (cons (strcat "line" (itoa n)) "") res))
)
)
)
)
)
(reverse res)
)
)
)
;; ============================================================
;; BAUTEILTABELLE (XRECORD SPS_SKEL_PARTS von tro_annotate.py)
;; Je Bauteil (1 . TeileId) (3 . Art) (10 . Punkt) (40 . halbe Breite)
;; (41 . halbe Hoehe), Punkt in Zeichnungskoordinaten.
;; ============================================================
;; -> Liste von (TeileId Art (x y z) halbeBreite halbeHoehe)
(defun tro-teile-laden ( / xr teil res)
(if (setq xr (dictsearch (namedobjdict) *tro-parts-xrecord*))
(foreach g xr
(cond
((= (car g) 1)
(if teil (setq res (cons (reverse teil) res)))
(setq teil (list (cdr g))))
((and teil (member (car g) '(3 10 40 41)))
(setq teil (cons (cdr g) teil)))
)
)
)
(if teil (setq res (cons (reverse teil) res)))
(reverse res)
)
;; Abstand eines Punkts zum Bauteil (0 innerhalb seiner Huellbox)
(defun tro-teil-abstand (pt teil / p hw hh)
(setq p (nth 2 teil) hw (nth 3 teil) hh (nth 4 teil))
(if (and hw hh (> hw 0) (> hh 0)
(<= (abs (- (car pt) (car p))) hw)
(<= (abs (- (cadr pt) (cadr p))) hh))
0.0
(distance (list (car pt) (cadr pt)) (list (car p) (cadr p)))
)
)
;; Naechstes Bauteil am Punkt, nur Arten aus `arten` (nil = alle).
;; -> (teil . abstand) oder nil
(defun tro-teil-am-punkt (pt teile arten / best d)
(foreach teil teile
(if (or (null arten) (member (cadr teil) arten))
(progn
(setq d (tro-teil-abstand pt teil))
(if (or (null best) (< d (cdr best))) (setq best (cons teil d)))
)
)
)
best
)
;; Mitte der gesetzten Bauteile eines Slot-Zustands (Einfuegepunkt) oder nil
(defun tro-teile-mitte (slots teile / sx sy n teil)
(setq sx 0.0 sy 0.0 n 0)
(foreach p slots
(if (and (/= (cdr p) "") (setq teil (assoc (cdr p) teile)))
(setq sx (+ sx (car (nth 2 teil)))
sy (+ sy (cadr (nth 2 teil)))
n (1+ n))
)
)
(if (> n 0) (list (/ sx n) (/ sy n) 0.0))
)
;; ============================================================
;; DIALOG - Zustand in globalen Variablen, weil action_tile-Ausdruecke
;; ausserhalb der aufrufenden Funktion laufen und der Dialog fuer
;; "Im Plan waehlen" geschlossen und neu geoeffnet wird.
;; *tro-st-id* *tro-st-type* *tro-st-slots* *tro-st-sel* (Index der
;; gewaehlten Zeile) *tro-st-liste* (Typliste) *tro-st-fremd*
;; ((TeileId . TRO-Kennung) der anderen Marker)
;; ============================================================
;; Bauteile aller anderen Marker sammeln (ent = eigener Marker oder nil)
(defun tro-fremde-teile (ent / ss i e a res)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat *tro-block-prefix* "*")))))
(progn
(setq i 0)
(while (setq e (ssname ss i))
(if (not (equal e ent))
(progn
(setq a (ssg-attrib-read e))
(foreach p (tro-slots-lesen (cdr (assoc "SLOTS" a)))
(if (/= (cdr p) "")
(setq res (cons (cons (cdr p) (cdr (assoc "ID" a))) res))
)
)
)
)
(setq i (1+ i))
)
)
)
res
)
;; Warnzeile: leere Separatoren/Linien, doppelte Bauteile, Bauteile anderer Marker
(defun tro-pruefen ( / leer doppelt fremd gesehen f teile)
(foreach p *tro-st-slots*
(cond
((= (cdr p) "")
(if (wcmatch (car p) "separator*,line*") (setq leer (cons (car p) leer))))
((member (cdr p) gesehen) (setq doppelt (cons (cdr p) doppelt)))
(t
(setq gesehen (cons (cdr p) gesehen))
(if (setq f (assoc (cdr p) *tro-st-fremd*))
(setq fremd (cons (ssg-textf "tro-edit-fremd" (list (car f) (cdr f))) fremd))))
)
)
(if leer
(setq teile (cons (ssg-textf "tro-edit-leer" (list (ssg-join (reverse leer) ", "))) teile)))
(if doppelt
(setq teile (cons (ssg-textf "tro-edit-doppelt" (list (ssg-join (reverse doppelt) ", "))) teile)))
(if fremd
(setq teile (cons (ssg-join (reverse fremd) ", ") teile)))
(if teile
(strcat "! " (ssg-join (reverse teile) "; "))
(ssg-text "tro-edit-ok")
)
)
;; Liste und alles, was von ihr abhaengt, neu anzeigen
(defun tro-liste-zeigen ( / vorgabe)
(start_list "slots")
(foreach p *tro-st-slots*
(add_list (strcat (car p) "\t" (if (= (cdr p) "") "-" (cdr p))))
)
(end_list)
(if (null *tro-st-slots*)
(setq *tro-st-sel* nil)
(progn
(if (or (null *tro-st-sel*) (>= *tro-st-sel* (length *tro-st-slots*)))
(setq *tro-st-sel* 0))
(set_tile "slots" (itoa *tro-st-sel*))
)
)
(tro-auswahl-zeigen)
(setq vorgabe (tro-linien-vorgabe *tro-st-type*))
(mode_tile "plus" (if (> vorgabe 0) 0 1))
(mode_tile "minus" (if (> (tro-linien-zahl *tro-st-slots*) 0) 0 1))
(set_tile "linien"
(if (> vorgabe 0)
(ssg-textf "tro-edit-linien"
(list (itoa (tro-linien-zahl *tro-st-slots*)) (itoa vorgabe)))
""))
(set_tile "warnung" (tro-pruefen))
)
;; Edit-Zeile zur gewaehlten Zeile
(defun tro-auswahl-zeigen ()
(set_tile "teil" (if *tro-st-sel* (cdr (nth *tro-st-sel* *tro-st-slots*)) ""))
(foreach k '("teil" "pick" "leeren") (mode_tile k (if *tro-st-sel* 0 1)))
)
;; Bauteil der gewaehlten Zeile setzen
(defun tro-slot-setzen (wert / p)
(if *tro-st-sel*
(progn
(setq p (nth *tro-st-sel* *tro-st-slots*))
(setq *tro-st-slots*
(subst (cons (car p) (vl-string-trim " " wert)) p *tro-st-slots*))
)
)
)
(defun tro-typ-wechseln (typ)
(setq *tro-st-slots* (tro-slots-fuer-typ typ *tro-st-slots*)
*tro-st-type* typ)
(tro-liste-zeigen)
)
;; + Lagerlinie: neue leere Linie am Ende, gewaehlt
(defun tro-linie-plus ()
(setq *tro-st-slots*
(tro-linien-nummerieren (append *tro-st-slots* (list (cons "line0" ""))))
*tro-st-sel* (1- (length *tro-st-slots*)))
(tro-liste-zeigen)
)
;; - Lagerlinie: die gewaehlte Linie, sonst die letzte
(defun tro-linie-minus ( / weg)
(if (and *tro-st-sel* (tro-ist-linie (car (nth *tro-st-sel* *tro-st-slots*))))
(setq weg (nth *tro-st-sel* *tro-st-slots*))
(foreach p *tro-st-slots* (if (tro-ist-linie (car p)) (setq weg p)))
)
(if weg
(setq *tro-st-slots* (tro-linien-nummerieren (vl-remove weg *tro-st-slots*))))
(tro-liste-zeigen)
)
;; "Im Plan waehlen" - laeuft bei geschlossenem Dialog (done_dialog 2)
(defun tro-waehlen ( / slot arten teile pt ok anderes)
(setq slot (car (nth *tro-st-sel* *tro-st-slots*))
arten (cdr (assoc (tro-slot-art slot)
(if (boundp '*TRO-SLOT-KINDS*) *TRO-SLOT-KINDS*))))
(setq teile (tro-teile-laden))
(cond
((null teile) (alert (ssg-text "tro-edit-keine-teile")))
((setq pt (getpoint (ssg-textf "tro-edit-prompt-teil"
(list slot (if arten (ssg-join arten "/") "?")))))
(setq ok (tro-teil-am-punkt pt teile arten)
anderes (tro-teil-am-punkt pt teile nil))
(cond
((and ok (<= (cdr ok) *tro-pick-radius*))
(tro-slot-setzen (car (car ok)))
(princ (ssg-textf "tro-edit-gewaehlt"
(list slot (car (car ok)) (cadr (car ok))))))
((and anderes (<= (cdr anderes) *tro-pick-radius*))
(alert (ssg-textf "tro-edit-falsche-art"
(list (car (car anderes)) (cadr (car anderes)) slot
(ssg-join arten "/")))))
(t (alert (ssg-textf "tro-edit-kein-teil" (list (rtos *tro-pick-radius* 2 0)))))
))
)
)
;; Dialog mit dem aktuellen Zustand zeigen, bis OK (1) oder Abbruch (0).
;; Gibt 1 oder 0 zurueck; der Zustand steht danach in *tro-st-...*.
(defun tro-dialog (kopf fb hinweis / dcl-pfad dat ergebnis idx)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/tro_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(setq ergebnis 2)
(while (= ergebnis 2)
(if (or (< dat 0) (not (new_dialog "tro_edit" dat)))
(progn
(alert (ssg-textf "tro-edit-dialog-fehlt" (list dcl-pfad)))
(setq ergebnis 0)
)
(progn
(set_tile "blockname" kopf)
(set_tile "fb" fb)
(set_tile "hinweis" hinweis)
(set_tile "id" *tro-st-id*)
(start_list "type")
(foreach typ *tro-st-liste* (add_list typ))
(end_list)
(setq idx (tro-index *tro-st-type* *tro-st-liste*))
(set_tile "type" (itoa (if idx idx 0)))
(tro-liste-zeigen)
(action_tile "id" "(setq *tro-st-id* $value)")
(action_tile "type" "(tro-typ-wechseln (nth (atoi $value) *tro-st-liste*))")
(action_tile "slots" "(setq *tro-st-sel* (atoi $value)) (tro-auswahl-zeigen)")
(action_tile "teil" "(tro-slot-setzen $value) (tro-liste-zeigen)")
(action_tile "leeren" "(tro-slot-setzen \"\") (tro-liste-zeigen)")
(action_tile "plus" "(tro-linie-plus)")
(action_tile "minus" "(tro-linie-minus)")
(action_tile "pick"
"(setq *tro-st-id* (get_tile \"id\")) (done_dialog 2)")
(action_tile "accept"
(strcat "(setq *tro-st-id* (get_tile \"id\"))"
"(tro-slot-setzen (get_tile \"teil\"))"
"(done_dialog 1)"))
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(if (= ergebnis 2) (tro-waehlen))
)
)
)
(if (>= dat 0) (unload_dialog dat))
ergebnis
)
;; ------------------------------------------------------------
;; C:TRO_INSERT - neuen TRO-Marker einfuegen
;;
;; Fragt Typ, Kennung und Bauteile im selben Dialog wie TRO_EDIT ab und
;; fuegt eine bestehende TRO_SYM_<Typ>-Blockdefinition ein. Die
;; Blockdefinition (Form, Farbe) entsteht nur ueber sps_skel
;; (lib/tro_annotate.py) - ohne einen frueheren Lauf mit dem gewuenschten
;; Typ bricht der Befehl mit einem Hinweis ab. KEY bleibt leer: fuer
;; --read-tros ist der Marker damit ein neuer TRO.
;; ------------------------------------------------------------
(defun c:TRO_INSERT ( / liste ergebnis bname pt lay oldAttreq oldAttdia)
(ssg-start "TRO_INSERT" nil)
(setq liste (tro-typliste nil))
(if (or (null liste) (equal liste (list "")))
(progn
(alert (ssg-text "tro-insert-kein-typ"))
(ssg-end)
(exit)
)
)
;; --- Dialog: Typ, Kennung, Bauteile -------------------------------------
(setq *tro-st-liste* liste
*tro-st-type* (car liste)
*tro-st-id* (tro-naechste-id)
*tro-st-slots* (tro-slots-fuer-typ (car liste) nil)
*tro-st-sel* 0
*tro-st-fremd* (tro-fremde-teile nil))
(setq ergebnis (tro-dialog (ssg-text "tro-edit-neu") ""
(ssg-text "tro-insert-hinweis")))
(if (/= ergebnis 1)
(progn (ssg-end) (exit))
)
(if (= (vl-string-trim " " *tro-st-id*) "")
(progn (alert (ssg-text "tro-edit-id-leer")) (ssg-end) (exit))
)
;; --- Blockdefinition pruefen --------------------------------------------
(setq bname (strcat *tro-block-prefix* *tro-st-type*))
(if (not (tblsearch "BLOCK" bname))
(progn
(alert (ssg-textf "tro-insert-kein-block" (list bname)))
(ssg-end)
(exit)
)
)
;; --- Einfuegepunkt (Enter = Mitte der gewaehlten Bauteile) --------------
(setq pt (getpoint (ssg-text "tro-insert-prompt-punkt")))
(if (null pt)
(setq pt (tro-teile-mitte *tro-st-slots* (tro-teile-laden)))
)
(if (null pt)
(progn (ssg-end) (exit))
)
;; --- Einfuegen ------------------------------------------------------------
(setq lay (tro-marker-layer bname))
(command "_LAYER" "_M" lay "")
(setq oldAttreq (getvar "ATTREQ") oldAttdia (getvar "ATTDIA"))
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(command "_.INSERT" bname pt 1 1 0)
(setvar "ATTREQ" oldAttreq)
(setvar "ATTDIA" oldAttdia)
(ssg-attrib-set-on (entlast)
(list (cons "ID" *tro-st-id*) (cons "TYPE" *tro-st-type*)
(cons "CONFIDENCE" "manuell")
(cons "SLOTS" (tro-slots-text *tro-st-slots*))))
(entupd (entlast))
(princ (ssg-textf "tro-insert-eingefuegt" (list *tro-st-id* *tro-st-type*)))
(ssg-end)
)
;; ------------------------------------------------------------
;; C:TRO_EDIT - Dialog fuer einen TRO-Marker
;; ------------------------------------------------------------
(defun c:TRO_EDIT ( / ss ent ed bname attribs
alt-id alt-type alt-fb int-id ergebnis)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
(= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
(setq ent (ssname ss 0))
)
(ssg-start "TRO_EDIT" nil)
;; Marker auswaehlen (falls nicht vorselektiert)
(if (null ent)
(progn
(princ (ssg-text "cmd-block-auswaehlen"))
(setq ss (ssget ":S" '((0 . "INSERT"))))
(if ss (setq ent (ssname ss 0)))
)
)
(if (null ent)
(progn (princ (ssg-text "cmd-kein-block-ausgewaehlt")) (ssg-end) (exit))
)
(setq ed (entget ent)
bname (cdr (assoc 2 ed)))
(if (not (wcmatch bname "TRO_*"))
(progn
(alert (ssg-textf "tro-edit-kein-tro" (list bname)))
(ssg-end)
(exit)
)
)
;; --- aktuelle Attribute lesen ----------------------------------------
(setq attribs (ssg-attrib-read ent)
alt-id (cdr (assoc "ID" attribs))
alt-type (cdr (assoc "TYPE" attribs))
alt-fb (cdr (assoc "FB_BLOCK" attribs))
int-id (cdr (assoc "UID" attribs)))
(if (null alt-id)
(progn
(alert (ssg-textf "tro-edit-kein-id-attribut" (list bname)))
(ssg-end)
(exit)
)
)
;; Marker aus einer Beschriftung vor den Slots: Bauteile nicht speicherbar
(if (null (assoc "SLOTS" attribs))
(progn
(alert (ssg-textf "tro-edit-keine-slots" (list alt-id)))
(ssg-end)
(exit)
)
)
(if (null alt-type) (setq alt-type ""))
;; --- Dialog -----------------------------------------------------------
(setq *tro-st-liste* (tro-typliste alt-type)
*tro-st-type* alt-type
*tro-st-id* alt-id
*tro-st-slots* (tro-slots-fuer-typ alt-type
(tro-slots-lesen (cdr (assoc "SLOTS" attribs))))
*tro-st-sel* 0
*tro-st-fremd* (tro-fremde-teile ent))
(setq ergebnis
(tro-dialog (ssg-textf "tro-edit-block" (list bname))
(ssg-textf "tro-edit-fb" (list (if alt-fb alt-fb "-") (if int-id int-id "-")))
(ssg-text "tro-edit-hinweis")))
;; --- zurueckschreiben -------------------------------------------------
(if (= ergebnis 1)
(if (= (vl-string-trim " " *tro-st-id*) "")
(alert (ssg-text "tro-edit-id-leer"))
(progn
(ssg-attrib-set-on ent
(list (cons "ID" *tro-st-id*) (cons "TYPE" *tro-st-type*)
(cons "SLOTS" (tro-slots-text *tro-st-slots*))))
(entupd ent)
(princ (ssg-textf "tro-edit-gespeichert" (list *tro-st-id* *tro-st-type*)))
(if (/= *tro-st-type* alt-type)
(princ (ssg-text "tro-edit-typ-geaendert"))
)
)
)
)
(ssg-end)
(princ)
)
(prompt "\nTro_Edit.lsp geladen - Befehle: TRO_INSERT, TRO_EDIT")
(princ)
Reference in New Issue View Git Blame Copy Permalink