LISP : Récupération des valeurs provenant des boîtes de dialogue

LISP : Récupération des valeurs provenant des boîtes de dialogue

Arthur.D21
Contributor Contributor
1 202 Visites
5 Réponses
Message 1 sur 6

LISP : Récupération des valeurs provenant des boîtes de dialogue

Arthur.D21
Contributor
Contributor

Bonsoir,

Je viens à vous concernant un problème entre ma boîte de dialogue et mon LISP.

 

Dans un premier temps, dans ma boîte de dialogue je demande le "diamètre du réseau". En exécution ma boîte de dialogue s'affiche correctement mais ne récupère pas la valeur entrée par l'utilisateur.

 

Dans un second temps, je demande d'écrire le nom du réseau choisit parmi les types que j'indique (EP/EU/CFA/CFO...)

J'aimerais plutôt que l'utilisateur rentre n'importe quel nom de réseau et que ce nom serve à créer un calque de type

PIC- Réseau "Réseau choisit"

 

J'espère pouvoir trouver votre aide et vous remercie par avance.

Très bonne soirée.😙

 

Voici le dcl :

reseauxboite: dialog {
label = "Sélection du réseau";

: column {
: edit_box {
label = "Réseau (EU/EP/CFA/CFO)";
key = "cléres";
}
: edit_box {
label = "Diametre du reseau (m)";
key = "clédiam";
}
: row {
: button {
label = "OK";
is_default = true;
key = "accept";
}
: button {
label = "Annuler";
is_default = false;
is_cancel = true;
key = "cancel";
}
}

 

Et le LISP

(defun c:réseaux()

(setq Acro (getvar "osmode"))
 
(setq id (load_dialog "Boitereseaux.dcl"))
(new_dialog "reseauxboite" id)

(setq Choix_reseaux 1)

(if (or (= Choix_reseaux nil)(= Choix_reseaux "")) (set_tile "cléres" Choix_reseaux) (set_tile "cléres" "EP"))
 
(action_tile "accept" "(fonctionok)")
(action_tile "cancel" "(fonctionannuler)")
(start_dialog)
  
(cond
    ((= Choix_reseaux "EU")
    (if (not (tblsearch "layer" "PIC-Réseau EU"));test de l'existence
    (command "_layer" "_M" "PIC-Réseau EU" "");si n'existe pas il est créé
    (progn ;s'il existe
        (command "_layer" "_T" "PIC-Réseau EU""");il est dégelé (au cas où)
        (command "_layer" "_S" "PIC-Réseau EU""");il devient courant
        )))

    ((= Choix_reseaux "EP")
    (if (not (tblsearch "layer" "PIC-Réseau EP"));test de l'existence
    (command "_layer" "_M" "PIC-Réseau EP" "");si n'existe pas il est créé
    (progn ;s'il existe
        (command "_layer" "_T" "PIC-Réseau EP""");il est dégelé (au cas où)
        (command "_layer" "_S" "PIC-Réseau EP""");il devient courant
        )))

    ((= Choix_reseaux "CFA")
    (if (not (tblsearch "layer" "PIC-Réseau CFA"));test de l'existence
    (command "_layer" "_M" "PIC-Réseau CFA" "");si n'existe pas il est créé
    (progn ;s'il existe
        (command "_layer" "_T" "PIC-Réseau CFA""");il est dégelé (au cas où)
        (command "_layer" "_S" "PIC-Réseau CFA""");il devient courant
        )))

    ((= Choix_reseaux "CFO")
    (if (not (tblsearch "layer" "PIC-Réseau CFO"));test de l'existence
    (command "_layer" "_M" "PIC-Réseau CFO" "");si n'existe pas il est créé
    (progn ;s'il existe
        (command "_layer" "_T" "PIC-Réseau CFO""");il est dégelé (au cas où)
        (command "_layer" "_S" "PIC-Réseau CFO""");il devient courant
        )))
(T (command "_layer" "_T" "0""");il est dégelé (au cas où)
        (command "_layer" "_S" "0"""));il devient courant )
    )
  
  
;(setq d0 (getreal "Diamètre du réseau"))

(setq pts nil)
  
(setvar "osmode" 0)
  
(command "polylign")

  (while (setq p2 (getpoint "Premier point ou Point suivant :"))
	  (command p2)
	  (setq pts (cons p2 pts)))

(command "")
 
(setq name(getpoint "saisir le point d'insertion du linéaire total"))
(setq périmètre (* pi d0))  

(command "texte" name 2 0 (strcat "Longueur du réseau (m) : " (rtos périmètre)))
  
(setq name1 (getpoint "saisir le point d'insertion de la valeur du diamètre"))
(setq diamètre d0)

(command "texte" name1 2 0 (strcat "Diamètre du réseau (m) : " (rtos diamètre)))
  
(setvar "osmode" acro)

(defun fonctionok ()
(setq Choix_reseaux (atoi(get_tile "cléres")))
(done_dialog))

(defun fonctionannuler ()
(done_dialog)
(exit)))


}
}

0 J'aime
Solutions acceptées (1)
1 203 Visites
5 Réponses
Replies (5)
Message 2 sur 6

Y.AUBRY
Advisor
Advisor

Bonjour,

 

Tu pourras trouver ci-joint le lisp Rbloc de @patrick_35 

 

Il contient de nombreux types de boutons dans le fichier dcl  : menus déroulants (popup_list), boutons (button), cases à cocher (toggle) et texbox (edit_box) comme tu peux le voir sur l'exemple ci-dessous.

 

YAUBRY_0-1643857958028.png

 

Il peut donc te servir de modèle pour la modification de ton lisp / dcl;

 

Rbloc.dcl

 

// =================================================================
//
//  RBLOC.DCL V2.10
//
//  Copyright (C) Patrick_35
//
// =================================================================

rbloc : dialog {
  key = "titre";
  is_cancel = true;
  : boxed_column {
    label = " Bloc(s) d'origine(s) ";
    : row {
      : popup_list {key = "listeo"; width = 30; label = "Nom";}
      : button     {key = "sel"; width = 15; label = "Sélection...";}
    }
    spacer;
    : toggle {key = "attr"; label = "Conserver les attributs";}
    : text {key = "texte1";}
  }
  : boxed_column {
    label = " Bloc remplaçant ";
    : row {
      : popup_list {key = "lister"; width = 30; label = "Nom";}
      : column {
        : button     {key = "pick"; width = 15; label = "Sélection...";}
        : button     {key = "rech"; width = 15; label = "Parcourir...";}
      }
    }
    : text {key = "texte2";}
  }
  : boxed_column {
    label = " Echelle ";
    : toggle {key = "echori"; label = "Conserver l'échelle d'origine";}
    : toggle {key = "uniforme"; label = "Echelle uniforme";}
    : row {
      : edit_box {key = "fact_x"; width = 5; label = "X:";}
      : edit_box {key = "fact_y"; width = 5; label = "Y:";}
      : edit_box {key = "fact_z"; width = 5; label = "Z:";}
    }
    : text {key = "texte3";}
  }
  spacer;
  ok_cancel;
}

 

 

Rbloc.lsp

 

 

;;;=================================================================
;;;
;;; RBLOC V2.10
;;;
;;; Remplacer un bloc par un autre
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:rbloc(/ bl conserver_attr dcl_id echo echu echx echy echz js liste_bl 
		 obj_liste old_error redef resultat selectiono selectionr
		 *errrbloc* MsgBox affiche_choix idem_lst ech_u affiche_dial
		 liste_choix liste_sel selection verif_valeur parcourir
		 selection_ecran changer_blocs)

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Gestion des erreurs
  ;;;
  ;;;---------------------------------------------------------------

  (defun *errrbloc* (msg)
    (if (/= msg "Function cancelled")
      (if (= msg "quit / exit abort")
	(princ)
	(princ (strcat "\nErreur : " msg))
      )
      (princ)
    )
    (setq *error* old_error)
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (princ)
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Message
  ;;;
  ;;;---------------------------------------------------------------

  (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
    (vl-load-com)  
    (setq WshShell (vlax-create-object "WScript.Shell"))
    (setq Reponse  (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))
    (vlax-release-object WshShell)
    Reponse
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Affichage tu type de sélection du bloc d'origine
  ;;;
  ;;;---------------------------------------------------------------

  (defun affiche_choix()
    (if (eq selectiono "0")
      (if js
	(set_tile "texte1" (strcat "Sélection Multiple de " (itoa (sslength js)) " bloc(s)"))
	(set_tile "texte1" "Sélection Multiple dans tout le dessin")
      )
      (if js
	(set_tile "texte1" (strcat "Sélection défini de " (itoa (sslength js)) " bloc(s)"))
	(set_tile "texte1" "Sélection défini dans tout le dessin")
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Comparaison des deux listes
  ;;;
  ;;;---------------------------------------------------------------

  (defun idem_lst()
    (if (and (eq (1- (atoi selectiono))(atoi selectionr)) (not redef))
      (progn
	(set_tile "texte2" "L'origine et le remplaçant ne peuvent pas être identique")
	(mode_tile "accept" 1)
	(mode_tile "cancel" 2)
      )
      (progn
	(if redef
	  (set_tile "texte2" (strcat "Bloc : " redef))
	  (set_tile "texte2" "")
	)
	(mode_tile "accept" 0)
	(mode_tile "accept" 2)
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Gestion de l'afficjage des facteurs d'échelles
  ;;;
  ;;;---------------------------------------------------------------

  (defun ech_u()
    (if (eq echo "1")
      (progn
	(mode_tile "fact_x" 1)
	(mode_tile "fact_y" 1)
	(mode_tile "fact_z" 1)
	(mode_tile "uniforme" 1)
      )
      (progn
	(mode_tile "fact_x" 0)
	(mode_tile "uniforme" 0)
	(if (eq echu "1")
	  (progn
	    (mode_tile "fact_y" 1)
	    (mode_tile "fact_z" 1)
	  )
	  (progn
	    (mode_tile "fact_y" 0)
	    (mode_tile "fact_z" 0)
	  )
	)
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Afficher la boite de dialogue
  ;;;
  ;;;---------------------------------------------------------------

  (defun affiche_dial()
    (new_dialog "rbloc" dcl_id)
    (set_tile "titre" "Rbloc V2.10")
    (start_list "listeo")
    (add_list "** Bloc(s) Multiple(s) **")
    (mapcar 'add_list liste_bl)
    (end_list)
    (set_tile "listeo" selectiono)
    (set_tile "attr" conserver_attr)
    (affiche_choix)
    (start_list "lister")
    (mapcar 'add_list liste_bl)
    (end_list)
    (set_tile "lister" selectionr)
    (if redef
      (mode_tile "lister" 1)
      (mode_tile "lister" 0)
    )
    (set_tile "echori" echo)
    (set_tile "fact_x" echx)
    (set_tile "fact_y" echy)
    (set_tile "fact_z" echz)
    (set_tile "uniforme" echu)
    (ech_u)
    (idem_lst)
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Comparaison avec la liste du bloc remplaçant
  ;;;
  ;;;---------------------------------------------------------------

  (defun liste_choix(val)
    (setq selectiono val js nil)
    (affiche_choix)
    (idem_lst)
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Comparaison avec la liste du bloc d'origine
  ;;;
  ;;;---------------------------------------------------------------

  (defun liste_sel(val)
    (setq selectionr val)
    (idem_lst)
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Sélection dans le dessin suivant un filtre
  ;;;
  ;;;---------------------------------------------------------------

  (defun selection(/ js1)
    (if (eq selectiono "0")
      (setq js1 (ssget (list (cons 0 "INSERT"))))
      (setq js1 (ssget (list (cons 0 "INSERT") (cons 2 (strcat (nth (1- (atoi selectiono)) liste_bl) ",`*U*")))))
    )
    (if js1
      (setq js js1)
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Vérification que la valeur zéro n'est pas entrée
  ;;;
  ;;;---------------------------------------------------------------

  (defun verif_valeur(var val)
    (if (zerop (read val))
      (cond
	((= var "x")
	  (set_tile "texte3" "Le facteur d'échelle X ne peut être nul")
	  (mode_tile "fact_x" 2)
	)
	((= var "y")
	  (set_tile "texte3" "Le facteur d'échelle Y ne peut être nul")
	  (mode_tile "fact_y" 2)
	)
	((= var "z")
	  (set_tile "texte3" "Le facteur d'échelle Z ne peut être nul")
	  (mode_tile "fact_z" 2)
	)
      )
      (cond
	((= var "x")
	  (set_tile "texte3" "")
	  (setq echx val)
	)
	((= var "y")
	  (set_tile "texte3" "")
	  (setq echy val)
	)
	((= var "z")
	  (set_tile "texte3" "")
	  (setq echz val)
	)
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Rechercher un bloc en tant que fichier
  ;;;
  ;;;---------------------------------------------------------------

  (defun parcourir(/ fic n result trouve)
    (if (setq fic (getfiled "Sélectionnez votre bloc" "" "dwg" 16))
      (progn
	(setq n 0 redef nil)
	(while (nth n liste_bl)
	  (if (eq (strcase (nth n liste_bl)) (strcase (vl-filename-base fic)))
	    (progn
	      (setq trouve T)
	      (setq result (msgbox "Rbloc - Bloc existant" (+ 4 48 256) (strcat "Le bloc " (strcase (nth n liste_bl)) " est déjà dans le dessin.\nDésirez-vous le remplacer ?")))
	      (if (eq result 6)
		(setq redef fic selectionr (itoa n))
		(setq redef nil selectionr (itoa n))
	      )
	    )
	  )
	  (setq n (1+ n))
	)
	(if (and (not trouve) (not redef))
	  (setq redef fic)
	)
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Selection d'un bloc remplacant sur l'écran
  ;;;
  ;;;---------------------------------------------------------------

  (defun selection_ecran(/ bl n no sel)
    (while (not (setq sel (ssget "_:E:S" (list (cons 0 "INSERT")))))
      (princ "\nVeuillez sélectionner un bloc.")
    )
    (setq no (vlax-ename->vla-object (ssname sel 0))
	  no (if (vlax-property-available-p no 'effectivename)
		(vla-get-effectivename no)
		(vla-get-name no)
	     )
    )
    (setq sel (tblsearch "block" no) n 0)
    (if (and (not (eq (logand (cdr (assoc 70 sel)) 1) 1))
	     (not (eq (logand (cdr (assoc 70 sel)) 4) 4))
	     (not (eq (logand (cdr (assoc 70 sel)) 16) 16))
	)
      (while (setq bl (nth n liste_bl))
	(if (eq (cdr (assoc 2 sel)) bl)
	  (setq selectionr (itoa n))
	)
	(setq n (1+ n))
      )
      (Msgbox "Rbloc" 48 "Ce bloc est un xref.")
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Remplacer un bloc par un autre
  ;;;
  ;;;---------------------------------------------------------------

  (defun changer_blocs(/ bl n nbl imod nom cont result tot)
    (if (and (not js) (eq selectiono "0"))
      (progn
	(setq result (msgbox "Rbloc - ATTENTION !!!" (+ 4 16 256) "Vous allez remplacer tous les blocs du dessin par un SEUL TYPE !!!\nDésirez-vous continuer ?"))
	(if (eq result 7)
	  (setq cont T)
	)
      )
    )
    (if (not cont)
      (progn
	(setq imod (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
	(if redef
	  (progn
	    (vla-delete (vla-InsertBlock imod (vlax-3d-point '(0.0 0.0 0.0)) redef 1 1 1 0))
	    (setq nom (vl-filename-base redef))
	  )
	  (setq nom (nth (atoi selectionr) liste_bl))
	)
	(if (not js)
	  (if (eq selectiono "0")
	    (setq js (ssget "x" (list (cons 0 "INSERT"))))
	    (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 (strcat (nth (1- (atoi selectiono)) liste_bl) ",`*U*")))))
	  )
	)
	(setq n 0 tot 0)
	(while (ssname js n)
	  (setq bl (entget (ssname js n))
		no (vlax-ename->vla-object (ssname js n))
		no (if (vlax-property-available-p no 'effectivename)
		      (vla-get-effectivename no)
		      (vla-get-name no)
		   )
	  )
	  (if (or (eq selectiono "0")
		  (and (not (eq selectiono "0"))
			    (eq no (nth (1- (atoi selectiono)) liste_bl))
		  )
	      )
	    (progn
	      (if (eq conserver_attr "1")
		(if (not (eq (strcase no) (strcase nom)))
		  (setq bl (subst (cons 2 nom) (assoc 2 bl) bl))
		)
		(progn
		  (setq nbl (entget (vlax-vla-object->ename (vla-InsertBlock imod (vlax-3d-point (cdr (assoc 10 bl))) nom 1 1 1 0))))
		  (entdel (cdr (assoc -1 bl)))
		  (setq bl (subst (assoc -1 nbl) (assoc -1 bl) bl)
			bl (subst (assoc  2 nbl) (assoc  2 bl) bl)
			bl (subst (assoc  5 nbl) (assoc  5 bl) bl)
		  )
		  (if (and (cdr (assoc 66 bl)) (not (cdr (assoc 66 nbl))))
		    (setq bl (vl-remove (assoc 66 bl) bl))
		  )
		)
	      )
	      (if (eq echo "0")
		(if (eq echu "0")
		  (setq bl (subst (cons 41 (atof echx)) (assoc 41 bl) bl)
			bl (subst (cons 42 (atof echy)) (assoc 42 bl) bl)
			bl (subst (cons 43 (atof echz)) (assoc 43 bl) bl)
		  )
		  (setq bl (subst (cons 41 (atof echx)) (assoc 41 bl) bl)
			bl (subst (cons 42 (atof echx)) (assoc 42 bl) bl)
			bl (subst (cons 43 (atof echx)) (assoc 43 bl) bl)
		  )
		)
	      )
	      (entmod bl)
	      (entupd (cdr (assoc -1 bl)))
	      (setq tot (1+ tot))
	    )
	  )
	  (setq n (1+ n))
	)
	(princ (strcat "\n\tRemplacement de "  (itoa tot) " bloc(s)."))
      )
      (princ "\n\tAbandon.")
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Routine principale.
  ;;;
  ;;;---------------------------------------------------------------

  (vl-load-com)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq Old_Error *error* *error* *errrbloc*)
  (if (findfile "rbloc.dcl")
    (progn
      (setq bl (tblnext "block" t))
      (while bl
	(if (and (not (eq (logand (cdr (assoc 70 bl)) 1) 1))
		 (not (eq (logand (cdr (assoc 70 bl)) 4) 4))
		 (not (eq (logand (cdr (assoc 70 bl)) 16) 16)))
	  (setq liste_bl (append liste_bl (list (cdr (assoc 2 bl)))))
	)
	(setq bl (tblnext "block"))
      )
      (if liste_bl
	(progn
	  (setq dcl_id (load_dialog (findfile "rbloc.dcl"))
		liste_bl (acad_strlsort liste_bl)
		conserver_attr "1"
		selectiono "0"
		selectionr "0"
		echo "1" echu "0" echx "1" echy "1" echz "1")
	  (while (and (not (eq resultat 0))(not (eq resultat 1)))
	    (affiche_dial)
	    (mode_tile "accept" 2)
	    (action_tile "listeo"   "(liste_choix $value)")
	    (action_tile "lister"   "(liste_sel $value)")
	    (action_tile "sel"      "(done_dialog 2)")
	    (action_tile "rech"     "(done_dialog 3)")
	    (action_tile "pick"     "(done_dialog 4)")
	    (action_tile "attr"     "(setq conserver_attr $value)")
	    (action_tile "echori"   "(setq echo $value)(ech_u)")
	    (action_tile "fact_x"   "(verif_valeur \"x\" $value)")
	    (action_tile "fact_y"   "(verif_valeur \"y\" $value)")
	    (action_tile "fact_z"   "(verif_valeur \"z\" $value)")
	    (action_tile "uniforme" "(setq echu $value)(ech_u)")
	    (action_tile "cancel"   "(done_dialog 0)")
	    (action_tile "accept"   "(done_dialog 1)")
	    (setq resultat (start_dialog))
	    (cond
	      ((= resultat 1)
		(changer_blocs)
	      )
	      ((= resultat 2)
		(selection)
	      )
	      ((= resultat 3)
		(parcourir)
	      )
	      ((= resultat 4)
		(selection_ecran)
	      )
	    )
	  )
	  (unload_dialog dcl_id)
	)
	(msgbox "Rbloc" 48 "Pas de bloc dans le dessin")
      )
    )
    (msgbox "Rbloc" 16 "Le fichier RBLOC.DCL est introuvable.")
  )
  (setq *error* Old_Error)
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
)

(setq nom_lisp "RBLOC")
(if (/= app nil)
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " chargé."))
    (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
  (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

 

J'espère que ca pourra t'aider pour finaliser ton code.

 

Bon courage,

Yoan

Yoan AUBRY

EESignature

0 J'aime
Message 3 sur 6

_gile
Consultant
Consultant

Salut,

Sans entrer dans les détails de ton con code, en règle générale il est toujours préférable de "séparer les préoccupations" (separate concerns). La boite de dialogue est juste une interface pour récupérer des entrées utilisateur et elle ne devrait que renvoyer le résultat de ces entrées.

C'est la fonction qui définit la commande qui charge et affiche cette boite de dialogue pour en récupérer le résultat et ensuite traiter ces données.

 

En reprenant ton exemple.

Le DCL :

reseauxboite: dialog {
  label = "Sélection du réseau";
    : edit_box {
      label = "Réseau (EU/EP/CFA/CFO)";
      key = "cleres";
    }
    : edit_box {
      label = "Diametre du reseau (m)";
      key = "clediam";
    }
    ok_cancel;
}

 

Le LISP qui gère la boite de dialogue :

;; Affiche la boite de dialogue
;; Renvoie une liste contenant le réseau et le diamètre
;; si l'utilisateur a cliqué OK ; nil, s'il a annulé.
(defun reseauxboite (/ dcl_id res diam return)
  (setq dcl_id (load_dialog "Boitereseaux.dcl"))
  (if (not (new_dialog "reseauxboite" dcl_id))
    (exit)
  )
  ;; valeur par défaut
  (setq res "EP")
  (setq diam 1.5)
  (set_tile "cleres" res)
  (set_tile "clediam" (rtos diam))
  ;; réactions
  (action_tile "cleres" "(setq res $value))")
  (action_tile
    "clediam"
    (vl-prin1-to-string
      '(if (distof $value)
	(setq diam (distof $value))
	(progn
	  (alert "Dimètre incorrect")
	  (set_tile "clediam" (rtos diam))
	)
       )
    )
  )
  (action_tile "accept" "(setq return (list res diam)) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  ;; valeur renvoyée
  return
)

 

Une commande de test :

(defun c:test (/ inputs res diam)
  (if (setq inputs (reseauxboite))
    (progn
      (setq res	 (car inputs)
	    diam (cadr inputs)
      )
      (alert
	(strcat
	  "Réseau : "
	  res
	  "\nDiamètre : "
	  (rtos diam)
	)
      )
    )
    (alert "L'utilisateur a annulé")
  )
  (princ)
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 J'aime
Message 4 sur 6

_gile
Consultant
Consultant
Solution acceptée

Si le choix du réseau doit se limiter à certaines valeurs, il vaut mieux utiliser une liste déroulante.

DCL :

reseauxboite: dialog {
  label = "Sélection du réseau";
    : popup_list {
      label = "Réseau";
      key = "cleres";
    }
    : edit_box {
      label = "Diametre du reseau (m)";
      key = "clediam";
    }
    ok_cancel;
}

LISP :

;; Affiche la boite de dialogue
;; Renvoie une liste contenant le réseau et le diamètre
;; si l'utilisateur a cliqué OK ; nil, s'il a annulé.
(defun reseauxboite (/ dcl_id lst res diam return)
  (setq dcl_id (load_dialog "Boitereseaux.dcl"))
  (if (not (new_dialog "reseauxboite" dcl_id))
    (exit)
  )
  ;; valeur par défaut
  (setq lst '("EU" "EP" "CFA" "CFO"))
  (setq res "EP")
  (setq diam 1.5)
  (start_list "cleres")
  (mapcar 'add_list lst)
  (end_list)
  (set_tile "cleres" "1")
  (set_tile "clediam" (rtos diam))
  ;; réactions
  (action_tile "cleres" "(setq res (nth (atoi $value) lst))")
  (action_tile
    "clediam"
    (vl-prin1-to-string
      '(if (distof $value)
	(setq diam (distof $value))
	(progn
	  (alert "Dimètre incorrect")
	  (set_tile "clediam" (rtos diam))
	)
       )
    )
  )
  (action_tile "accept" "(setq return (list res diam)) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  ;; valeur renvoyée
  return
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 5 sur 6

Arthur.D21
Contributor
Contributor
merci pour votre réponse 🙂
0 J'aime
Message 6 sur 6

ezaiah.harlin
Observer
Observer

Salut, merci pour ces information je trouve ça vraiment utile.

Appvalley TutuApp Tweakbox

0 J'aime