Aller au contenu

[DCL] Formulaire de longueur incertaine


Fraid

Messages recommandés

Bonjour,

Pour répondre à mes besoin,

j'ai du trouver une solution au problème qu'une boite de dialogue au contenu incertain peut poser.

Je partage donc mon expérience qui, après recherche, n'est pas courante.

Ici, avec un formulaire qui s'adapte au contenu d'une liste.

;;;multinput
;;;Formulaire adaptatif
;;;Arg :name, String nom et titre de la boite de dialogue
;;;     linp, liste des champs
;;;Retour : Liste des valeurs des champs ou nil
;;;Exemple (multinput "Test" '("Nom :" "Prénom :" "Adresse :" "Age :"))
(defun multinput (name linp / tdcl n dcltmp odcl tfct vals vdef acts fct ofct ret)
;Ecriture du DCL
    (setq tdcl (strcat name " :dialog {label = \"" name "\"; :boxed_column { ") n 0)
    (foreach inp linp
        (setq tdcl (strcat tdcl ":edit_box { 
                                        key = \"input" (itoa (setq n (1+ n))) "\"; 
                                        label = \"" inp "\"; 
                                        edit_width = 20; 
                                        }"
                    )
        )
    )
    (setq tdcl (strcat tdcl "} spacer; ok_cancel; }")
           dcltmp (vl-filename-mktemp "tmp.dcl")
           odcl (open dcltmp "w")
    )
    (write-line tdcl odcl)
    (close odcl)
;Ecriture de la fonction d'appel    
    (setq tfct (strcat "(defun fcttmp (dcl name / dcl_id done") n 0 acts "" vals "" vdef "")
    (foreach inp linp
        (setq vals (strcat vals " val" (itoa (setq n (1+ n))))
               vdef (strcat vdef " val" (itoa n) " \"\"")
               acts (strcat acts "(action_tile \"input" (itoa n) "\" \"(setq val"(itoa n)" $value)\")")
        )
    )
    (setq   tfct (strcat tfct   
                                vals 
                                ")(if (new_dialog \""
                                name 
                                "\" (setq dcl_id (load_dialog dcl)))(progn (setq " 
                                vdef
                                ")"
                                acts 
                                "(action_tile \"cancel\" \"(done_dialog 0)\")
                                 (action_tile \"accept\" \"(done_dialog 1)\")
                                 (setq done (start_dialog))
                                 (unload_dialog dcl_id)
                                 (if (= done 1)(list " 
                                 vals 
                                 ")
                                 nil
                                 ))))"
                )
            fct (vl-filename-mktemp "fct.lsp")
            ofct (open fct "w")
            
    )
    (write-line tfct ofct)
    (close ofct)
;Chargement de la fonction
    (load fct)
;Execution
    (setq ret (fcttmp dcltmp name))
;Effacement des fichiers temp
    (vl-file-delete dcltmp)
    (vl-file-delete fct)
;Liste en retour
    ret
)

Le test donne ceci

test.jpg.4a25252f11ba4e150f840ed834e46167.jpg

à bientôt

Modifié par Fraid
Accompagnement des nil à la sortie
Lien vers le commentaire
Partager sur d’autres sites

Coucou,

