Cherche LSP pour incrementer un Attr existant dans N Blocs differents deja inseres

[lecrabe]

Hello

 

Je dois etre fatigue ce matin !?

 

J ai de nombreuses routines US et French pour incrementer des textes et/ou inserer de nouveaux blocs avec incrementation d un attribut ...

MAIS A PRIORI aucune ne correspond a mon besoin specifique !

 

En fait j ai besoin de selectionner visuellement un ATTR (ou de donner son Etiquette d Attr au clavier)

puis de selectionner N Blocs STATIQUES OU DYNAMIQUES (eventuellement DIFFERENTS) mais ayant TOUS ce fameux Attr

Question Prefixe eventuel ?

Question Suffixe eventuel ?

Question Valeur Depart (Defaut = 1) ?

Question Increment/Pas (Defaut = 1) ? 

TRAITEMENT ...

 

SVP si quelqu un a la bonne routine, je suis preneur ! 

 

Merci d avance, Bonne semaine, Bye, lecrabe

 

 

[Luna]

Coucou @lecrabe 

Je présume que la différence avec les programmes déjà existants c'est de ne pas considérer le nom du bloc comme une valeur de référence.

Tout ce qui t'intéresse c'est de filtrer les blocs qui possèdent un attribut portant toujours le même nom, peu importe le nom du bloc. 

Si c'est le cas, je vais voir ce que je peux sortir (mais chat ne sera pas au niveau d'un GILE_INCR ou autre évidemment 

Bisous, Luna

[lecrabe]

Hello @Luna

OUI c bien le probleme ... Traiter N blocs differents DEJA inseres ayant le fameux attribut en commun (que l on ECRASE !)

BON en attendant j ai trouve un Lisp "AutoTag_Attr" (que j ai un poil bricole) qui resoud en partie mon probleme !

Mais il faudrait l ameliorer un peu !?

1) Le securiser sur la selection : que des Blocs (INSERT) Facile

2) Traiter N Blocs STATIQUES ET DYNAMIQUES ET DIFFERENTS

3) Mettre toutes les questions que j ai prevues - Il y en a deja 2 + Avec des valeurs par defaut qui marchent ...

2  questions manquantes : le Pas/Increment et le Suffixe

J espere que cette base te convient !?

Et si on pouvait soit Cliquer sur l Attribut concerne OU donner son nom, ca serait Top !?

Merci, Bye, lecrabe

 

;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/auto-populate-of-block-attributes-with-incremental-series-number/m-p/11597317
;;
;; Routine: AutoTag_Attr by hak_vz
;;

(vl-load-com) 

(defun c:AutoTag_Attr (/ LM:vl-setattributevalue ssBlock intIncrement startValue prefixValue objBlock attrtag) 

	(defun LM:vl-setattributevalue ( blk tag val )
		(setq tag (strcase tag))
		(vl-some
		   '(lambda ( att )
				(if (= tag (strcase (vla-get-tagstring att)))
					(progn (vla-put-textstring att val) val)
				)
			)
			(vlax-invoke blk 'getattributes)
		)
	) 

	(setq ssBlock (ssget)) 

        (setq attrtag "XXX") 
	(setq intIncrement 0)
        (setq startValue 1) 
        (setq prefixValue "")

   (princ "\n------ ATTENTION : No Error Management ! ------ ")
   (princ "\nSo please select ONLY right Blocks and give the Start Value ! ")

   (setq attrtag (getstring T "\nPlease EXACT Name for the Attribute to increment : ")) 

	(setq startValue (getint "\nSpecify Start Value : ")
		   prefixValue (strcase (getstring t "\nSpecify Prefix : ")))

	(repeat (sslength ssBlock)
	  (setq objBlock (vlax-ename->vla-object (ssname ssBlock intIncrement)))
	  (LM:vl-setattributevalue objBlock attrtag (strcat prefixValue (rtos startValue 2 0)))
	  (setq startValue (1+ startValue))
	  (setq intIncrement (1+ intIncrement))
	) 

	(princ) 
) 

 

[Luna]

@lecrabe,
Je viens de remarquer un truc qui pourrait être utile d'un point de vue information : comment dois-je "trier" la sélection des blocs pour incrémenter la valeur suivant un ordre désiré ? Car avec un (ssget), difficile de savoir quel bloc doit être à 1, puis à 2, etc... ^^
Donc faut-il prévoir un tri graphique ? Un tri manuel, donc pas de (ssget) mais un (entsel) dans une boucle (while) par exemple ? Pas de tri et l'utilisateur croise les doigts ?

Tu ne m'en voudras pas trop j'espère mais j'ai préféré partir sur une base saine à partir de mes fonctions persos et j'ai ajouter un peu d'ergonomie pour les utilisateurs 🙂
Je posterais le programme une fois que je saurais comment trier mes blocs pour une incrémentation désirée par l'utilisateur !

Bisous, Luna

[lecrabe]

