multi_set_action_tile

a subrotina abaixo serve para facilitar a criação de rotinas que usam DCLs, e será útil nas rotinas que estão por vir. Pode parecer meio estranhas no inicio, mas com um exemplo que postarei as coisas irão clarear... mas pelo título do post, dá pra imaginar o que é, não dá?

---

;vars: lista de strings com as "key" das tiles
;vals: lista dos valores que cada tile irá assumir, tanto na dcl como na variavel
;act:  "string" com a "action" que cada tile irá receber
(defun multi_set_action_tile (vars vals act / m tmp)
  (setq m "")
  (setq tmp (vl-catch-all-apply
              '(lambda (vars vals)
                (if (not vals) (setq vals (mapcar 'eval (mapcar 'read vars))))
                (mapcar '(lambda (k v / val p)
                           (if act (action_tile k act))
                           (setq m k)
                           (setset_tile2 k v))
                        vars vals))
             (list  vars vals)))
  (if (vl-catch-all-error-p tmp)
    (alert (strcat m "\n" (vl-catch-all-error-message tmp)))))

;|k :key
  v :valor a ser atribuido
      v pode ser:
        real
        int
        str
        nil
        ( "opn" [ou n]        ;valor que a variavel (READ K) irá receber
          ("op1" "op2" "opn") ;lista que polula a popup_list
          "key-popup_list")   ;key da popup_list que será populada
        (0 1 2 3)               ;indices a serem selecionados na popup_list
|;
(defun setset_tile2 (k v / val str l p)
  (setq val (if v v (eval (read k)))
    str (cond ((= 'real (type val))  (rtos val 2 3))
          ((= 'int (type val))   (itoa val))
          ((= 'str (type val))  val)
          ((null val)  "")
          ((and (listp val) (listp (setq l (cadr val))))
           (setq p   (vl-position (type (car val)) '(str int nil))
             tmp (if (= p 0)
                   (vl-position (car val) l)
                   (if (= p 1)
                 (if (< (car val) (length l))
                   (car val)))))
           (if (caddr v)
             (progn
               (start_list (caddr v) 3)
               (mapcar 'add_list l)
               (add_list " ")
               (end_list)))
           (setq val (if tmp (nth tmp l)))
           (itoa (if tmp tmp (length l))))
          (t (if (listp val)
                       (if (vl-every '(lambda (x) (= 'int (type x))) val)
                         (l2s val)
                         (vl-princ-to-string val))
                       (vl-princ-to-string val)))))
  (set (read k) val)
  (set_tile k str))

;transforma lista para string, se forem só numeros
(defun l2s (l /)
  (setq l (vl-princ-to-string l))
  (substr l 2 (- (strlen l) 2)))

Link(s) da(s) subrotina(s) usada(s):
setset_tile2, l2s, multi_set_action_tile