dxfmakros/Lisp/Jam_Edit.lsp

;; ============================================================
;; 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
;;
;; 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)
;;   scl_skeleton.bat --json <csv>_anlage.json --templates
;;
;; 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]*")))
)


;; ------------------------------------------------------------
;; 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
                      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))) ("?")))

  ;; 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 "jam-edit-hinweis"))
  (set_tile "conveyor" alt-conv)
  (set_tile "number" alt-nr)
  (if (= auto "") (mode_tile "reset" 1))

  (setq neu-conv alt-conv neu-nr alt-nr)
  (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\")))"
            "(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")))
      (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)))
       (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)