Hello @Luna

1) MERCI de ton interet et de ton travail pour moi !

2) Soit les gens selectionnent les Blocs UN par UN et ce sera bien sur l ordre de traitement 

-- Soit ils font une grosse selection globale (par Fenetre ou autre) et on traite dans l ordre d'arrivee des Blocs ...

En principe ZERO probleme de tri !?

Bye, lecrabe

 

[Luna]

oki doki je vois.
Je vais voir chat alors

[Luna]

Coucou,
Bon je n'ai pas vraiment le temps de le tester, je verrais chat demain 🙂

(defun c:ATTINCR (/ lst2str str2lst getkdh LgT LM:vl-setattributevalue break att val pas pre suf mode jsel i name)
  (vl-load-com)
  (defun lst2str (lst sep)
    (if lst
      (vl-string-left-trim
        sep
        (apply
          'strcat
          (mapcar '(lambda (x) (strcat sep (vl-princ-to-string x))) lst)
        )
      )
    )
  )
  (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 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) (""))))
      (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)))
          (cond
            ( (listp hlp) (eval hlp))
            ((princ hlp))
          )
        )
        (setq val (get msg))
      )
    )
    val
  )
  (defun LgT (en fr)
    (if (= (getvar "LOCALE") "FR")
      fr 
      en
    )
  )
  (defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
        (if (= tag (strcase (vla-get-tagstring att)))
          (progn (vla-put-textstring att val) val)
        )
      )
      (vlax-invoke blk 'getattributes)
    )
  )

  (if (not *AttI-Tag*) (setq *AttI-Tag* "XXX"))
  (if (not *AttI-Val*) (setq *AttI-Val* 1))
  (if (not *AttI-Pas*) (setq *AttI-Pas* 1))
  (while (not break)
    (setq att
      (getkdh
        (quote (nentsel msg))
        (LgT
          "\nPlease select an attribute or"
          "\nVeuillez sélectionner un attribut ou"
        )
        (list (LgT "Name eXit _Name eXit" "Nommer Quitter _Name eXit"))
        " : "
        "Name"
        nil
      )
    )
    (cond
      ( (= "eXit" att) (setq break T))
      ( (= "Name" att)
        (cond
          ( (= "" (setq att (getstring (strcat (LgT "\nSpecify the tag name <" "\nRenseignez le nom d'étiquette <") *AttI-Tag* "> : "))))
            (setq att *AttI-Tag*)
          )
          (att)
        )
        (setq break T)
      )
      ( (and
          (listp att)
          (setq att (car att))
          (= "ATTRIB" (cdr (assoc 0 (entget att))))
        )
        (setq att (cdr (assoc 2 (entget att))))
        (setq break T)
      )
      ( T
        (princ (LgT "\nError on selection, try again please..." "\nErreur lors de la sélection, veuillez réessayer..."))
      )
    )
  )
  (and
    att
    (setq *AttI-Tag* att)
    (not (setq break nil))
    (while (not break)
      (princ
        (strcat
          (LgT "\nStep = " "\nPas = ") (itoa (cond (pas) (*AttI-Pas*)))
          (LgT " | Prefix = \"" " | Préfixe = \"") (cond (pre) ("")) "\""
          (LgT " | Suffix = \"" " | Suffixe = \"") (cond (suf) ("")) "\""
        )
      )
      (setq val
        (getkdh
          (quote (getint msg))
          (LgT "\nStarting value" "\nValeur de départ")
          (list (LgT "steP prEfix sUffix _steP prEfix sUffix" "Pas prEfixe sUffixe _steP prEfix sUffix"))
          " : "
          *AttI-Val*
          nil
        )
      )
      (cond
        ( (= "steP" val)
          (setq pas (getkdh (quote (getint msg)) (LgT "\nSpecify the step" "\nSpécifiez le pas") (list 2) " : " (itoa *AttI-Pas*) nil))
        )
        ( (= "prEfix" val) (setq pre (getstring T (LgT "\nPrefix <> : " "\nPréfixe <> : "))))
        ( (= "sUffix" val) (setq suf (getstring T (LgT "\nSuffix <> : " "\nSuffixe <> : "))))
        ( (numberp val)
          (setq
            pas (cond (pas) (*AttI-Pas*)) *AttI-Pas* pas
            pre (cond (pre) (""))
            suf (cond (suf) (""))
            *AttI-Val* val
            break T
          )
        )
      )
    )
    (setq n 0)
    (setq mode
      (getkdh
        (quote (getkword msg))
        (LgT "\nSelection mode" "\nMode de sélection")
        (list (LgT "Auto Manual _Auto Manual" "Auto Manuel _Auto Manual"))
        " : "
        "Manual"
        nil
      )
    )
    (cond
      ( (and (= "Auto" mode) (setq jsel (ssget '((0 . "INSERT") (66 . 1)))))
        (repeat (setq i (sslength jsel))
          (setq name (ssname jsel (setq i (1- i))))
          (if (LM:vl-setattributevalue (vlax-ename->vla-object name) att (strcat pre (itoa val) suf))
            (setq
              val (+ val pas)
              n (1+ n)
            )
          )
        )
        T
      )
      ( (and (= "Manual" mode) (not (setq break nil)))
        (while (not break)
          (princ (strcat (LgT "\nTag = " "\nEtiquette = ") (strcase att)))
          (setq name
            (getkdh
              (quote (entsel msg))
              (LgT "\nPlease select a block with attributes" "\nVeuillez sélectionner un bloc avec attribut")
              (list (LgT "eXit _eXit" "Quitter _eXit"))
              " : "
              "eXit"
              nil
            )
          )
          (cond
            ( (= "eXit" name) (setq break T))
            ( (and
                (listp name)
                (setq name (car name))
                (= "INSERT" (cdr (assoc 0 (entget name))))
                (= 1 (cdr (assoc 66 (entget name))))
              )
              (if (LM:vl-setattributevalue (vlax-ename->vla-object name) att (strcat pre (itoa val) suf))
                (setq
                  val (+ val pas)
                  n (1+ n)
                )
              )
            )
            ( T (princ (LgT "\nError on selection, try again please..." "\nErreur lors de la sélection, veuillez réessayer...")))
          )
        )
        T
      )
    )
    (princ
      (strcat
        (LgT "\nA total of " "\nUn total de ")
        (itoa n)
        (LgT " block has been modified succesfully..." " blocs ont été modifiés avec succès...")
      )
    )
  )
  (princ)
)

Le défaut que j'ai constaté c'est la réinitialisation des préfixes/suffixes à une valeur nulle (en raison de la valeur par défaut qui empêche de considérer un string vide). Et je testé très vite fait, chat semble fonctionnel mais je suis persuadée que je me suis emmêlée les pinceaux ^^"

MOD : Modification du code pour une valeur par défaut de préfixe/suffixe = ""

Bisous,
Luna

Modifié le 6 février par Luna
correction du code : suppression des variables *AttI-Pre* et *AttI-Suf*

[Steven]

Salut Luna @Luna,

Je viens de tester ton Lisp ... Nickel 👍

Cependant, lorsqu'on a défini un préfixe ou un suffixe, comment fait-on lorsqu'on ne souhaite plus en mettre ?

J'ai mis un espace lorsque je ne souhaite plus de préfixe ou de suffixe mais le soucis est que ça crée un espace ou deux

selon qu'on a supprimé un préfixe et un siffixe, dans la valeur de l'attribut.

Par conséquent, y a-t-il un moyen de supprimer le préfixe et le suffixe sans devoir mettre un espace ?

[Luna]

Coucou @Steven,

Yes c'est justement le problème dont je faisais mention. Le problème c'est que (getstring) ne prend pas en compte les mots clés, et je n'ai pas d'AutoCAD sous la main présentement pour vérifier si un (getkword) initialisé avec le bit 7 de (initget) permet de renseigner une chaîne de caractères contenant des espaces ou non.

Une autre solution serait de supprimer la valeur par défaut pour les préfixes et suffixes, permettant ainsi de considérer une chaîne de caractères vide comme une valeur acceptable pour les préfixes et suffixes (équivalent donc à la suppression de ces derniers).

Merci pour les retours en tout cas :3

Bisous, Luna

[lecrabe]

Hello @Luna 

SVP tu fais au plus SIMPLE ...

Pour moi, il est evident que Par Defaut : Prefixe et Suffixe sont VIDES !

Si on relance la Routine, TANT PIS si on doit resaisir la meme valeur de Prefixe / Suffixe 

Par defaut : Valeur Depart = 1 et Valeur Increment = 1

MERCI, Bye, lecrabe

 

[Luna]

@lecrabe , @Steven,
J'ai corrigé le code (ci-dessus) pour prendre une valeur par défaut des préfixes/suffixes à "".

Bisous,
Luna

[Steven]

il y a 49 minutes, Luna a dit :

@lecrabe , @Steven,
J'ai corrigé le code (ci-dessus) pour prendre une valeur par défaut des préfixes/suffixes à "".

Bisous,
Luna

Salut @Luna,

 

Carrément Tip-Top 👍‍

Puis il fonctionne aussi avec AutoCAD LT 2024 😃

[Luna]

Si jamais, je n'ai pas ajouté de messages d'aide pour les (getkdh) mais c'est possible d'en ajouter au besoin : il suffit juste de remplacer le dernier nil par une chaîne de caractères expliquant chaque option ou bien d'utiliser la fonction (LgT) pour avoir l'aide en anglais ou en français en fonction de la variable "LOCALE".

Je ne suis pas fan de celui-là mais au moins il fait le job ^^'

Bisous,
Luna

[lecrabe]

Hello @Luna

Merci beaucoup... 

Belle annee 2024 et La Santé, Bye, lecrabe