Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2e49d0b52234a9b2c6900ed14256d726aab3cb6e
dxfmakros/Lisp/Tro_Edit.lsp
T
s.ayadi 9c7dda8a37 Add TRO_INSERT command to hand-place new TRO markers 
Lets the TRO menu insert a fresh TRO_SYM_<Typ> marker (point + type +
auto-suggested TROnn id) by reusing a block definition tro_annotate.py
already created, instead of only editing markers it placed.
2026-08-03 15:56:13 +02:00

355 lines
12 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; TRO_EDIT.LSP - TRO-Marker einfuegen und bearbeiten
;;
;; Verwaltet die Attribute ID und TYPE 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)
;; ITEMS, CONFIDENCE, SEPARATORS unsichtbar, reine Daten
;;
;; 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.
;; Ohne einen frueheren Lauf mit dem gewuenschten Typ bricht der Befehl
;; mit einem Hinweis ab.
;;
;; Aufruf TRO_EDIT (Attribute eines bestehenden Markers 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.
;;
;; Die Auswahlliste der Typen kommt 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 des Blocks in der Liste; TRO_INSERT bricht dann ab (siehe
;; tro-insert-kein-typ).
;;
;; Grenze: TRO_EDIT aendert nur die Attribute, TRO_INSERT nur die Position -
;; 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-*) und ssg_lang.lsp voraus.
;; ============================================================
(setq *tro-block-prefix* "TRO_SYM_")
;; ------------------------------------------------------------
;; 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")
)
)
;; ------------------------------------------------------------
;; C:TRO_INSERT - neuen TRO-Marker einfuegen
;;
;; Fuegt eine bestehende TRO_SYM_<Typ>-Blockdefinition an einem gewaehlten
;; Punkt ein und setzt ID und TYPE. 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.
;; ------------------------------------------------------------
(defun c:TRO_INSERT ( / liste dcl-pfad dat ergebnis typ id pt bname 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 ---------------------------------------------
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/tro_insert.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "tro_insert" dat))
(progn
(alert (ssg-textf "tro-edit-dialog-fehlt" (list dcl-pfad)))
(ssg-end)
(exit)
)
)
(start_list "type")
(foreach typname liste (add_list typname))
(end_list)
(set_tile "type" "0")
(set_tile "id" (tro-naechste-id))
(set_tile "hinweis" (ssg-text "tro-insert-hinweis"))
(setq typ (car liste))
(action_tile "type" "(setq typ (nth (atoi (get_tile \"type\")) liste))")
(action_tile "id" "(setq id (get_tile \"id\"))")
(action_tile "accept"
(strcat "(setq typ (nth (atoi (get_tile \"type\")) liste)"
" id (get_tile \"id\"))"
"(done_dialog 1)"))
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (/= ergebnis 1)
(progn (ssg-end) (exit))
)
(if (= (vl-string-trim " " id) "")
(progn (alert (ssg-text "tro-edit-id-leer")) (ssg-end) (exit))
)
;; --- Blockdefinition pruefen --------------------------------------------
(setq bname (strcat *tro-block-prefix* typ))
(if (not (tblsearch "BLOCK" bname))
(progn
(alert (ssg-textf "tro-insert-kein-block" (list bname)))
(ssg-end)
(exit)
)
)
;; --- Einfuegepunkt -------------------------------------------------------
(setq pt (getpoint (ssg-text "tro-insert-prompt-punkt")))
(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" id) (cons "TYPE" typ) (cons "CONFIDENCE" "manuell")))
(entupd (entlast))
(princ (ssg-textf "tro-insert-eingefuegt" (list id typ)))
(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
neu-id neu-type
liste idx dcl-pfad dat 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)))
(if (null alt-id)
(progn
(alert (ssg-textf "tro-edit-kein-id-attribut" (list bname)))
(ssg-end)
(exit)
)
)
(if (null alt-type) (setq alt-type ""))
;; --- Dialog -----------------------------------------------------------
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/tro_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "tro_edit" dat))
(progn
(alert (ssg-textf "tro-edit-dialog-fehlt" (list dcl-pfad)))
(ssg-end)
(exit)
)
)
(setq liste (tro-typliste alt-type)
idx (tro-index alt-type liste))
(set_tile "blockname" (ssg-textf "tro-edit-block" (list bname)))
(set_tile "fb" (ssg-textf "tro-edit-fb" (list (if alt-fb alt-fb "-"))))
(set_tile "hinweis" (ssg-text "tro-edit-hinweis"))
(set_tile "id" alt-id)
(start_list "type")
(foreach typ liste (add_list typ))
(end_list)
(set_tile "type" (itoa (if idx idx 0)))
(setq neu-id alt-id neu-type alt-type)
(action_tile "id" "(setq neu-id (get_tile \"id\"))")
(action_tile "type" "(setq neu-type (nth (atoi (get_tile \"type\")) liste))")
(action_tile "accept"
(strcat "(setq neu-id (get_tile \"id\")"
" neu-type (nth (atoi (get_tile \"type\")) liste))"
"(done_dialog 1)"))
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
;; --- zurueckschreiben -------------------------------------------------
(if (= ergebnis 1)
(if (= (vl-string-trim " " neu-id) "")
(alert (ssg-text "tro-edit-id-leer"))
(progn
(ssg-attrib-set-on ent (list (cons "ID" neu-id) (cons "TYPE" neu-type)))
(entupd ent)
(princ (ssg-textf "tro-edit-gespeichert" (list neu-id neu-type)))
(if (/= neu-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