C'est en effet intéressant comme exercice :3 Il est vrai que je n'ai jamais eut à utiliser les edit_box (la plupart de mes BdL passent par la fonction (ListBox) ^^") mais en revanche, le fait qu'une BdL soit définie par un nombre de lignes variables arrive assez souvent !
Donc ce programme aidera beaucoup de monde pour comprendre comment moduler sa BdL en fonction d'une liste de longueur variable :3

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

En gardant le même principe, avec des popup_list

;;;multicheck
;;;Check liste adaptatif
;;;Arg :name, String nom et titre de la boite de dialogue
;;;     linp, liste de liste
;;;Retour : Liste des valeurs choisies ou nil
;;;Exemple (multicheck "Fourreaux" '(("Nombre :" ("1" "2" "3")) ("Type :" ("P.E.H.D." "P.V.C.")) ("Diametre :"("28/32" "42/45"))))
(defun multicheck (name linp / tdcl n dcltmp odcl tfct vals vdef acts fct ofct l ret)
;Ecriture du DCL
    (setq tdcl (strcat name " :dialog {label = \"" name "\"; :boxed_column { ") n 0)
    (foreach inp linp
        (setq tdcl (strcat tdcl ":popup_list { 
                                        key = \"pop" (itoa (setq n (1+ n))) "\"; 
                                        label = \"" (car inp) "\"; 
                                        edit_width = 20;}"
                    )
        )
    )
    (setq tdcl (strcat tdcl "} spacer; ok_cancel; }")
           dcltmp (vl-filename-mktemp "tmp.dcl")
           odcl (open dcltmp "w")
    )
    (write-line tdcl odcl)
    (close odcl)
;Ecriture de la fonction d'appel    
    (setq tfct (strcat "(defun fcttmp (dcl name li / dcl_id done ") n 0 star "" acts "" vals "" vdef "")
    (foreach inp linp
        (setq vals (strcat vals " val" (itoa (setq n (1+ n))))
               vdef (strcat vdef " val" (itoa n) " \"" (caadr inp)"\"")
               star (strcat star "(start_list \"pop" (itoa n) "\")
                                    (mapcar 'add_list (cadr (nth "(itoa (1- n))" li)))
                                    (end_list)"
               
                    )
               acts (strcat acts "(action_tile \"pop" (itoa n) "\" \"(setq val" (itoa n) " (nth (atoi $value) (cadr (nth "(itoa (1- n))" li))))\")")
        )                          
    )
    (setq   tfct (strcat tfct   
                                vals 
                                ")(if (new_dialog \""
                                name 
                                "\" (setq dcl_id (load_dialog dcl)))(progn (setq " 
                                vdef
                                ")"
                                star
                                acts 
                                "(action_tile \"cancel\" \"(done_dialog 0)\")
                                 (action_tile \"accept\" \"(done_dialog 1)\")
                                 (setq done (start_dialog))
                                 (unload_dialog dcl_id)
                                 (if (= done 1)(list " 
                                 vals 
                                 ")
                                 nil
                                 )
                                 )))"
                )
            fct  (vl-filename-mktemp "fct.lsp")
            ofct (open fct "w")
    )
    (write-line tfct ofct)
    (close ofct)
;Chargement de la fonction
    (load fct)
;Execution
    (setq ret (fcttmp dcltmp name linp))
;Effacement des fichiers temp
    (vl-file-delete dcltmp)
    (vl-file-delete fct)
;Liste en retour
    ret
)

le test donne ceci

test1.jpg.e017e635eaec390dc8916eaef0631775.jpg

on peut donc imaginer des combinaisons, mais c'est la liste d'entrée qui devient difficile à construire.

Sinon, je voulais aborder le sujet d'écrire des fonctions en lisp qui s'adaptent aux circonstances.

Il me semble que c'est se rapprocher de l'Intelligence Artificielle.

Certain disent qu'elle commence avec l'utilisation du if ,

ce n'est encore qu'une abstraction, un concept qui reste à définir.

En tout cas, c'est une chose que ne peuvent pas faire tout les langages, c'est l'avantage de ceux qui ne sont pas compilé

ils peuvent s'auto-écrire.

Lien vers le commentaire
Partager sur d’autres sites

Pour s'adapter aux circonstances, il suffirait de passer en argument via un flag les différents types de box utiles et utilisées je pense (donc "edit_box", "popup_list", etc).
En soit, pour la plupart, c'est bien souvent le key et label qui sont nécessaire et ensuite en fonction du type de valeur, il faut définir les tiles correctement (via (start_list), (set_tile), etc).
Mais je reconnais bien trop souvent que plus on généralise une fonction pour quelle s'adapte à tous les cas de figure, et plus la définition des arguments nécessite des fonctions de génération de liste ou autre (ici encore, il serait possible de les généraliser xD)
Donc évidemment, l'exercice semble intéressant mais il ne faut pas non plus créer des fonctions tellement générales au point de devoir créer des fonctions annexes pour les paramétrer correctement >w<
Mais en soit, c'est l'utilité des fonctions d'ordre supérieur (un vrai casse-tête à programmer, mais un vrai plaisir à utiliser une fois fait !).

17 minutes ago, Fraid said:

Il me semble que c'est se rapprocher de l'Intelligence Artificielle.

J'attends le jour où je n'aurais plus qu'à appuyer sur un bouton et AutoCAD s'occupera de gérer mes projets, mes plannings et tout le tointoin xD

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

juste pour infos : je suis dans les réseaux et j'ai plein de liste intelligente comme tu dis !

par contre tu connais mes préférences de lagunages ^^ (mais si tu as besoin d'aide, je suis dispo en MP)

et néglige pas le select case 😉

 

Quote

J'attends le jour où je n'aurais plus qu'à appuyer sur un bouton et AutoCAD s'occupera de gérer mes projets, mes plannings et tout le tointoin xD

je démissionne si tu veux, je supprimes tout et tu recommences XD

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

Désolé du décalage temporel, mais voici quand même la suite de mon expérience.

La fusion des 2 premiers lisp plus le rajout des toggles,(case à cocher)

J'ai aussi évité de parcourir 2 fois la même liste avec foreach,

mais c'étais pour rendre les choses plus lisible.

j'ai réduit à un argument, une liste, avec comme premier élément le nom du dcl (qui apparait en titre) puis les tuiles qui seront reconnu par leur type.

un simple texte :  edit_box ex "Nom :"

une liste de 2 textes : Toggle '( ": Visible" "1") 0 ou 1 pour activée ou non

sinon popup_list '("Nombre :" ("1" "2" "3"))

;;;multidcl
;;;DCL adaptatif
;;;Arg :ldcl, liste
;;;Retour : Liste des valeurs choisies ou nil
;;;Exemple (multidcl '("Test" "Nom :" (" : Visible" "1")(" : Imprimable" "0")("Nombre :" ("1" "2" "3"))))
(defun multidcl (ldcl / tdcl n tfct star acts vals vdef dcltmp odcl fct ofct ret)
    (setq tdcl (strcat (car ldcl) " :dialog {label = \"" (car ldcl) "\"; :boxed_column { ") n 0
           tfct (strcat "(defun fcttmp (dcl name li / dcl_id done ")
           star "" acts "" vals "" vdef ""
    )
    (foreach dc (cdr ldcl)
        (cond  ((= (type dc) 'STR)
                    (setq   tdcl    (strcat tdcl ":edit_box { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" dc "\"; 
                                                    edit_width = 20; 
                                                    }"
                                    )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"\"")
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val"(itoa n)" $value)\")")
                    )
                )
                ((= (type (cadr dc)) 'STR)
                    (setq tdcl (strcat tdcl ":toggle { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" (car dc) "\"; 
                                                    value = \"" (cadr dc) "\";}"
                                )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"" (cadr dc)"\"")
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val"(itoa n)" $value)\")")
                    )
                )
                ( T (setq tdcl (strcat tdcl ":popup_list { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" (car dc) "\"; 
                                                    edit_width = 20;}"
                                )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"" (caadr dc)"\"")
                            star (strcat star "(start_list \"til" (itoa n) "\")
                                    (mapcar 'add_list (cadr (nth "(itoa (1- n))" (cdr li))))
                                    (end_list)"
               
                                )
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val" (itoa n) " (nth (atoi $value) (cadr (nth "(itoa (1- n))" (cdr li)))))\")")
                    )
                )
        )
    )
    (setq tdcl (strcat tdcl "} spacer; ok_cancel; }")
           dcltmp (vl-filename-mktemp "tmp.dcl")
           odcl (open dcltmp "w")
           
    )
    (write-line tdcl odcl)
    (close odcl)
    (setq   tfct (strcat tfct   
                                vals 
                                ")(if (new_dialog \""
                                (car ldcl) 
                                "\" (setq dcl_id (load_dialog dcl)))(progn (setq " 
                                vdef
                                ")"
                                star
                                acts 
                                "(action_tile \"cancel\" \"(done_dialog 0)\")
                                 (action_tile \"accept\" \"(done_dialog 1)\")
                                 (setq done (start_dialog))
                                 (unload_dialog dcl_id)
                                 (if (= done 1)(list " 
                                 vals 
                                 ")
                                 nil
                                 )
                                 )))"
                )
            fct  (vl-filename-mktemp "fct.lsp")
            ofct (open fct "w")
    )
    (write-line tfct ofct)
    (close ofct)
    (load fct)
    (setq ret (fcttmp dcltmp (car ldcl) ldcl))
    (vl-file-delete dcltmp)
    (vl-file-delete fct)
    ret
)

le résultat

Testx.jpg.a588983c8d71877844ae952fd3cda54a.jpg

(test réalisé sur win 10 cette fois ci)

On peut très certainement aller plus loin encore

et rajouter d'autre tuiles, des espaces ...

Lien vers le commentaire
Partager sur d’autres sites

5 minutes ago, Fraid said:

tfct (strcat "(defun fcttmp (dcl name li / dcl_id done ")

Coucou,

Je n'arrive pas à comprendre cette ligne...A quoi correspond ce (defun) et surtout, à quel endroit s'arrête-il ?
Autrement, cela semble tout-à-fait remarquable, je regarderais chat en détails lorsque j'aurais un peu plus de temps :3
Merci du partage !! ♥w♥

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

18 minutes ago, Luna said:

A quoi correspond ce (defun)

C'est la fonction d'appel du DCL qui est écrit dans un fichier à part, puis chargé.

Si on n'efface pas les fichiers temporaires, on peut utiliser le dcl + la fonction pour un autre programme.

On peut y arrivé sans écriture avec des fonctions supérieurs, mais on ne peut rien sauvegarder.

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité