Besoin d'un "entsel / getstring"

Bred · le 24 mars 2020

Bonjour,

Avant d'y perdre quelques heures, je cherche une fonction qui permet de laisser une invite en laissant la possibilité de retourner une sélection unique (entsel) ou un texte...

Genre :

(setq r (entsel-getstring "\n Entrez un nom ou faire Sélection : "))

Merci d'avance.

Luna · le 24 mars 2020

Bonjour,

La fonction (entsel) possède déjà un argument pour afficher un message personnalisé :)

Il est vrai qu'on ne le spécifie que rarement mais il est bien présent (si j'ai bien compris ta demande ^^')

Voir aide AutoCAD

Sumimasen, après relecture, je me suis levée du pied gauche !

Le problème d'initget c'est qu'il n'est pas compatible avec la fonction (getstring) cependant, tu peux tricher !

Si l'utilisateur diot retourner des chaînes de caractères spécifique (similaire à (getkword)), tu peux voir un (initget) avec les mots clés auquel tu associe un (getpoint) (et via le (getpoint), tu récupères l'entité située à ce point - mais il faudra passer par une sélection relative ou via un fuzz - )

https://www.cadtutor.net/forum/topic/59762-getpoint-can-be-used-as-getkword/

Peut-être voir du côté de (nentselp) si (ssget) ne fonctionne pas correctement mais attention car (entsel) est différent de (nentsel) donc à voir selon tes besoins :

https://documentation.help/AutoLISP-Functions/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-699b.htm

