getXXX functions + default value + help message

[Luna]

Coucou,

A force d'écrire des fonctions getXXX pour leur prévoir des valeurs par défaut, des initialisation (initget) et/ou prévoir une aide "?" qui boucle pour afficher un message avant de reposer la même question, j'ai fini par écrire le programme (getkdh) (= GETxxx Keyword Defaultvalue Helpmessage). Donc pour ceux que chat intéresse, le principe de ce programme est de regrouper toutes les fonctionnalités citées ci-dessus en une seule fonction pour récupérer des saisies utilisateurs. Il est donc possible d'utiliser toutes les fonctions compatibles avec (initget) (cf. Help Center - initget (AutoLISP) ), de définir les arguments d'initget comme on le désire (notamment les keyword), de définir également les arguments des fonctions getXXX (notamment l'argument 'pt), de définir une valeur par défaut et/ou d'ajouter un message à afficher pour aider l'utilisateur dans la saisie attendue.

Ci-dessous les fonctions LISP (getkdh) ainsi que (str2lst) et (lst2str) nécessaire au fonctionnement de (getkdh) :

(defun getkdh (fun pfx arg sfx dft hlp / get bit kwd msg val)
  (defun get (msg / v)
    (apply 'initget arg)
    (if (null (setq v (apply (car fun) (vl-remove nil (mapcar '(lambda (x) (if (vl-symbolp x) (vl-symbol-value x) x)) (cdr fun))))))
      (setq v (cdr dft))
      v
    )
  )
  (and
    (member (car fun) (list 'getint 'getreal 'getdist 'getangle 'getorient 'getpoint 'getcorner 'getkword 'entsel 'nentsel 'nentselp))
    (= 'STR (type (cond (pfx) (""))) (type (cond (sfx) (""))) (type (cond (hlp) (""))))
    (listp arg)
    (if (null (setq bit (car (vl-remove-if-not '(lambda (x) (= 'INT (type x))) arg)))) (setq bit 0) bit)
    (if (null (setq kwd (car (vl-remove-if-not '(lambda (x) (= 'STR (type x))) arg))))
      (not kwd)
      (if (vl-string-search "_" kwd)
        (setq kwd (mapcar 'cons (str2lst (car (str2lst kwd "_")) " ") (str2lst (cadr (str2lst kwd "_")) " ")))
        (setq kwd (mapcar 'cons (str2lst kwd " ") (str2lst kwd " ")))
      )
    )
    (if hlp
      (if (not (assoc "?" kwd))
        (setq kwd (append kwd '(("?" . "?"))))
        T
      )
      T
    )
    (cond
      ( (null dft) (not dft))
      ( (member dft (mapcar 'car kwd))
        (setq dft (assoc dft kwd))
      )
      ( (member dft (mapcar 'cdr kwd))
        (setq dft (nth (vl-position (car (member dft (mapcar 'cdr kwd))) (mapcar 'cdr kwd)) kwd))
      )
      ( T (setq dft (cons (vl-princ-to-string dft) dft)))
    )
    (if (and dft (= 1 (logand 1 bit))) (setq bit (1- bit)) T)
    (setq arg (vl-remove nil (list bit (lst2str (vl-remove nil (list (lst2str (mapcar 'car kwd) " ") (lst2str (mapcar 'cdr kwd) " "))) "_"))))
    (if (or pfx kwd dft sfx)
      (setq
        msg
          (strcat
            (cond (pfx) (""))
            (if kwd (strcat " [" (lst2str (mapcar 'car kwd) "/") "]") "")
            (if dft (strcat " <" (car dft) ">") "")
            (cond (sfx) (""))
          )
      )
      (not (setq msg nil))
    )
    (if hlp
      (while (= "?" (setq val (get msg)))
        (princ hlp)
      )
      (setq val (get msg))
    )
  )
  val
)

(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons
      (substr str 1 pos)
      (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)

(defun lst2str (lst sep)
  (if lst
    (vl-string-left-trim
      sep
      (apply
        'strcat
        (mapcar
          '(lambda (x)
            (strcat sep (vl-princ-to-string x))
          )
          lst
        )
      )
    )
  )
)

Pour plus d'infos sur les définitions des arguments, il y a le fichier .lsp en PJ (avec l'aide en anglais sur l'utilisation de la fonction). Ci-dessous quelques exemples d'utilisation et du résultat obtenu sur ligne de commande :

Commande: (getkdh (quote (getint msg)) "\nSpécifier un nombre entier positif" '(6) " :" 1 nil)
Spécifier un nombre entier positif <1> :0
La valeur doit être positive et non nulle.
Spécifier un nombre entier positif <1> : *ENTER*
1

 

Commande: (getkdh (quote (getint msg)) "\nSpécifier un nombre" '(6) " :" 1 "\nLe nombre doit être strictement supérieur à 0")
Spécifier un nombre [?] <1> :?
Le nombre doit être strictement supérieur à 0
Spécifier un nombre [?] <1> :-1
La valeur doit être positive et non nulle.
Spécifier un nombre [?] <1> :12.2
Nécessite un entier positif non nul ou une option.
Spécifier un nombre [?] <1> :5
5

 

Commande: (setq pt (getkdh (quote (getpoint msg)) "\nSpecify a point" nil " : " '(0.0 0.0 0.0) nil))
Specify a point <(0.0 0.0 0.0)> : *ENTER*
(0.0 0.0 0.0)
Commande: (getkdh (quote (nentselp msg pt)) nil nil nil nil nil)
(<Nom d'entité: 2274fb62560> (0.0 0.0 0.0)) ;;or nil if there's no entity

 

Commande: (getkdh (quote (getkword msg)) "\nChoisir une option" '("Active Sélection Toutes _Current Selection All") nil nil "Message d'aide...")
Choisir une option [Active/Sélection/Toutes/?]?
Message d'aide...
Choisir une option [Active/Sélection/Toutes/?]t
"All"

 

Commande: (getkdh (quote (getkword msg)) "\nChoisir une option" '("Active Sélection Toutes _Current Selection All") " " "Active" nil)
Choisir une option [Active/Sélection/Toutes] <Active>
"Current"

 

Commande: (getkdh (quote (getkword msg)) "\nChoisir une option" '("Active Sélection Toutes") " " "eXit" nil)
Choisir une option [Active/Sélection/Toutes] <eXit> A
"Active"
Commande: (getkdh (quote (getkword msg)) "\nChoisir une option" '("Active Sélection Toutes") " " "eXit" nil)
Choisir une option [Active/Sélection/Toutes] <eXit> *ENTER*
"eXit"

Ce ne sont que des exemples parmi tant d'autres, mais cela permet de montrer un peu plus en détail son fonctionnement ^^"
Le but étant de pouvoir l'utiliser dans de nombreux cas possibles, évidemment s'il y a des idées d'amélioration je suis preneuse après tout le but est de fournir un outil qui réponde à un maximum de besoin quasi-similaires 😉

PS: Pour ceux qui ne l'on pas remarqué dans les exemples ci-dessus, le premier argument doit obligatoirement être la fonction (quote) suivie de la liste (FunctionName [arg1] msg [arg2]) avec obligatoirement FunctionName en premier atom et msg doit obligatoirement être présent également (il s'agit du symbol à qui le programme affecte la valeur du message affiché pour l'utilisateur, donc il est essentiel également). Les [arg1] et [arg2] correspondent aux arguments optionnels des fonctions reliées à (initget) et dont leur position est relative au [msg]. A savoir que seul (nentselp) possède [arg2] correspondant au [pt], les autres fonctions possèdent seulement [arg1] (ou pas) en plus du [msg].

Si vous avez des questions n'hésitez pas 😉

Bisous,
Luna

UtDac . lst2str.lsp UtDac . str2lst.lsp UtUse . getkdh.lsp

[lecrabe]

Hello 

Merci Luna pour tes contributions !

La Santé, Bye, lecrabe