225 lines
8.4 KiB
Common Lisp
225 lines
8.4 KiB
Common Lisp
;; ============================================================
|
|
;; JAM_EDIT.LSP - Staubereich (JAM_AREA) bearbeiten
|
|
;;
|
|
;; Die Staubereiche zeichnet sps_skel (lib/tro_annotate.py --anlage) als
|
|
;; Block JAM_AREA: ein Rechteck, darin der Name Jam<NNNN>_<k>. Attribute
|
|
;; NAME sichtbar - Jam0054_3
|
|
;; CONVEYOR, NUMBER unsichtbar - Foerderer NNNN und laufende Nummer k
|
|
;; TRO, ENTRY unsichtbar - TRO und Eingang, in den er fuehrt
|
|
;; (stabiler Schluessel, nicht aendern)
|
|
;; AREA unsichtbar - Kennung der TRO-JSON (J0039)
|
|
;; AUTO unsichtbar - von sps_skel abgeleitete Nummer NNNN_k
|
|
;; KEY unsichtbar - stabiler Schluessel fuer --read-jams
|
|
;; CAPACITY unsichtbar - Kapazitaet (Traegerplaetze), leer = offen;
|
|
;; wird nCapacityMax/nCapacitySet und der Wert
|
|
;; der Konstante cJam<NNNN>_<k> im DB_JamArea<NNNN>
|
|
;;
|
|
;; Alte Zeichnungen ohne CAPACITY: Feld gesperrt, Hinweis - neu beschriften.
|
|
;;
|
|
;; Aufruf JAM_EDIT:
|
|
;; - Doppelklick auf den Staubereich -> ***DOUBLECLICK [INSERT] -> SSG_BLOCKEDIT
|
|
;; - EATTEDIT -> c:EATTEDIT -> SSG_BLOCKEDIT
|
|
;; - direkt: JAM_EDIT
|
|
;; Der Dispatcher SSG_BLOCKEDIT (SSG_LIB_Commands.lsp) leitet Blocknamen
|
|
;; "JAM_*" hierher.
|
|
;;
|
|
;; Der Dialog aendert nur die Zeichnung. In die SCL kommt die Aenderung mit
|
|
;; tro_annotate.bat --file <csv> --read-jams (-> cfg/<csv>_jam_names.ini,
|
|
;; [jam] und [capacity])
|
|
;; scl_skeleton.bat --json <csv>_anlage.json --templates
|
|
;; (-> <csv>_FB_Main.scl, <csv>_DB_JamArea.scl,
|
|
;; <csv>_JamArea_Konstanten.xlsx)
|
|
;;
|
|
;; Setzt ssg_core.lsp (ssg-start/ssg-end, ssg-attrib-*) und ssg_lang.lsp voraus.
|
|
;; ============================================================
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Nur Ziffern, nicht leer
|
|
;; ------------------------------------------------------------
|
|
(defun jam-ziffern-p (s)
|
|
(and s (/= s "") (not (wcmatch s "*[~0-9]*")))
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Ein Attribut setzen, auch auf "" (ssg-attrib-set-on laesst leere
|
|
;; Werte aus - eine geloeschte Kapazitaet muss aber leer werden)
|
|
;; ------------------------------------------------------------
|
|
(defun jam-attrib-setzen (ent tag wert / obj ed fertig)
|
|
(setq obj (entnext ent) fertig nil)
|
|
(while (and obj (not fertig))
|
|
(setq ed (entget obj))
|
|
(cond
|
|
((= (cdr (assoc 0 ed)) "SEQEND") (setq fertig t))
|
|
((and (= (cdr (assoc 0 ed)) "ATTRIB") (= (strcase (cdr (assoc 2 ed))) tag))
|
|
(entmod (subst (cons 1 wert) (assoc 1 ed) ed))
|
|
(entupd obj)
|
|
(setq fertig t))
|
|
)
|
|
(setq obj (entnext obj))
|
|
)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Name aus Foerderer und Nummer: "0054" "3" -> "Jam0054_3"
|
|
;; ------------------------------------------------------------
|
|
(defun jam-name (foerderer nummer)
|
|
(strcat "Jam" foerderer "_" nummer)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Gibt es den Namen schon an einem anderen Staubereich?
|
|
;; Liefert die Kennung (AREA) des anderen Blocks oder nil.
|
|
;; ------------------------------------------------------------
|
|
(defun jam-name-belegt (name eigener / ss i ent attribs treffer)
|
|
(setq treffer nil)
|
|
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "JAM_*"))))
|
|
(progn
|
|
(setq i 0)
|
|
(while (and (null treffer) (setq ent (ssname ss i)))
|
|
(if (not (eq ent eigener))
|
|
(progn
|
|
(setq attribs (ssg-attrib-read ent))
|
|
(if (= (strcase (cond ((cdr (assoc "NAME" attribs))) (""))) (strcase name))
|
|
(setq treffer (cond ((cdr (assoc "AREA" attribs))) ("?")))
|
|
)
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
treffer
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; C:JAM_EDIT - Dialog fuer einen Staubereich
|
|
;; ------------------------------------------------------------
|
|
(defun c:JAM_EDIT ( / ss ent ed bname attribs
|
|
alt-conv alt-nr auto tro entry area
|
|
neu-conv neu-nr auto-conv auto-nr pos
|
|
alt-kap neu-kap hat-kap
|
|
dcl-pfad dat ergebnis name andere)
|
|
|
|
;; 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 "JAM_EDIT" nil)
|
|
|
|
(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 "JAM_*"))
|
|
(progn
|
|
(alert (ssg-textf "jam-edit-kein-jam" (list bname)))
|
|
(ssg-end)
|
|
(exit)
|
|
)
|
|
)
|
|
|
|
;; --- aktuelle Attribute lesen ----------------------------------------
|
|
(setq attribs (ssg-attrib-read ent)
|
|
alt-conv (cond ((cdr (assoc "CONVEYOR" attribs))) (""))
|
|
alt-nr (cond ((cdr (assoc "NUMBER" attribs))) (""))
|
|
auto (cond ((cdr (assoc "AUTO" attribs))) (""))
|
|
tro (cond ((cdr (assoc "TRO" attribs))) ("?"))
|
|
entry (cond ((cdr (assoc "ENTRY" attribs))) ("?"))
|
|
area (cond ((cdr (assoc "AREA" attribs))) ("?"))
|
|
hat-kap (assoc "CAPACITY" attribs)
|
|
alt-kap (cond ((cdr hat-kap)) ("")))
|
|
|
|
;; AUTO "0054_3" -> Foerderer "0054", Nummer "3"
|
|
(setq auto-conv "" auto-nr "")
|
|
(if (setq pos (vl-string-search "_" auto))
|
|
(setq auto-conv (substr auto 1 pos)
|
|
auto-nr (substr auto (+ pos 2)))
|
|
)
|
|
|
|
;; --- Dialog -----------------------------------------------------------
|
|
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/jam_edit.dcl"))
|
|
(setq dat (load_dialog dcl-pfad))
|
|
(if (not (new_dialog "jam_edit" dat))
|
|
(progn
|
|
(alert (ssg-textf "jam-edit-dialog-fehlt" (list dcl-pfad)))
|
|
(ssg-end)
|
|
(exit)
|
|
)
|
|
)
|
|
|
|
(set_tile "bereich" (ssg-textf "jam-edit-bereich" (list area tro entry)))
|
|
(set_tile "auto" (ssg-textf "jam-edit-auto"
|
|
(list (if (= auto "") "-" (jam-name auto-conv auto-nr)))))
|
|
(set_tile "hinweis" (ssg-text (if hat-kap "jam-edit-hinweis" "jam-edit-ohne-kapazitaet")))
|
|
(set_tile "conveyor" alt-conv)
|
|
(set_tile "number" alt-nr)
|
|
(set_tile "capacity" alt-kap)
|
|
(if (= auto "") (mode_tile "reset" 1))
|
|
;; alte Zeichnung: Block ohne CAPACITY - nichts, wohin der Wert koennte
|
|
(if (not hat-kap) (mode_tile "capacity" 1))
|
|
|
|
(setq neu-conv alt-conv neu-nr alt-nr neu-kap alt-kap)
|
|
(action_tile "reset"
|
|
"(set_tile \"conveyor\" auto-conv) (set_tile \"number\" auto-nr)")
|
|
(action_tile "accept"
|
|
(strcat "(setq neu-conv (vl-string-trim \" \" (get_tile \"conveyor\"))"
|
|
" neu-nr (vl-string-trim \" \" (get_tile \"number\"))"
|
|
" neu-kap (vl-string-trim \" \" (get_tile \"capacity\")))"
|
|
"(done_dialog 1)"))
|
|
(action_tile "cancel" "(done_dialog 0)")
|
|
|
|
(setq ergebnis (start_dialog))
|
|
(unload_dialog dat)
|
|
|
|
;; --- pruefen und zurueckschreiben -------------------------------------
|
|
(if (= ergebnis 1)
|
|
(cond
|
|
((not (and (jam-ziffern-p neu-conv) (= (strlen neu-conv) 4)))
|
|
(alert (ssg-text "jam-edit-foerderer-ungueltig")))
|
|
((not (and (jam-ziffern-p neu-nr) (> (atoi neu-nr) 0)))
|
|
(alert (ssg-text "jam-edit-nummer-ungueltig")))
|
|
((not (or (= neu-kap "") (and (jam-ziffern-p neu-kap) (> (atoi neu-kap) 0))))
|
|
(alert (ssg-text "jam-edit-kapazitaet-ungueltig")))
|
|
(t
|
|
(setq neu-nr (itoa (atoi neu-nr))
|
|
name (jam-name neu-conv neu-nr))
|
|
(ssg-attrib-set-on ent (list (cons "CONVEYOR" neu-conv)
|
|
(cons "NUMBER" neu-nr)
|
|
(cons "NAME" name)))
|
|
(if hat-kap
|
|
(jam-attrib-setzen ent "CAPACITY"
|
|
(if (= neu-kap "") "" (itoa (atoi neu-kap)))))
|
|
(entupd ent)
|
|
(princ (ssg-textf "jam-edit-gespeichert" (list name area)))
|
|
(if (setq andere (jam-name-belegt name ent))
|
|
(princ (ssg-textf "jam-edit-doppelt" (list name andere)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
|
|
(prompt "\nJam_Edit.lsp geladen - Befehl: JAM_EDIT")
|
|
(princ)
|