Si tu as une entrée de chaînes libres, je n'ai pas d'autres solutions que de te proposer un (getpoint) associer avec un (getkword), de ce genre là (non testé, notamment au niveau de la récupération de l'entité) :

(initget "Texte")
(if (null (setq chx (getpoint "\nChoisir une entité ou <Texte> : ")))
     (setq chx (getstring "\nEntrez le texte : "))
     (setq chx (ssname (ssget chx) 0))
)

Bisous,

Luna

DenisHen · le 24 mars 2020

Sumimasen,...

Japonais(e) ?

Bred · le 24 mars 2020

Bonjour,

merci pour la réponse.

Non, cela ne convient pas.

Le getpoint ne convient pas en 3D.

De plus votre proposition ne peut fonctionner car le getpoint (comme le entsel) signale par message la "non selection" (et ce n'est pas une erreur, sinon je pourrais le traiter avec vl-catch-error)

Je pense qu'il doit y avoir une astuce avec vl-catch-all-apply, mais je dois faire fausse route car je tourne en rond.

Luna · le 24 mars 2020

Salut !

Japonais(e) ?

Malheureusement nan, mais fana de la culture Jap' :)

Le getpoint ne convient pas en 3D

Après quelques tests, la fonction (entsel) me retourne toujours l'entité dernièrement créée si le point cliqué fait référence à plusieurs entités différentes situées sur un plan différent (élévation pour "LWPOLYLINE" et coordonnées Z pour les sommets de "POLYLINE" 3D) sans tenir compte de l'altitude la plus élevée ou de la plus proche au-dessous de Z=0.

Je travaille jamais/rarement en 3D donc mon expérience dans ce domaine est limitée mais si je teste rapidement les fonctions on a :

De plus votre proposition ne peut fonctionner car le getpoint (comme le entsel) signale par message la "non selection" (et ce n'est pas une erreur, sinon je pourrais le traiter avec vl-catch-error)

(entsel "\nCliquez sur l'écran") ; Sélection vide
nil

(entsel "\nCliquez sur l'écran") ; Sélection d'un objet
(<Nom d'entité: 500a9570> (403.995 -302.801 0.0)) ; On remarque donc que (entsel) reprend le format d'un retour de getpoint pour le (cadr) puisqu'on a un point 3D avec Z = 0.0

(getpoint "\nCliquez sur l'écran") ; Ne clique pas et appuis sur ENTER ou SPACE
nil

(getpoint "\nCliquez sur l'écran") ; Clic sur écran
(403.995 -302.801 0.0) ; Retour d'un point 3D systématique (Z = 0.0 si le point n'appartient à aucun objet dont la valeur du Z est différente de 0.0)

Du coup quel est le soucis exactement au niveau de la saisie 3D car (ssname (ssget pt) 0) retourne le même résultat qu'un (car (entsel)) par rapport à ma configuration d'AutoCAD...

Donc si je prend :

(defun Test (/ chx)
 (initget "Texte")
 (if (or (null (setq chx (getpoint "\nChoisir une entité ou [Texte] <Texte> : "))) (= chx "Texte"))
     (setq chx (getstring "\nEntrez le texte : "))
     (setq chx (ssname (ssget chx) 0))
 )
)

Commande: (test)
Commande: Choisir une entité ou [Texte] <Texte> : ; Appui sur ENTER ou SPACE
Commande: Entrez le texte : Essai
Commande: "Essai"
Commande: (test)
Commande: Choisir une entité ou [Texte] <Texte> : (403.995 -302.801 0.0) ; Clic sur l'écran
Commande: <Nom d'entité: 500a9570>
Commande: (test)
Commande: Choisir une entité ou [Texte] <Texte> : T
Commande: Entrez le texte : Essai
Commande: "Essai"

Donc je pense que je n'ai pas compris votre demande ^^'

Bisous,

Luna

Bred · le 24 mars 2020

Non, la validation pour rentrer le texte (ou sélectionner) est justement ce que je veux modifier.

Voilà ce que je veux modifier (ça ne marchera pas chez vous, mais le code est clair je pense) :

-je demande un nom de bloc, si je ne veux pas donner de nom, je propose une sélection, sauf que cette sélection je doit l'atteindre en validant.

Ce n'est pas propre.

  (setq bloc_R (getstring t "\n Entrez le nom du bloc Remplaçant ou < Sélection >: "))  
 (if (= bloc_R "")
       (progn (while (= bloc_R "")
     (setq bloc_R (ssget "_:S:E" '((0 . "INSERT")))))      
     (setq bloc_R (cdr (assoc 2 (entget (ssname bloc_R 0)))))
     (princ (strcat "\n Bloc remplaçant : " bloc_R)))
   (if (vl-catch-all-error-p
  (vl-catch-all-apply 'vla-item (list
				  (vla-get-Blocks
					(vla-get-ActiveDocument (vlax-get-acad-object)))bloc_R)))
     (setq bloc_R (findfile (strcat bloc_R ".dwg" ))))
   )

La validation pour sélectionner si je ne veux pas rentrer de nom, je la trouve laborieuse.

Luna · le 24 mars 2020

Salut,

En effet, auquel cas, le problème pourrait être "esquiver" via une boîte de dialogue (je sais que ça peut sembler lourd mais au final, ça l'est beaucoup moins que de devoir se taper le nom entier du bloc à la mano !^^')

Pour cela, j'ai pris l'habitude d'utiliser la fonction ListBox de BonusCAD (qui je viens de l'apprendre, serait de (gile) hihi) qui est super géniale !!

(voir le post #6)

Après pour être honnête, je l'ai modifiée légèrement car je l'utilise avec des listes d'atomes simples (pas de (key . label)) donc si veux voici ma version (1 argument supplémentaire pour une valeur par défaut) :

;--- LISP de bonusCAD publié sur CADXP.com le 11/01/2016 11:34

;--- Version modifiée de la fonction (ListBox), possède 5 arguments
;--- title correspond à l'entête de la boîte de dialogue
;--- msg correspond au message affiché au dessus de la liste
;--- lst correspond à la liste à afficher
;--- value correspond à la valeur définie par défaut
;--- flag correspond au type de liste souhaitée
;	flag = 0  ->  liste déroulante (choix unique)
;	flag = 1  ->  liste avec barre de défilement (choix unique)
;	flag = 2  ->  liste avec barre de défilement (choix multiple)

; Renvoie la liste des éléments ayant été sélectionnés
(defun ListBox (title msg lst value flag / tmp file DCL_ID choice)

(setq tmp (vl-filename-mktemp "tmp.dcl")
      file (open tmp "w")
)
(write-line
	(strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";")
	file
)
(if (and msg (/= msg ""))
	(write-line (strcat ":text{label=\"" msg "\";}") file)
)
(write-line
	(cond
		((= 0 flag) "spacer;:popup_list{key=\"lst\";")
		((= 1 flag) "spacer;:list_box{height=15;key=\"lst\";")
		(t "spacer;:list_box{height=15;key=\"lst\";multiple_select=true;")
	)
	file
)
(write-line "}spacer;ok_cancel;}" file)
(close file)
(setq DCL_ID (load_dialog tmp))
(if (not (new_dialog "ListBox" DCL_ID))
	(exit)
)
(start_list "lst")
(mapcar 'add_list lst)
(end_list)
(set_tile "lst" (if (member value lst) (itoa (vl-position value lst)) (itoa 0)))
(action_tile
		"accept"
		"(or 	(= (get_tile \"lst\") \"\")
			(if (= 2 flag)
				(progn
					(foreach n (str2lst (get_tile \"lst\") \" \")
						(setq choice (cons (nth (atoi n) lst) choice))
					)
					(setq choice (reverse choice))
				)
				(setq choice (nth (atoi (get_tile \"lst\")) lst))
			)
		)
		(done_dialog)"
)
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete tmp)
choice

)

;--- LISP de bonusCAD publié sur CADXP.com le 11/01/2016 11:34

;--- Nécessaire au bon fonctionnement de la fonction (ListBox) ci-dessus

(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)
       )
)

Ainsi tu pourrais ne pas faire de validation après le (getstring) mais plutôt à la place du (getstring), du tout-en-un quoi ^^'

On pourrait donc avoir ceci :

(defun try (/ bloclist name chx)

(setq name (cdr (assoc 2 (tblnext "BLOCK" t))))
(while name
      (setq bloclist (cons name bloclist)
            name (cdr (assoc 2 (tblnext "BLOCK")))
      )
)
(initget "Texte")
(if (or (null (setq chx (getpoint "\nChoisir une entité ou [Texte] <Texte> : "))) (= chx "Texte"))
      (setq chx (ListBox "Sélection du bloc" "Choisir le nom d'un bloc" (vl-sort (vl-remove-if '(lambda (B) (wcmatch b "`*U*,`*D*")) bloclist) '<) nil 1))
      (setq chx (getpropertyvalue (ssname (ssget chx '((0 . "INSERT"))) 0) "BlockTableRecord/Name"))
)

)

ça retourne le nom de la définition de bloc sélectionnée via la boîte de dialogue ou via un (getpoint)+(ssget).

C'est pas parfait, et notamment au niveau du ssget, qui retourne une erreur si aucun objet de type bloc n'est sélectionné, donc c'est préférable de mettre un boucle pour s'assurer de la validation de l'utilisateur, mais ça reste une piste je pense :)

En espérant que ça puisse t'aider en tout cas !

Bisous,

Luna

(gile) · le 24 mars 2020

Salut Bred,

Ça faisait un bout de temps qu'on ne t'avait vu par ici.

Je te propose un truc avec grread, c'est améliorable.

J'ai essayé de faire quelque chose de générique mais tu peux en faire quelque chose plus spécifique à ton besoin.

;; getstringorentity
;; Invite l'utilisateur à  entrer une chaîne ou sélectionner une entité.
;; Renvoie la chaîne entrée, une liste semblable à celle revoyée par (entsel) ou nil.
;;
;; Arguments
;; cr  : si non nil, accepte les espaces dans la chaîne comme (getstring)
;; msg : message d'invite
(defun getstringorentity (cr msg / break result gr pt ent str)
 (prompt msg)
 (while
   (and (not break) (setq gr (grread T 4 2)))
    (cond
      ;; récupération du point sous le curseur
      ((= (car gr) 5)
(setq pt (cadr gr))
      )
      ;; clic gauche
      ((= 3 (car gr))
(setq ent    (nentselp pt)
      result (cond
	       ((null ent) nil)
	       ((= (length ent) 2) ent)
	       (T (list (last (last ent)) pt))
	     )
      break T
)
      )
      ;; validation par Entrée
      ((equal gr '(2 13))
 (setq result str
       break T
 )
      )
      ;; validation par espace
      ((and (not cr) (equal gr '(2 32)))
 (setq result str
       break T
 )
      )
      ;; récupération des entrées au clavier
      (T
(if (= (cadr gr) 8) ;_ 8 = retour/effacer
  (or
    (and str
	 (/= str "")
	 (setq str (substr str 1 (1- (strlen str))))
	 (princ (chr 8))
	 (princ (chr 32))
    )
    (setq str nil)
  )
  (or
    (and str (setq str (strcat str (chr (cadr gr)))))
    (setq str (chr (cadr gr)))
  )
)
(and str (princ (chr (cadr gr)))) ;_ affichage sur la ligne de commande
      )
    )
 )
 result
)

(gile) · le 24 mars 2020

Un truc plus spécifique qui vérifie que l'entité sélectionnée est bien un bloc ou que le nom entré est bien celui d'un bloc du dessin.

Je te laisse l'adapter.

(defun getblock	(msg / break result gr pt ent str)
 (prompt msg)
 (while
   (and (not break) (setq gr (grread T 4 2)))
    (cond
      ;; récupération du point sous le curseur
      ((= (car gr) 5)
(setq pt (cadr gr))
      )
      ;; clic gauche
      ((= 3 (car gr))
(setq ent (nentselp pt)
)
(cond
  ((null ent)
   (setq break T)
  )
  ((= (length ent) 2)
   (prompt "\nL'objet sélectionné n'est pas un bloc.")
  )
  (T
   (setq result	(list (last (last ent)) pt)
	 break	T
   )
  )
)
      )
      ;; validation par Entrée ou Espace
      ((or (equal gr '(2 13)) (equal gr '(2 32)))
(if (tblsearch "block" str)
  (setq	result str
	break T
  )
  (progn
    (prompt (strcat "\nLe bloc '" str "' est introuvable.\n" msg))
    (setq str nil)
  )
)
      )
      ;; récupération des entrées au clavier
      (T
(if (= (cadr gr) 8) ;_ 8 = retour/effacer
  (or
    (and str
	 (/= str "")
	 (setq str (substr str 1 (1- (strlen str))))
	 (princ (chr 8))
	 (princ (chr 32))
    )
    (setq str nil)
  )
  (or
    (and str (setq str (strcat str (chr (cadr gr)))))
    (setq str (chr (cadr gr)))
  )
)
(and str (princ (chr (cadr gr)))) ;_ affichage sur la ligne de commande
      )
    )
 )
 result
)

Bred · le 24 mars 2020

grread !!!

bien sûr.

... complétement oublier son existence... quand on manipule plus on perd vite.

Merci (gile), et comme d'habitude, tu penses déjà à plein de truc dans ta routine (... le coup de l'espace dans la chaine par exemple).

Luna · le 25 mars 2020

Bonjour,

J'avais en effet pas penser à la fonction (grread) dans une boucle (while) pour reconstituer la chaîne de caractère, c'est très ingénieux !!

Cependant, je ne comprend pas très bien pourquoi définir le premier argument de (grread) sur t (enfin VRAI quoi) parce que du coup, l'utilisateur n'a aucune saisi possible !--"

Il renvoie automatiquement la localisation du pointeur avec une paire pointée suivant le code 5, alors qu'en désactivant l'argument track (= nil), l'utilisateur a la main et peux rentrer une chaîne de caractères, valider ou cliquer sur un point (en gros, il peut bouger la souris et accéder à son clavier)

Après je n'ai pas tester ton programme personnellement, c'est uniquement sur l'utilisation isolée de (grread) dont je me souviens...

Bisous,

Luna

Bred · le 25 mars 2020

Ah, zut, bug.

Si il y a un ssget avant la fonction ça plante... j'essaye d'en comprendre la raison, mais je n'y arrive pas.

(defun c:tt (/ ent)
 (ssget)
 (setq ent (getstringorentity t "\n Entrez un nom ou Sélectionnez : "))
   )

Entrez un nom ou Sélectionnez : ; erreur: type d'argument incorrect: fixnump: (-4.67679 5.50782 0.0)

(gile) · le 25 mars 2020

Ah, zut, bug.

Si il y a un ssget avant la fonction ça plante... j'essaye d'en comprendre la raison, mais je n'y arrive pas.
(defun c:tt (/ ent)
 (ssget)
 (setq ent (getstringorentity t "\n Entrez un nom ou Sélectionnez : "))
   )

Je n'arrive pas à reproduire cette erreur avec le code de getstringorentity ci dessus. peux-tu préciser la version d'AutoCAD ?

As tu essayé de localiser l'erreur avec "Arrêt sur erreur" ?

Bred · le 25 mars 2020

testé sur 2014 et 2018

Source dernière interuption :

(defun getstringorentity (cr msg / break result gr pt ent str)

(prompt msg)

(while

(and (not break) (setq gr (grread t 4 2)))

(cond

;; récupération du point sous le curseur

((= (car gr) 5)

(setq pt (cadr gr))

)

;; clic gauche

((= 3 (car gr))

(setq ent (nentselp pt)

result (cond

((null ent) nil)

((= (length ent) 2) ent)

(T (list (last (last ent)) pt))

)

break T

)

;; validation par Entrée

((equal gr '(2 13))

(setq result str

break T

)

;; validation par espace

((and (not cr) (equal gr '(2 32)))

(setq result str

break T

)

;; récupération des entrées au clavier

(T

(if (= (cadr gr) 8) ;_ 8 = retour/effacer

(or

(and str

(/= str "")

(setq str (substr str 1 (1- (strlen str))))

(princ (chr 8))

(princ (chr 32))

)

(setq str nil)

)

(or

(and str (setq str (strcat str (chr (cadr gr)))))

(setq str (chr (cadr gr)))

)

(and str (princ (chr (cadr gr)))) ;_ affichage sur la ligne de commande

)

result

)

Luna · le 25 mars 2020

C'est que la fonction (grread) a du renvoyer un code 12 (voir Aide), que renvoie un espion sur ta variable gr au moment de l'erreur ?

Donc peut être ajouter une vérification plus poussée pour filtrer les codes non utiles à ta fonction ?

Bisous,

Luna

(gile) · le 25 mars 2020

Quand tu es dans l'arrêt sur erreur, que vaut gr ? ou plus précisément (car gr) ?

(gile) · le 25 mars 2020

Bonjour,

J'avais en effet pas penser à la fonction (grread) dans une boucle (while) pour reconstituer la chaîne de caractère, c'est très ingénieux !!
Cependant, je ne comprend pas très bien pourquoi définir le premier argument de (grread) sur t (enfin VRAI quoi) parce que du coup, l'utilisateur n'a aucune saisi possible !--"
Il renvoie automatiquement la localisation du pointeur avec une paire pointée suivant le code 5, alors qu'en désactivant l'argument track (= nil), l'utilisateur a la main et peux rentrer une chaîne de caractères, valider ou cliquer sur un point (en gros, il peut bouger la souris et accéder à son clavier)

Après je n'ai pas tester ton programme personnellement, c'est uniquement sur l'utilisation isolée de (grread) dont je me souviens...

Bisous,
Luna

J'ai fait ça vite fait à partir d'un code qui montre différentes utilisations de grread (ici).

Mais tu as raison on peut mettre le premier argument à nil et ne pas s'occuper du groupe 5. Par contre, le fait de le mettre à T n'empêche aucunement les saisies au clavier.

Une version un peu plus robuste (on ne prend les entrées au clavier que pour le code 2):

;; getstringorentity
;; Invite l'utilisateur à  entrer une chaîne ou sélectionner une entité.
;; Renvoie la chaîne entrée, une liste semblable à celle revoyée par (entsel) ou nil.
;;
;; Arguments
;; cr  : si non nil, accepte les espaces dans la chaîne comme (getstring)
;; msg : message d'invite
(defun getstringorentity (cr msg / break result gr pt ent str)
 (prompt msg)
 (while
   (and (not break) (setq gr (grread nil 12 2)))
    (cond
      ;; clic gauche
      ((= 3 (car gr))
(setq ent    (nentselp (cadr gr))
      result (cond
	       ((null ent) nil)
	       ((= (length ent) 2) ent)
	       (T (list (last (last ent)) (cadr gr)))
	     )
      break  T
)
      )
      ;; validation par Entrée
      ((equal gr '(2 13))
(setq result str
      break T
)
      )
      ;; validation par espace
      ((and (not cr) (equal gr '(2 32)))
(setq result str
      break T
)
      )
      ;; récupération des entrées au clavier
      ((= 2 (car gr))
(if (= (cadr gr) 8) ;_ 8 = retour/effacer
  (or
    (and str
	 (/= str "")
	 (setq str (substr str 1 (1- (strlen str))))
	 (princ (chr 8))
	 (princ (chr 32))
    )
    (setq str nil)
  )
  (or
    (and str (setq str (strcat str (chr (cadr gr)))))
    (setq str (chr (cadr gr)))
  )
)
(and str (princ (chr (cadr gr)))) ;_ affichage sur la ligne de commande
      )
    )
 )
 result
)

Bred · le 25 mars 2020

Quand tu es dans l'arrêt sur erreur, que vaut gr ? ou plus précisément (car gr) ?

(cadr gr) = (1.13884 -0.333956 0.0)

.... donc (chr (cadr gr)) plante forcément

J'ai remplacé par car (tu t'es auto-corrigé dans ta question !) les deux (chr (cadr ...) qui se suivent....

... sauf que l'appel au clavier ne fonctionne plus (ce n'est plus un message d'erreur, c'est un "gel")

Bred · le 25 mars 2020

.... pas "l'appel au clavier" mais la possibilité de rentrer une chaine à la question.

(gile) · le 25 mars 2020

La dernière version que j'ai posté devrait résoudre ce problème en ne prenant que les code 2 pour les entrées au clavier.

Bred · le 25 mars 2020

J'ai trouvé ce qui cloche : je valide avec le clic droit !... (je suis un vieux)...

(gile) · le 25 mars 2020

J'ai trouvé ce qui cloche : je valide avec le clic droit !... (je suis un vieux)...

Même quand tu entres une chaîne au clavier ?

On peut capturer le clic droit comme validation :

remplace :

       ;; validation par Entrée
      ((equal gr '(2 13))
(setq result str
      break T
)
      )

par :

       ;; validation par Entrée ou clic droit
      ((or (equal gr '(2 13))
    (member(car gr) '(12 25))
    )
(setq result str
      break T
)
      )

Bred · le 25 mars 2020

... la version "plus robuste" fonctionne avec la validation clic droit... (je pige pas)

Bred · le 25 mars 2020

.. et non, je ne valide pas par clic droit quand je rentres une chaine au clavier, mais l'erreur precedente était dû par le clic droit.

Là, ça à l'air de fonctionner nickel.

Merci !

Connexion

Besoin d'un "entsel / getstring"

Messages recommandés

Bred

Luna

DenisHen

Bred

Luna

Bred

Luna

(gile)

(gile)

Bred

Luna

Bred

(gile)

Bred

Luna

(gile)

(gile)

Bred

Bred

(gile)

Bred

(gile)

Bred

Bred

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante