[LISP/Diesel ou Full Lisp] Renommer des onglets et des folios dans un cartouche automatiquement

JPhil · le 5 février 2021

Bonjour à toutes et tous,

Programme double (Lisp et Diesel) qui permet de renommer totomatiquement les folios d'un cartouche.

Idéal pour un carnet contenant plusieurs dizaines de folios.

[01/07/2021] Mise à jour en full lisp 🙂, voir plus bas.

Pour renommer les onglets il faut utiliser ce lisp suivant dont la source est >>> ici <<< :

Les modifications sont :

    (setq nb (itoa (length (layoutlist))))
         (if (< (strlen nb) 2)
           (setq nb (strcat "0" nb))
         )
   (setq pre "Folio"
         suf (strcat "-" nb)
         lyn (list (strcase pre))
   )

à la place de :

    (setq pre (validstring "\nSpecify prefix <none>: ")
         suf (validstring "\nSpecify suffix <none>: ")
         lyn (list (strcase pre))

Le lisp :

;; Renumber Layouts  -  Lee Mac
;; Sequentially numbers all Paperspace layouts, with an optional prefix & suffix.

(defun c:rl ( / int lst lyn ord pre sed suf )

   ;; Obtain a valid (optional) prefix & suffix
;;;    (setq pre (validstring "\nSpecify prefix <none>: ")
;;;          suf (validstring "\nSpecify suffix <none>: ")
;;;          lyn (list (strcase pre))


   (setq nb (itoa (length (layoutlist))))
         (if (< (strlen nb) 2)
           (setq nb (strcat "0" nb))
         )
   (setq pre "Folio"
         suf (strcat "-" nb)
         lyn (list (strcase pre))
   )

   ;; Obtain list of layout objects, current names, and sort index
   (vlax-for lyt (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
       (if (= :vlax-false (vla-get-modeltype lyt))
           (setq lst (cons lyt lst)
                 lyn (cons (strcase (vla-get-name lyt)) lyn)
                 ord (cons (vla-get-taborder lyt) ord)
           )
       )
   )

   ;; Construct a unique seed for temporary renaming
   (setq sed "%")
   (while (vl-some '(lambda ( x ) (wcmatch x (strcat "*" sed "*"))) lyn)
       (setq sed (strcat sed "%"))
   )

   ;; Temporarily rename layouts to ensure no duplicate keys when renumbering
   (setq int 0)
   (foreach lyt lst
       (vla-put-name lyt (strcat sed (itoa (setq int (1+ int)))))
   )

   ;; Rename layouts in tab order, with prefix & suffix
   (setq int 0)
   (foreach idx (vl-sort-i ord '<)
       (vla-put-name (nth idx lst) (strcat pre (padzeros (itoa (setq int (1+ int))) 2) suf))
   )
   (princ)
)

(defun padzeros ( str len )
   (if (< (strlen str) len) (padzeros (strcat "0" str) len) str)
)

(defun validstring ( msg / rtn )
   (while
       (not
           (or
               (= "" (setq rtn (getstring t msg)))
               (snvalid rtn)
           )
       )
       (princ (strcat "\nThe name cannot contain the characters \\<>/?\":;*|,=`"))
   )
   rtn
)

(vl-load-com) (princ)

Le lisp va créer le mot "Folio", suivi du numéro de l'onglet en cours en fonction de sa place, suivi du séparateur "-", suivi du nombre total d'onglets.

Il n'est pas possible de rajouter un espace et/ou le séparateur "/" dans le nom de l'onglet -> trop facile sinon <_<

Pour renommer le numéro de folio dans le cartouche, il faut créer un champ dans l'attribut folio en prenant l'expression Diesel, et y mettre ceci :

$(upper,$(substr,$(getvar,ctab),1,5)) $(substr,$(getvar,ctab),6,$(if,$(eq,$(substr,$(getvar,ctab),8,1),"-"),2,$(if,$(eq,$(substr,$(getvar,ctab),9,1),"-"),3)))/$(substr,$(getvar,ctab),$(if,$(eq,$(substr,$(getvar,ctab),$(-,$(strlen,$(getvar,ctab)),2),1),"-"),$(+,1,$(-,$(strlen,$(getvar,ctab)),2)),$(+,1,$(-,$(strlen,$(getvar,ctab)),3))))

L'expression Diesel va mettre le mot "Folio" tout en majuscule, puis va créer un espace, puis va mettre le numéro du folio en cours, puis va transformer le séparateur "-" en séparateur "/", puis va mettre le nombre total de folio.

Le nom de l'onglet sera : "Folio01-99" ou "Folio50-200" ou "Folio701-800"

Le numéro de folio dans le cartouche sera "FOLIO 01/99" ou "FOLIO 50/200" ou "FOLIO 701/800"

Si vous déplacez, supprimez, ou rajoutez un onglet, relancer le lisp pour mettre à jour.

Le lisp fonctionne très bien sur un carnet existant contenant plusieurs onglets.

L'expression Diesel est à utiliser dés le début de la conception d'un carnet de folio pour plus de facilité 🙂

Question : Est-il possible de faire un lisp qui puisse modifier l'attribut folio en y intégrant l'expression Diesel sur un carnet existant contenant plusieurs dizaines de pages ? -> à première vue plutôt compliqué :unsure:

Testé sous AutoCAD 2020

Luna · le 5 février 2021

Coucou,

Petite question : il s'agit d'un cartouche issu d'un Toolkit ? Auquel cas, il suffirait je pense d'intégrer l'expression Diesel dans l'attribut correspondant et ainsi cela pourra servir de modèle à chaque création d'un nouvel onglet...

Personnellement, je fonctionne autrement puisque nous avons des indices de plan en fonction des destinataires et information dans le plan. Donc j'utilise les infos du bloc cartouche pour renommer l'onglet AutoCAD, tandis que toi, tu utilises l'onglet AutoCAD pour renommer ton cartouche. :3

Pour modifier un cartouche existant (donc avant l'insertion modèle de l'expression Diesel dans l'attribut), je te suggère simplement de faire cela à partir d'un jeu de sélection construit en sélectionnant l'ensemble des cartouches présents dans le dessin (ssget "_X" '((0 . "INSERT") (2 . [...]))). Attention car si tes cartouches sont dynamiques, il te faudra vérifier l'effectivename du bloc.

Et ensuite, modifier pour chaque bloc, l'attribut nommé via la fonction (setpropertyvalue).

Je ne pense pas que cela soit si difficile, à moins que je n'ai pas compris la demande...

S'il te faut des exemple de prog', pas de soucis :3

Bisous, Luna

JPhil · le 5 février 2021

Hello,

En fait, dans le service où je suis on utilise le logiciel Méridian de BlueCielo.

Il inclut une tonne de fichier avec des champs automatique du style nom du fichier, nom du projeteur, du chargé d'affaire, du titre du plan ..... bref super balèze!

Là dans le cartouche AutoCAD on peut modifier le numéro du folio et un sous-titre à la mano, le reste étant automatique.

Et d'après ce que j'ai compris vaut mieux pas y mettre son nez sinon on y fout le bordel et ça c'est pas bon du tout.

Donc oui, l'idéal serait de modifier le fichier d'origine qui sert de modèle pour inclure ce champ automatique, mais pour l'instant j'y crois absolument pas à cette possibilité. Les fichiers modèles ont été créés en 2010 pour information.

Donc pour les nouveaux documents on peut intégrer l'expression Diesel puisqu'on duplique l'onglet de base pour faire notre carnet, mais pour l'existant à part faire à la mano lors d'une mise à jour je vois pas trop.

L'idée de ce "double programme" c'est dû à un collègue qui m'a dit, sur un des carnets existants que j'avais mis à jour, que le numéro des folios n'était pas bon, à savoir qu'il veut "FOLIO 10/15" plutôt que "FOLIO 10".

Bon je pense que t'as compris que pour 2/3 cartouches c'est rapide, mais sur un document existant comportant 37 folios c'est .... hum... plus long!

Comme on ne peut pas ajouter le nombre total de folio en utilisant l'expression Diesel (pas faute d'avoir chercher), j'ai donc pris le problème à l'envers en renommant l'onglet (plus facile, après avoir trouvé LE lisp qui va bien).

En plus l'avantage de ce lisp comme celui de Patrick_35 (Ron v1.01) c'est qu'il permet très facilement de mettre à jour les numéros de folios après avoir déplacer, supprimer, ou rajouter un onglet.

C'est la raison du pourquoi j'ai partagé le lisp et l'expression Diesel pour ceux qui font des carnets sous AutoCAD.

Ma question était plus vis à vis des carnets existants, puisque faire à la mano (texte basique) ou mettre le champ (expression Diesel) à la mano, au niveau temps c'est pareil.

Par contre la deuxième solution est plus intéressante pour l'avenir.

Pour l'automatisation, le nom du bloc du cartouche est "Cartouche horizontal" et l'attribut pour le numéro de folio est "NUM_F".

Je n'ai pas ouvert tous les modèles de plan, mais je ne serai pas surpris de voir "Cartouche vertical", "Cartouche A3" ....

Donc si t'as une idée de lisp, pourquoi pas.

Je vois bien l'idée de demander à l'utilisateur de cliquer sur le cartouche puis l'attribut du folio et que le programme se débrouille pour mettre à jour cet attribut sans toucher les autres.

Par contre, me vient une réflexion :mellow: .

Serait-il possible, en modifiant le lisp plus haut, d'ajouter la possibilité de modifier cet attribut ("NUM_F") sans utiliser l'expression Diesel ?

Je dis ça car quand les personnes utilisent le viewer d'Autodesk, ils ne voient pas l'information de l'expression Diesel.

Pour cette partie :

Personnellement, je fonctionne autrement puisque nous avons des indices de plan en fonction des destinataires et information dans le plan. Donc j'utilise les infos du bloc cartouche pour renommer l'onglet AutoCAD, tandis que toi, tu utilises l'onglet AutoCAD pour renommer ton cartouche. :3

Je veux bien ton lisp pour comprendre si c'est possible :)

Luna · le 5 février 2021

Oki, donc à chaque fois que tu créé, supprime ou modifie l'ordre d'un onglet, il te faut relancer la commande à chaque fois ?

Pour l'exemple, voici le programmes et les fonctions que j'utilise :

; Renomme la présentation en fonction des données paramétrées dans le cartouche de la présentation :
;--- Cette commande permet de récupérer le code projet et la phase à partir du nom du fichier DWG de la forme Cxxxx_x_x_* et l'indice projet, la planche et le titre du plan dans le cartouche
;--- On peut soit renommer la présentation active, soit l'ensemble des présentations
;--- On peut soit les renommer de manière détaillée "Cxxxx_x_xxxx-xx_*" soit de manière simplifiée "xxxx.xx"

; Modification le 04/08/2020 - ajout de l'option "Sélection" pour renommer un nombre partiel de présentations
(defun c:NAMECART (/ Choix name jsel i Code_Projet Vis_Phase Phase Ind_Projet Planche_Projet Titre_Projet layout-list layout acadDoc acadDocSummaryInfo DWG_name Explode_name Name_List DWG_Prop_Code Name)

(setq acadDoc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
      acadDocSummaryInfo (vlax-get-property acadDoc 'SummaryInfo)
      DWG_name (getvar "DWGNAME")
      Phase (substr DWG_name (+ 2 (vl-string-position (ascii "_") DWG_name)) 1)
      Code_Projet (substr DWG_name 1 5)
)
(cond
	((= Phase "S") (setq Vis_Phase "ESQ"))
	((= Phase "A") (setq Vis_Phase "APS"))
	((= Phase "E") (setq Vis_Phase "APD"))
	((= Phase "C") (setq Vis_Phase "DCE"))
	((= Phase "X") (setq Vis_Phase "EXE"))
	((= Phase "D") (setq Vis_Phase "DOE"))
	(Phase (setq Vis_Phase "Masquer"))
)
(initget "Active Toutes Sélection")
	(if (null (setq Choix (getkword "\nQuelles présentations souhaitez-vous renommer [Active/Toutes/Sélection] <Active> ? ")))
		(setq Choix "Active")
	)
	(cond
		((= Choix "Active")
			(if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 (getvar "CTAB"))))) (= (sslength jsel) 1))
				(progn
					(sssetfirst nil nil)
					(setq name (ssname jsel 0))
					(setq Name_List name
					      Att_List (Get-att-list name)
					      Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List)))
					      Planche_Projet (cdr (assoc "PLANCHE" Att_List))
					      Titre_Projet (cdr (assoc "TITRE_2" Att_List))
					)
					(if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase))))
						(setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)
					)
					(if (or 
						(= Code_Projet "[...]")
						(= Vis_Phase "Masquer")
						(= Ind_Projet "")
						(= Titre_Projet "")
						(vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*")))
					    )
						(alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation."
							       "\nCela peut provenir des éléments suivants :"
							       "\n -  Indice du plan non renseigné"
							       "\n -  Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier"
							       "\n -  Titre principal comportant des caractères non autorisés"
							       "\n     (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )"
							       "\n"
							       "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci."
							)
						)
						(progn
							(initget "Détaillé Simplifié")
							(if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer la présentation [Détaillé/Simplifié] <Détaillé> ?  ")))
								(setq Type_name "Détaillé")
							)
							(cond
								((or (and (= Type_name "Détaillé") (= (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
								     (and (= Type_name "Simplifié") (= (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet)))
								 )
									(prompt (strcat "\nLa présentation \"" (getvar "CTAB") "\" possède déjà la bonne dénomination."))
								)
								((= Type_name "Détaillé") (Set-layout-name (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
								((= Type_name "Simplifié") (Set-layout-name (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet)))
							)
						)
					)
				)
				(cond
					((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation " (getvar "CTAB") ".")))
					((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation " (getvar "CTAB") ".")))
				)
			)
		)
		((member Choix '("Toutes" "Sélection"))
			(progn
				(cond
					((= Choix "Toutes")
						(setq layout-list (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil))
					)
					((= Choix "Sélection")
						(setq layout-list (ListBox "NAMECART : Sélection des présentations"
									   "Veuillez définir la ou les présentation(s) à renommer :"
									   (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil)
									   (getvar "CTAB")
									   2
								  )
						)
					)
				)
				(initget "Détaillé Simplifié")
				(if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer les présentations [Détaillé/Simplifié] <Détaillé> ?  ")))
					(setq Type_name "Détaillé")
				)
				(foreach layout layout-list
					(if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 layout)))) (= (sslength jsel) 1))
						(progn
							(sssetfirst nil nil)
							(setq name (ssname jsel 0))
							(setq Name_List (cons name Name_List)
							      Att_List (Get-att-list name)
							      Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List)))
							      Planche_Projet (cdr (assoc "PLANCHE" Att_List))
							      Titre_Projet (cdr (assoc "TITRE_2" Att_List))
							)
							(if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase))))
								(setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)
							)
							(if (or (= Code_Projet "[...]")
								(= Vis_Phase "Masquer")
								(= Ind_Projet "")
								(= Titre_Projet "")
								(vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*")))
							    )
								(alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation \""
									       layout
									       "\"."
									       "\nCela peut provenir des éléments suivants :"
									       "\n -  Indice du plan non renseigné"
									       "\n -  Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier"
									       "\n -  Titre principal comportant des caractères non autorisés"
									       "\n     (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )"
									       "\n"
									       "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci."
									)
								)
								(cond
									((or (and (= Type_name "Détaillé") (= layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
									     (and (= Type_name "Simplifié") (= layout (strcat Ind_Projet "-" Planche_Projet)))
									 )
										(prompt (strcat "\nLa présentation \"" layout "\" possède déjà la bonne dénomination."))
									)
									((= Type_name "Détaillé") (Set-layout-name layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
									((= Type_name "Simplifié") (Set-layout-name layout (strcat Ind_Projet "-" Planche_Projet)))
								)
							)
						)
						(cond
							((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation \"" layout "\".")))
							((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation \"" layout "\".")))
						)
					)
				)
			)
		)
	)
(set-layout-pos)
(princ)

)

; Permet de récupérer la liste des présentations sous forme de liste :
;--- La fonction (Get-Layout-list) possède aucun argument

;--- Renvoie une liste composée de paire pointée avec le premier élément de la paire correspondant au nom de la présentation, le second au VLA-Object de cette présentation
(defun Get-Layout-list (/ layout layout-list)

(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
	(setq layout-list (cons (cons (vla-get-name layout) layout) layout-list))
)
(reverse layout-list)

)

; Permet de renommer une présentation sans utiliser la fonction (command) :
;--- La fonction (Set-Layout-Name) possède 2 arguments
;--- layout correspond au nom de la présentation à renommer
;--- name correspond au nouveau nom de la présentation

;--- Renvoie le nouveau nom de la présentation ou nil en cas d'échec
(defun Set-Layout-Name (layout name / layout-list)

(setq layout-list (get-layout-list))
(if (assoc layout layout-list)
	(if (not (assoc name layout-list))
		(progn
			(vla-put-name (cdr (assoc layout layout-list)) name)
			(prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\"."))
			name
		)
		(progn
			(while (assoc name layout-list)
				(cond
					((wcmatch name "* (#)")
						(setq name (strcat (substr name 1 (- (strlen name) 2)) (itoa (1+ (atoi (substr name (1- (strlen name)) 1)))) ")"))
					)
					((wcmatch name "* (##)")
						(setq name (strcat (substr name 1 (- (strlen name) 3)) (itoa (1+ (atoi (substr name (- (strlen name) 2) 2)))) ")"))
					)
					(t
						(setq name (strcat name " (2)"))
					)
				)
			)
			(vla-put-name (cdr (assoc layout layout-list)) name)
			(prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\"."))
			name
		)
	)
	(progn
		(prompt (strcat "\nLa présentation \"" layout "\" n'existe pas..."))
		(princ)
	)
)

)

; Récupère une liste de paires pointées de l'ensemble des attributs du bloc spécifié en argument et de leur valeur correspondantes :
;--- La fonction (Get-att-list) possède 1 arguments
;--- e_name correspond au nom de l'entité ciblée

;--- Renvoie une liste de paires pointées composées chacunes du nom de l'attribut et de sa valeur (ex : (("CODEPROJET" "C2244") ("N°_DESSIN" "1030 -") ("TITRE_2" "CALEPINAGE DES MODULES PV")) )

;; Modification mineure 21/09/2020
(defun Get-att-list (name / Att Att_List)

(if  (= (cdr (assoc 0 (entget name))) "INSERT")
	(setq Att_List (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke (vlax-ename->vla-object name) 'getattributes)))
	(prompt (strcat "\nErreur : Le nom d'entité spécifié ne fait pas référence à un bloc."
			"\nIl fait référence à : "
			(cdr (assoc 0 (entget e_name)))
			".\n"
		)
	)
)

)

;--- 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 calques 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)
       )
)

(defun get-init-layout-pos (/ i tabs lay-list lay Init_Pos-list)

(vl-load-com)
(setq i 0
      tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      lay-list (layoutlist)
)
(foreach lay (reverse lay-list)
	(setq Init_Pos-list (cons (cons lay (vla-get-taborder (vla-item tabs lay))) Init_Pos-list))
)
Init_Pos-list

)

(defun set-layout-pos (/ i d tabs Init_Pos lay-list lay lay-move)

(vl-load-com)
(setq i 0
      d 0
      tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      lay-list (layoutlist)
      Init_Pos (get-init-layout-pos)
)
(foreach lay lay-list
	(vla-put-taborder (vla-item tabs lay) (setq i (1+ i)))
	(if (/= (cdr (assoc lay Init_Pos)) i)
		(setq d (1+ d)
		      lay-move (cons lay lay-move)
		)
	)
)
(prompt (strcat "\nUn total de "
		(itoa (length lay-list))
		" présentations ont été prises en compte."
		"\nSur les "
		(itoa (length lay-list))
		", "
		(itoa (length lay-move))
		" présentations ont changé de position."
		"\nVoici la liste des présentations ayant été déplacé :"
		(DXF_List lay-move "\"\n  - \"" "left" t nil)
		"\n"
	)
)

)

Il manque quelques fonctions (comme Select-filter ou DXF_List) donc Select-filter, tu peux la trouver ici. Je l'utilise très souvent dans mes programmes et notamment pour la sélection de blocs dynamiques ou bien d'attributs, mais si je comprend bien, tes blocs ne sont pas dynamiques donc le code DXF 2 de ton "INSERT" correspond déjà à l'effectivename donc un simple

(ssget "_X" '((0 . "INSERT") (2 . "Cartouche*")))

devrait suffire pour ton cas.

N'étant pas du genre à commenter mes programmes correctement, je m'en excuse d'avance. :S

Dans ton cas, il peut s'avérer utile d'installer un reactor basé sur la création, modification ou suppression de l'objet présentation (je n'ai pas encore les connaissances nécessaires pour t'en donner un exemple malheureusement) autrement, je pense en effet que tu n'as pas forcément besoin d'écrire une expression DIESEL dans tes cartouches si tu dois lancer une commande à chaque présentation nouvelle ou autre. A mes yeux, un simple

(setpropertyvalue name "NUM_F" fol)

suffit parfaitement...

Avec name l'entity name de ton cartouche contenant l'attribut "NUM_F" et fol le nom de ta présentation (après avoir subit les modifications de caractères comme souhaité. Mais avec le lancement manuel de la commande, il peut s'avérer long de relancer la commande à chaque fois et de renommer toutes les présentations sans exception car il y a le nombre total affiché...

De plus, ne pas la lancer à chaque fois revient à avoir des cartouches faux à certains moments. ^^"

Es-tu à l'aise avec le langage AutoLISP (ou bien ActiveX ou Visual LISP) ? Car si ce n'est pas le cas, je pense qu'il faudra aborder le problème par étape et de le scinder en plusieurs problèmes simple au lieu de le prendre de front :3

Bisous,

Luna

JPhil · le 5 février 2021

Oki, donc à chaque fois que tu créé, supprime ou modifie l'ordre d'un onglet, il te faut relancer la commande à chaque fois ?

Actuellement, je dirais que mes collègues travaillent de cette façon lors d'un nouveau carnet :

- nouveau plan avec un seul folio (inclus cartouche et 1 fenêtre)

- modification du nom de l'onglet puis duplication de l'onglet ou duplication de l'onglet puis modification du nom de l'onglet

- modification de l'attribut folio avant ou après avoir pris connaissance du nombre total de folio

-> en fait j'en sais rien :unsure: mais ce que je sais c'est qu'ils le font à la mano.

J'ai pas l'impression qu'ils suppriment ou modifient l'ordre des onglets au moment de la création du carnet et même après.

Le lisp peut mettre à jour les numéros des folios en fonction de l'avancement du projet, je trouve que c'est un plus qui peut servir.

Donc relancer le lisp tous les 4/5 présentations ou plus en fonction de l'avancement du travail jusqu'à avoir fini me paraît pas trop déconnant, sachant qu'il est assez rare de rajouter (ou supprimer) une présentation entre deux si on a bien fait le travail.

De plus, ne pas la lancer à chaque fois revient à avoir des cartouches faux à certains moments. ^^"

Es-tu à l'aise avec le langage AutoLISP (ou bien ActiveX ou Visual LISP) ? Car si ce n'est pas le cas, je pense qu'il faudra aborder le problème par étape et de le scinder en plusieurs problèmes simple au lieu de le prendre de front :3

Dans ce service, il y a beaucoup de vérificateurs, alors ce genre de chose devrait être évité :(rires forts):

Je comprends un peu plus facilement l'AutoLISP que les autres.

Je vais regarder ton astuce pour les carnets existants (et futur aussi).

J'essaye d'apprendre à mes collègues que l'automatisation (si bien fait) peut être un plus :)

Sympa ton programme, dans mon ancien service, j'avais utilisé deux champs automatiques dans le cartouche à deux endroits :

Pour le nom du fichier un champ non modifiable basique : "Document" comme catégorie de champ, puis "Nom de fichier uniquement" avec "Afficher l'extension du fichier" -> c'est pour éviter d'avoir un fichier qui s’appelle toto.dwg avec un numéro de cartouche autre <_<

Pour l'identification du plan en Diesel, j'avais fait un mixte entre le nom du fichier autocad et le nom de l'onglet :

$(upper,$(substr,$(getvar,dwgname),1,$(-,$(strlen,$(getvar,dwgname)),$(if,$(eq,$(substr,$(getvar,dwgname),$(-,$(strlen,$(getvar,dwgname)),9),1),"-"),9,$(if,$(eq,$(substr,$(getvar,dwgname),$(-,$(strlen,$(getvar,dwgname)),8),1),"-"),14,11)))))$(substr,$(getvar,ctab),1)

L'idée est de prendre les premiers caractères du nom du fichier autocad puis de rajouter le nom de l'onglet, en sachant que dans le nom du fichier autocad il n'y a pas forcément le numéro du folio.

Bref, ça permet d'avoir un nom de fichier autocad à l'indice B, et d'avoir 2 plans à l'indice A et 1 plan à l'indice B.

J'ai fait en sorte qu'il soit évolutif en fonction du nombre de caractère du numéro de projet (ça va de 4 à 7).

Le nom du fichier autocad se résume ainsi : [Numéro projet]-[Phase]-

-[Discipline]-[Numéro du plan]-[Numéro du folio]-[indice] ou [Numéro projet]-[Phase]-[Code Géo]-[Discipline]-[Numéro du plan]-[indice]

Le nom de l'onglet du plan se résume ainsi : [Numéro du plan]-[Numéro du folio]-[indice]

L'identification du plan sur le cartouche se résume ainsi : [Numéro projet]-[Phase]-[Code Géo]-[Discipline]-[Numéro du plan]-[Numéro du folio]-[indice]

J'avais tenté de jouer avec la phase (AVP, PRO, DCE) en Diesel, mais j'ai vite abandonné à cause des mises à jour des projets.

Luna · le 18 février 2021

Coucou,

Je peux te proposer ceci :

(defun c:Layoutname (/ n e c jsel i name txt layout)

(setq i 0 e '(3.0 3.0 0.0) c '(40.0 23.0 0.0) n (if (< (setq n (length (layoutlist))) 10) (strcat "0" (itoa n)) (itoa n)))
(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
	(if (/= (vla-get-name layout) "Model") (vla-put-name layout (strcat "#" (itoa (setq i (1+ i))))))
)
(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
	(if (/= (vla-get-name layout) "Model")
		(progn
			(vla-put-name layout (setq name (strcat "Folio" (if (< (setq i (vla-get-taborder layout)) 10) (strcat "0" (itoa i)) (itoa i)) "-" n)))
			(if (and (setq jsel (ssget "_X" (list '(0 . "MTEXT") '(8 . "0") (cons 410 name) '(-4 . ">,>,=") (cons 10 (mapcar '- c e)) '(-4 . "<,<,=") (cons 10 (mapcar '+ c e)))))
				 (= (sslength jsel) 1)
				 (setq txt (ssname jsel 0))
			    )
				(entmod (subst (cons 1 (strcat "FOLIO " (vl-string-subst "/" "-" (substr name 6)))) (assoc 1 (entget txt)) (entget txt)))
			)
		)
	)
)
(princ)

)

Je ne sais pas vraiment le contexte de ton fichier mais si j'ai bien compris, cela devrait être un bon début je pense. Il faut simplement modifier le code DXF 0 et 8 si jamais ils ne correspondent pas à ton entité texte et ensuite les paramètres pour la sélection des textes (il me semble qu'ils ont une position fixe) tu as les variables c et e.

La variable c correspond aux coordonnées arrondies de ton point d'insertion du texte (pas besoin d'être précis au dixième près) et la variable e correspond à la précision de ta sélection. Par exemple sur les valeurs supposées ci-dessus, (40.0 23.0 0.0) signifie que ton point d'insertion du texte est à ces coordonnées (arrondies à l'entier) et (3.0 3.0 0.0) signifie que tu effectues une sélection à +/- 3.0 unités en X ou Y par rapport aux coordonnées (40.0 23.0 0.0).

Plus les valeurs de la variable e sont élevées et plus il y a un risque de sélectionner d'autres textes (auquel cas, les textes ne seront pas mis à jour), et inversement si les valeurs sont faibles, alors tu risques de ne pas sélectionner le texte. Il faut donc trouver le juste milieu qui fonctionne correctement avec ton fichier. A savoir que la sélection du texte peut s'effectuer même si le point d'insertion de ton texte ne se situe pas dans la zone de sélection, ce qui compte c'est l'emprise du texte (similaire au masque d'arrière-plan du texte au facteur 1.0).

Bisous,

Luna

JPhil · le 1 juillet 2021

Mise à jour en full lisp 🙂

Le programme est une compilation de deux lisp "Renumber Layouts" et "Paging" adapté à mon besoin.

Il renomme tous les onglets en "FolioXX-YY" ainsi que l'attribut des folios du cartouche en "FOLIO XX/YY".

J'ai inclus la possibilité de dire que le premier folio est une page de garde ou non.

Par contre, le numéro des folios dans le cartouche déconne quand le nombre de présentation dépasse 99 🤥. Voir dans la partie "Paging" d'où vient le problème.

Bon en même temps, le maximum de folios dans un même fichier DWG, que j'ai vu, était de 60, donc j'suis large mais si quelqu'un peut dire dire pourquoi ça déconne (et comment le résoudre) quand on dépasse les 99 folios, il est le bienvenue 😉

;; Renumber Layouts  -  Lee Mac
;; Sequentially numbers all Paperspace layouts, with an optional prefix & suffix.
;; Optional Page de Garde include

(defun RL ( / int lst lyn ord pre sed suf )
    ;; Ask for a Page de Garde
    (initget "Yes No")
    (setq pdgtab 0)
    (if
      (= (getkword "\nY'a t'il une Page de Garde ? [Yes/No] <No>: ") "Yes")
      (setq pdgtab -1)
    )

    ;; Count all tabs with or without Page de Garde
    (setq nbtab (itoa (+ pdgtab (length (layoutlist)))))
          (if (< (strlen nbtab) 2)
            (setq nbtab (strcat "0" nbtab))
          )

    ;; Prefix & suffix
    (setq pdgname "PDG"
          pre "Folio"
          suf (strcat "-" nbtab)
          lyn (list (strcase pre))
    )

    ;; Obtain list of layout objects, current names, and sort index
    (vlax-for lyt (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-modeltype lyt))
            (setq lst (cons lyt lst)
                  lyn (cons (strcase (vla-get-name lyt)) lyn)
                  ord (cons (vla-get-taborder lyt) ord)
            )
        )
    )

    ;; Construct a unique seed for temporary renaming
    (setq sed "%")
    (while (vl-some '(lambda ( x ) (wcmatch x (strcat "*" sed "*"))) lyn)
        (setq sed (strcat sed "%"))
    )

    ;; Temporarily rename layouts to ensure no duplicate keys when renumbering
    (setq int (+ 0 pdgtab))
    (foreach lyt lst
        (vla-put-name lyt (strcat sed (itoa (setq int (1+ int)))))
    )

    ;; Rename layouts in tab order, with prefix & suffix
    (setq int (+ 0 pdgtab))
    (foreach idx (vl-sort-i ord '<)
        (vla-put-name (nth idx lst) (strcat pre (padzeros (itoa (setq int (1+ int))) 2) suf))

    ;; Rename the first layout PDG if the answer of Page de Garde is Yes
        (if (= int 0)
        (vla-put-name (nth idx lst) pdgname)
        )

    )
    (princ)
)

(defun padzeros ( str len )
    (if (< (strlen str) len) (padzeros (strcat "0" str) len) str)
)

(defun validstring ( msg / rtn )
    (while
        (not
            (or
                (= "" (setq rtn (getstring t msg)))
                (snvalid rtn)
            )
        )
        (princ (strcat "\nThe name cannot contain the characters \\<>/?\":;*|,=`"))
    )
    rtn
)


(defun PAGING( / nombloc attpage attnumpage adoc numtabs atts id lay_field)

; Paramètres

(setq nombloc "Cartouche horizontal")  ; nom du bloc cartouche
(setq attpage "NUM_F")                   ; étiquette de l'attribut numéro de page

; Fin paramètres

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq lay_field 0)
  (setq id 0)
  (vlax-for lt (vla-get-layouts adoc)
        (vlax-for obj (vla-get-block lt)
        (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
                (= nombloc (vla-get-effectivename obj)) 
                (= :vlax-true (vla-get-hasattributes obj) ))
           (progn
              (setq atts (vlax-invoke obj 'getattributes))
              (foreach x atts
                   (if (= attpage (vla-get-tagstring x))
                      (progn
                         (setq lay_field (+ 1 lay_field))
                         (setq id (itoa lay_field))
                         (if (< (strlen id) 2)
                            (setq id (strcat "0" id))
                         ) ; fin if strlen id
                         (setq lay_fieldc (strcat "FOLIO " id "/" nbtab))
                         (vla-put-textstring x lay_fieldc) ; insère la mention folio x/y
                         (if (> id nbtab)
                            (vla-put-textstring x pdgname) ; insère la mention pdgname à la place de folio x/y
                         ) ; fin if id nbtab
                      ) ; fin progn
                   ) ; fin if attpage 
              ) ; fin foreach atts
           ) ; fin progn
        ) ; fin if AcDbBlockReference
        ) ; fin vlax-for obj
  ) ; fin vlax-for lt
  (princ)
) ; fin defun PAGING


(defun c:GEFPAGING()
(vl-load-com) (princ)
(RL)
(PAGING)
)

JPhil · le 2 août 2021

Mise à jour du programme qui gère plus de 100 folios et le fait qu'il n'y ait pas de bloc cartouche dans une présentation.

J'ai ajouté la question sur le fait d'afficher les "0" dans le champ folio du cartouche. Vous avez le choix entre "FOLIO 001/100" ou "FOLIO 1/100".

Avec cette mise à jour il faut compter un peu moins de 2 minutes pour 40 folios.

;; Renumber Layouts  -  Lee Mac
;; Sequentially numbers all Paperspace layouts, with an optional prefix & suffix.
;; Optional Page de Garde include

(defun RL ( / int lst lyn ord pre sed suf )

    ;; Ask for a Page de Garde
    (initget "Yes No")
    (setq pdgtab 0)
    (if
      (= (getkword "\nY'a t'il une Page de Garde ? [Yes/No] <No>: ") "Yes")
      (setq pdgtab -1)
    )
    (initget "Yes No")
    (setq savezeros 0)
    (if
      (= (getkword "\nFaire apparaitre des 0 du style 001/100 ? [Yes/No] <No>: ") "Yes")
      (setq savezeros -1)
    )


    (setq padzeros nil)

    ;; Count all tabs with or without Page de Garde
    (setq nbtab (itoa (+ pdgtab (length (layoutlist)))))

    ;; Prefix & suffix
    (setq pdgname "PDG"
          pre "Folio"
          suf (strcat "-" nbtab)
          lyn (list (strcase pre))
    )

    ;; Obtain list of layout objects, current names, and sort index
    (vlax-for lyt (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-modeltype lyt))
            (setq lst (cons lyt lst)
                  lyn (cons (strcase (vla-get-name lyt)) lyn)
                  ord (cons (vla-get-taborder lyt) ord)
            )
        )
    )

    ;; Construct a unique seed for temporary renaming
    (setq sed "%")
    (while (vl-some '(lambda ( x ) (wcmatch x (strcat "*" sed "*"))) lyn)
        (setq sed (strcat sed "%"))
    )

    ;; Temporarily rename layouts to ensure no duplicate keys when renumbering
    (setq int (+ 0 pdgtab))
    (foreach lyt lst
        (vla-put-name lyt (strcat sed (itoa (setq int (1+ int)))))
    )

    ;; Rename layouts in tab order, with prefix & suffix
    (setq int (+ 0 pdgtab))
    (foreach idx (vl-sort-i ord '<)
       (progn
       (setq int (1+ int))
       (setq padzeros (itoa int))
       (while (< (strlen padzeros) (strlen nbtab))
       (setq padzeros (strcat "0" padzeros))
       )
        (vla-put-name (nth idx lst) (strcat pre padzeros suf))

    ;; Rename the first layout PDG if the answer of Page de Garde is Yes
        (if (= int 0)
        (vla-put-name (nth idx lst) pdgname)
        )
       )
    )
    (princ)
)


(defun PAGING( / nombloc attpage attnumpage adoc numtabs atts id lay_field)
(progn
; Paramètres

   (setq nombloc "Cartouche horizontal")  ; nom du bloc cartouche
   (setq attpage "NUM_F")                   ; étiquette de l'attribut numéro de page
   (setq lstlay nil)
; Fin paramètres

   (vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      (if (/= (vla-get-name layout) "Model")
         (setq lstlay (vl-list* (vla-get-name layout) lstlay))
      )
   )
   (foreach folioname lstlay
      (progn
         (command "ctab" folioname)
         ;;; Mode espace papier
         (command "_pspace")
         ;;; Zoom
         (command "_.zoom" "_extents")
         (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 nombloc) (cons 410 folioname))))
(if ss
(progn
         (setq x (sslength ss))
         (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS (setq x (- x 1)) )) 'getattributes)
            (if (= attpage (strcase (vla-get-tagstring att)))
               (progn
                  (setq folionamenew folioname)
                  (if (wcmatch folionamenew "*olio*")
                     (setq folionamenew (vl-string-subst "OLIO " "olio" folionamenew))
                  )
                  (if (= savezeros 0)
                     (if (wcmatch folionamenew "* 0*")
                     (while (wcmatch folionamenew "* 0*")
                        (setq folionamenew (vl-string-subst " " " 0" folionamenew))
                     )
                     )
                  )
                  (if (wcmatch folionamenew "*-*")
                     (setq folionamenew (vl-string-subst "/" "-" folionamenew))
                  )
                  (vla-put-textstring att folionamenew) 
               )
            ) ; end if
         ) ; foreach
) ; fin progn if ss
) ; fin if ss
      ) ; progn
   ) ; foreach folioname lstlay
   (princ)
)
) ; fin defun PAGING



(defun c:GEFPAGING()
(vl-load-com) (princ)
(RL)
(PAGING)
)

Netparty · le 22 décembre 2021

Le 05/02/2021 à 16:22, Luna a dit :

Oki, donc à chaque fois que tu créé, supprime ou modifie l'ordre d'un onglet, il te faut relancer la commande à chaque fois ?

Pour l'exemple, voici le programmes et les fonctions que j'utilise :

; Renomme la présentation en fonction des données paramétrées dans le cartouche de la présentation :
;--- Cette commande permet de récupérer le code projet et la phase à partir du nom du fichier DWG de la forme Cxxxx_x_x_* et l'indice projet, la planche et le titre du plan dans le cartouche
;--- On peut soit renommer la présentation active, soit l'ensemble des présentations
;--- On peut soit les renommer de manière détaillée "Cxxxx_x_xxxx-xx_*" soit de manière simplifiée "xxxx.xx"

; Modification le 04/08/2020 - ajout de l'option "Sélection" pour renommer un nombre partiel de présentations
(defun c:NAMECART (/ Choix name jsel i Code_Projet Vis_Phase Phase Ind_Projet Planche_Projet Titre_Projet layout-list layout acadDoc acadDocSummaryInfo DWG_name Explode_name Name_List DWG_Prop_Code Name)

(setq acadDoc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
      acadDocSummaryInfo (vlax-get-property acadDoc 'SummaryInfo)
      DWG_name (getvar "DWGNAME")
      Phase (substr DWG_name (+ 2 (vl-string-position (ascii "_") DWG_name)) 1)
      Code_Projet (substr DWG_name 1 5)
)
(cond
	((= Phase "S") (setq Vis_Phase "ESQ"))
	((= Phase "A") (setq Vis_Phase "APS"))
	((= Phase "E") (setq Vis_Phase "APD"))
	((= Phase "C") (setq Vis_Phase "DCE"))
	((= Phase "X") (setq Vis_Phase "EXE"))
	((= Phase "D") (setq Vis_Phase "DOE"))
	(Phase (setq Vis_Phase "Masquer"))
)
(initget "Active Toutes Sélection")
	(if (null (setq Choix (getkword "\nQuelles présentations souhaitez-vous renommer [Active/Toutes/Sélection] <Active> ? ")))
		(setq Choix "Active")
	)
	(cond
		((= Choix "Active")
			(if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 (getvar "CTAB"))))) (= (sslength jsel) 1))
				(progn
					(sssetfirst nil nil)
					(setq name (ssname jsel 0))
					(setq Name_List name
					      Att_List (Get-att-list name)
					      Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List)))
					      Planche_Projet (cdr (assoc "PLANCHE" Att_List))
					      Titre_Projet (cdr (assoc "TITRE_2" Att_List))
					)
					(if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase))))
						(setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)
					)
					(if (or 
						(= Code_Projet "[...]")
						(= Vis_Phase "Masquer")
						(= Ind_Projet "")
						(= Titre_Projet "")
						(vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*")))
					    )
						(alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation."
							       "\nCela peut provenir des éléments suivants :"
							       "\n -  Indice du plan non renseigné"
							       "\n -  Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier"
							       "\n -  Titre principal comportant des caractères non autorisés"
							       "\n     (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )"
							       "\n"
							       "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci."
							)
						)
						(progn
							(initget "Détaillé Simplifié")
							(if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer la présentation [Détaillé/Simplifié] <Détaillé> ?  ")))
								(setq Type_name "Détaillé")
							)
							(cond
								((or (and (= Type_name "Détaillé") (= (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
								     (and (= Type_name "Simplifié") (= (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet)))
								 )
									(prompt (strcat "\nLa présentation \"" (getvar "CTAB") "\" possède déjà la bonne dénomination."))
								)
								((= Type_name "Détaillé") (Set-layout-name (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
								((= Type_name "Simplifié") (Set-layout-name (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet)))
							)
						)
					)
				)
				(cond
					((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation " (getvar "CTAB") ".")))
					((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation " (getvar "CTAB") ".")))
				)
			)
		)
		((member Choix '("Toutes" "Sélection"))
			(progn
				(cond
					((= Choix "Toutes")
						(setq layout-list (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil))
					)
					((= Choix "Sélection")
						(setq layout-list (ListBox "NAMECART : Sélection des présentations"
									   "Veuillez définir la ou les présentation(s) à renommer :"
									   (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil)
									   (getvar "CTAB")
									   2
								  )
						)
					)
				)
				(initget "Détaillé Simplifié")
				(if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer les présentations [Détaillé/Simplifié] <Détaillé> ?  ")))
					(setq Type_name "Détaillé")
				)
				(foreach layout layout-list
					(if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 layout)))) (= (sslength jsel) 1))
						(progn
							(sssetfirst nil nil)
							(setq name (ssname jsel 0))
							(setq Name_List (cons name Name_List)
							      Att_List (Get-att-list name)
							      Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List)))
							      Planche_Projet (cdr (assoc "PLANCHE" Att_List))
							      Titre_Projet (cdr (assoc "TITRE_2" Att_List))
							)
							(if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase))))
								(setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)
							)
							(if (or (= Code_Projet "[...]")
								(= Vis_Phase "Masquer")
								(= Ind_Projet "")
								(= Titre_Projet "")
								(vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*")))
							    )
								(alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation \""
									       layout
									       "\"."
									       "\nCela peut provenir des éléments suivants :"
									       "\n -  Indice du plan non renseigné"
									       "\n -  Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier"
									       "\n -  Titre principal comportant des caractères non autorisés"
									       "\n     (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )"
									       "\n"
									       "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci."
									)
								)
								(cond
									((or (and (= Type_name "Détaillé") (= layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
									     (and (= Type_name "Simplifié") (= layout (strcat Ind_Projet "-" Planche_Projet)))
									 )
										(prompt (strcat "\nLa présentation \"" layout "\" possède déjà la bonne dénomination."))
									)
									((= Type_name "Détaillé") (Set-layout-name layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet)))
									((= Type_name "Simplifié") (Set-layout-name layout (strcat Ind_Projet "-" Planche_Projet)))
								)
							)
						)
						(cond
							((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation \"" layout "\".")))
							((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation \"" layout "\".")))
						)
					)
				)
			)
		)
	)
(set-layout-pos)
(princ)

)

; Permet de récupérer la liste des présentations sous forme de liste :
;--- La fonction (Get-Layout-list) possède aucun argument

;--- Renvoie une liste composée de paire pointée avec le premier élément de la paire correspondant au nom de la présentation, le second au VLA-Object de cette présentation
(defun Get-Layout-list (/ layout layout-list)

(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
	(setq layout-list (cons (cons (vla-get-name layout) layout) layout-list))
)
(reverse layout-list)

)

; Permet de renommer une présentation sans utiliser la fonction (command) :
;--- La fonction (Set-Layout-Name) possède 2 arguments
;--- layout correspond au nom de la présentation à renommer
;--- name correspond au nouveau nom de la présentation

;--- Renvoie le nouveau nom de la présentation ou nil en cas d'échec
(defun Set-Layout-Name (layout name / layout-list)

(setq layout-list (get-layout-list))
(if (assoc layout layout-list)
	(if (not (assoc name layout-list))
		(progn
			(vla-put-name (cdr (assoc layout layout-list)) name)
			(prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\"."))
			name
		)
		(progn
			(while (assoc name layout-list)
				(cond
					((wcmatch name "* (#)")
						(setq name (strcat (substr name 1 (- (strlen name) 2)) (itoa (1+ (atoi (substr name (1- (strlen name)) 1)))) ")"))
					)
					((wcmatch name "* (##)")
						(setq name (strcat (substr name 1 (- (strlen name) 3)) (itoa (1+ (atoi (substr name (- (strlen name) 2) 2)))) ")"))
					)
					(t
						(setq name (strcat name " (2)"))
					)
				)
			)
			(vla-put-name (cdr (assoc layout layout-list)) name)
			(prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\"."))
			name
		)
	)
	(progn
		(prompt (strcat "\nLa présentation \"" layout "\" n'existe pas..."))
		(princ)
	)
)

)

; Récupère une liste de paires pointées de l'ensemble des attributs du bloc spécifié en argument et de leur valeur correspondantes :
;--- La fonction (Get-att-list) possède 1 arguments
;--- e_name correspond au nom de l'entité ciblée

;--- Renvoie une liste de paires pointées composées chacunes du nom de l'attribut et de sa valeur (ex : (("CODEPROJET" "C2244") ("N°_DESSIN" "1030 -") ("TITRE_2" "CALEPINAGE DES MODULES PV")) )

;; Modification mineure 21/09/2020
(defun Get-att-list (name / Att Att_List)

(if  (= (cdr (assoc 0 (entget name))) "INSERT")
	(setq Att_List (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke (vlax-ename->vla-object name) 'getattributes)))
	(prompt (strcat "\nErreur : Le nom d'entité spécifié ne fait pas référence à un bloc."
			"\nIl fait référence à : "
			(cdr (assoc 0 (entget e_name)))
			".\n"
		)
	)
)

)

;--- 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 calques 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)
       )
)

(defun get-init-layout-pos (/ i tabs lay-list lay Init_Pos-list)

(vl-load-com)
(setq i 0
      tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      lay-list (layoutlist)
)
(foreach lay (reverse lay-list)
	(setq Init_Pos-list (cons (cons lay (vla-get-taborder (vla-item tabs lay))) Init_Pos-list))
)
Init_Pos-list

)

(defun set-layout-pos (/ i d tabs Init_Pos lay-list lay lay-move)

(vl-load-com)
(setq i 0
      d 0
      tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      lay-list (layoutlist)
      Init_Pos (get-init-layout-pos)
)
(foreach lay lay-list
	(vla-put-taborder (vla-item tabs lay) (setq i (1+ i)))
	(if (/= (cdr (assoc lay Init_Pos)) i)
		(setq d (1+ d)
		      lay-move (cons lay lay-move)
		)
	)
)
(prompt (strcat "\nUn total de "
		(itoa (length lay-list))
		" présentations ont été prises en compte."
		"\nSur les "
		(itoa (length lay-list))
		", "
		(itoa (length lay-move))
		" présentations ont changé de position."
		"\nVoici la liste des présentations ayant été déplacé :"
		(DXF_List lay-move "\"\n  - \"" "left" t nil)
		"\n"
	)
)

)

Il manque quelques fonctions (comme Select-filter ou DXF_List) donc Select-filter, tu peux la trouver ici. Je l'utilise très souvent dans mes programmes et notamment pour la sélection de blocs dynamiques ou bien d'attributs, mais si je comprend bien, tes blocs ne sont pas dynamiques donc le code DXF 2 de ton "INSERT" correspond déjà à l'effectivename donc un simple

(ssget "_X" '((0 . "INSERT") (2 . "Cartouche*")))

devrait suffire pour ton cas.

N'étant pas du genre à commenter mes programmes correctement, je m'en excuse d'avance. :S

Dans ton cas, il peut s'avérer utile d'installer un reactor basé sur la création, modification ou suppression de l'objet présentation (je n'ai pas encore les connaissances nécessaires pour t'en donner un exemple malheureusement) autrement, je pense en effet que tu n'as pas forcément besoin d'écrire une expression DIESEL dans tes cartouches si tu dois lancer une commande à chaque présentation nouvelle ou autre. A mes yeux, un simple

(setpropertyvalue name "NUM_F" fol)

suffit parfaitement...

Avec name l'entity name de ton cartouche contenant l'attribut "NUM_F" et fol le nom de ta présentation (après avoir subit les modifications de caractères comme souhaité. Mais avec le lancement manuel de la commande, il peut s'avérer long de relancer la commande à chaque fois et de renommer toutes les présentations sans exception car il y a le nombre total affiché...

De plus, ne pas la lancer à chaque fois revient à avoir des cartouches faux à certains moments. ^^"

Es-tu à l'aise avec le langage AutoLISP (ou bien ActiveX ou Visual LISP) ? Car si ce n'est pas le cas, je pense qu'il faudra aborder le problème par étape et de le scinder en plusieurs problèmes simple au lieu de le prendre de front :3

Bisous,

Luna

Bonjour Luna

Je suis tombé par hasard sur ton post et m’intéresse fortement.

Dans mon cas je renomme manuellement chaque présentation quand je change l'indice de mon plan exemple : ELEC-01-A , pour l'indice suivant ELEC-01-B comment puis-je récupérer le champs " DERNIER_INDICE " de mon cartouche pour renommer automatiquement mes présentation.

Merci d'avance

Luna · le 22 décembre 2021

Coucou,

tout va dépendre de comment sont nommés tes attributs relatifs aux attributs 🙂
Je pense que le plus simple c'est de récupérer dans un premier temps la liste de tous tes attributs de ton bloc via la fonction (get-att-list) par exemple et si tes attributs relatifs aux attributs portent un nom commun genre "INDICE_A", "INDICE_B", etc... il te suffit de supprimer tous les attributs dont l'étiquette ne possède pas "INDICE_*" et tous les attributs dont leur valeur est "". Du coup il te restera uniquement la liste des attributs relatifs aux indices ayant une valeur et tu regardes le dernier attribut de la liste une fois triée dans l'ordre alphabétique à partir du nom de l'étiquette. Comme chat, tu connais le dernier indice défini dans ton cartouche. J'ai un fonctionnement dans le genre avec ma commande MODCART :

(defun C:MODCART (/ vl-all-position nth-remove laylist jsel i ind name Mod Mod_Ind Auteur att-list lst l mod-list aut-list n)

	(defun vl-all-position (x lst / i p)

		(setq i 0)
		(while (< i (length lst))
			(if (= x (nth i lst))
				(setq p (cons i p))
			)
			(setq i (1+ i))
		)
		(reverse p)

	)

	(defun nth-remove (lst tag / i)

		(setq i 0)
		(vl-remove-if '(lambda (x) (member (setq i (1+ i)) tag)) lst)

	)

	(if (setq laylist (ListBox "Commande MODCART : Sélection des présentations"
				   "Veuillez sélectionner les présentations à modifier :"
				   (DXF_List (vl-remove "TOOLKIT" (layoutlist)) nil nil t nil)
				   (getvar "CTAB")
				   2
			  )
	    )
		(progn
			(setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 (DXF_List laylist "," "right" t t))))
			      i 0
			)
			(sssetfirst nil nil)
			(initget "Reset +1 -1")
			(if (null (setq Mod (getkword "Que souhaitez-vous faire [Reset/+1/-1] <+1> ? ")))
				(setq Mod "+1")
			)
		)
	)
	(cond
		((and
		 	(= Mod "Reset")
			jsel
			(> (sslength jsel) 0)
		 )
			(while (< i (sslength jsel))
				(setq name (ssname jsel i)
				      att-list (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_[B-F],AUTEUR_[B-F]")) (/= (cdr x) ""))) (get-att-list name))
				      lst (cons (cdr (assoc 410 (entget name))) lst)
				      i (1+ i)
				)
				(if att-list
					(set-att-list name (append (list '("MODIFICATIONS_IND_A" . "CREATION DU PLAN")) (mapcar '(lambda (x) (cons (car x) "")) att-list)))
					(prompt (strcat "\nLe cartouche \"" (cdr (assoc 410 (entget name))) "\" est déjà à l'indice A."))
				)
			)
			(set-date laylist nil)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List lst "\", \"" "right" t t)
					"\" ont été redéfini à l'indice A : \"CREATION DU PLAN\"."
				)
			)
		)
		((and
			(= Mod "+1")
			jsel
			(> (sslength jsel) 0)
			(setq Mod (strcase (getstring t (strcat "\nVeuillez spécifier la modification à afficher dans " (itoa (sslength jsel)) " cartouche(s) : "))))
		 )
			(if (= "" (setq Auteur (getstring (strcat "\nVeuillez spécifier l'auteur pour cette modification <" (vlax-get-property (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) 'SummaryInfo) 'Author) "> : "))))
				(setq Auteur (vlax-get-property (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) 'SummaryInfo) 'Author))
			)
			(set-date laylist nil)
			(while (< i (sslength jsel))
				(setq name (ssname jsel i)
				      att-list (get-att-list name)
				      Mod_Ind (caar (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*")) (= (cdr x) ""))) att-list))
				      lst (cons (cons (cdr (assoc 410 (entget name))) (substr Mod_Ind (strlen Mod_Ind) 1)) lst)
				      i (1+ i)
				)
				(set-att-list name (list (cons Mod_Ind Mod) (cons (strcat "AUTEUR_" (substr Mod_Ind (strlen Mod_Ind) 1)) Auteur)))
			)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List (mapcar '(lambda (x) (strcat (car x) " (" (cdr x) ")")) lst) "\", \"" "right" t t)
					"\" ont été modifiés."
				)
			)
		)
		((and
			(= Mod "-1")
			jsel
			(> (sslength jsel) 0)
			(repeat (setq i (sslength jsel))
				(setq name (ssname jsel (setq i (1- i)))
				      att-list (cons (cons name (sort-cons (vl-remove-if-not '(lambda (x) (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_[B-F],AUTEUR_[B-F]"))) (get-att-list name)))) att-list)
				)
			)
			(setq Mod (ListBox "Commande MODCART : Sélection des modifications à retirer"
					   (strcat "Veuillez sélectionner les modifications à retirer dans " (itoa (sslength jsel)) " cartouche(s) :")
					   (DXF_List (mapcar 'cdr (vl-remove-if '(lambda (x) (or (wcmatch (strcase (car x)) "AUTEUR_*") (wcmatch (strcase (cdr x)) ""))) (apply 'append (mapcar 'cdr att-list)))) nil nil t nil)
					   0
					   2
				  )
			)
		 )
			(set-date laylist nil)
			(foreach lst att-list
				(setq name (car lst)
				      lst (cdr lst)
				      mod-list (mapcar 'cdr (vl-remove-if '(lambda (x) (wcmatch (strcase (car x)) (strcase "AUTEUR_*"))) lst))
				      aut-list (mapcar 'cdr (vl-remove-if '(lambda (x) (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*"))) lst))
				      Mod_Ind (apply 'append (mapcar '(lambda (x) (vl-all-position x mod-list)) Mod))
				      mod-list (append (nth-remove mod-list (mapcar '1+ Mod_Ind)) (progn (setq l nil) (repeat (length Mod_Ind) (setq l (cons "" l)))))
				      aut-list (append (nth-remove aut-list (mapcar '1+ Mod_Ind)) (progn (setq l nil) (repeat (length Mod_Ind) (setq l (cons "" l)))))
				      Mod_Ind "A"
				      mod-list (mapcar '(lambda (x) (cons (strcat "MODIFICATIONS_IND_" (setq Mod_Ind (Sup-Incr Mod_Ind 1))) (strcase x))) mod-list)
				      Mod_Ind "A"
				      aut-list (mapcar '(lambda (x) (cons (strcat "AUTEUR_" (setq Mod_Ind (Sup-Incr Mod_Ind 1))) (strcase x))) aut-list)
				      lst (append aut-list mod-list)
				)
				(set-att-list name lst)
				(setq att-list (get-att-list name)
				      Mod_Ind (substr (caar (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*")) (= (cdr x) ""))) att-list)) (strlen "MODIFICATIONS_IND_*") 1)
				      laylist (subst (strcat (cdr (assoc 410 (entget name))) " (" (Sup-Incr Mod_Ind -1) ")") (cdr (assoc 410 (entget name))) laylist)
				)
			)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List laylist "\", \"" "right" t t)
					"\" ont été modifiés."
				)
			)
		)
		((or (null laylist)
		     (null jsel)
		     (= (sslength jsel) 0)
		 )
			(prompt "\nErreur: Commande MODCART annulée...")
		)
		(prompt (strcat "\nAucune modification apportée pour le(s) "
				(itoa (sslength jsel))
				" cartouche(s) présents sur la/les présentation(s) \""
				(DXF_List laylist "\", \"" "right" t t)
				"\"..."
			)
		)
	)
	(princ)

)

Bisous,
Luna

Netparty · le 23 décembre 2021

Il y a 13 heures, Luna a dit :

Coucou,

tout va dépendre de comment sont nommés tes attributs relatifs aux attributs 🙂
Je pense que le plus simple c'est de récupérer dans un premier temps la liste de tous tes attributs de ton bloc via la fonction (get-att-list) par exemple et si tes attributs relatifs aux attributs portent un nom commun genre "INDICE_A", "INDICE_B", etc... il te suffit de supprimer tous les attributs dont l'étiquette ne possède pas "INDICE_*" et tous les attributs dont leur valeur est "". Du coup il te restera uniquement la liste des attributs relatifs aux indices ayant une valeur et tu regardes le dernier attribut de la liste une fois triée dans l'ordre alphabétique à partir du nom de l'étiquette. Comme chat, tu connais le dernier indice défini dans ton cartouche. J'ai un fonctionnement dans le genre avec ma commande MODCART :

(defun C:MODCART (/ vl-all-position nth-remove laylist jsel i ind name Mod Mod_Ind Auteur att-list lst l mod-list aut-list n)

	(defun vl-all-position (x lst / i p)

		(setq i 0)
		(while (< i (length lst))
			(if (= x (nth i lst))
				(setq p (cons i p))
			)
			(setq i (1+ i))
		)
		(reverse p)

	)

	(defun nth-remove (lst tag / i)

		(setq i 0)
		(vl-remove-if '(lambda (x) (member (setq i (1+ i)) tag)) lst)

	)

	(if (setq laylist (ListBox "Commande MODCART : Sélection des présentations"
				   "Veuillez sélectionner les présentations à modifier :"
				   (DXF_List (vl-remove "TOOLKIT" (layoutlist)) nil nil t nil)
				   (getvar "CTAB")
				   2
			  )
	    )
		(progn
			(setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 (DXF_List laylist "," "right" t t))))
			      i 0
			)
			(sssetfirst nil nil)
			(initget "Reset +1 -1")
			(if (null (setq Mod (getkword "Que souhaitez-vous faire [Reset/+1/-1] <+1> ? ")))
				(setq Mod "+1")
			)
		)
	)
	(cond
		((and
		 	(= Mod "Reset")
			jsel
			(> (sslength jsel) 0)
		 )
			(while (< i (sslength jsel))
				(setq name (ssname jsel i)
				      att-list (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_[B-F],AUTEUR_[B-F]")) (/= (cdr x) ""))) (get-att-list name))
				      lst (cons (cdr (assoc 410 (entget name))) lst)
				      i (1+ i)
				)
				(if att-list
					(set-att-list name (append (list '("MODIFICATIONS_IND_A" . "CREATION DU PLAN")) (mapcar '(lambda (x) (cons (car x) "")) att-list)))
					(prompt (strcat "\nLe cartouche \"" (cdr (assoc 410 (entget name))) "\" est déjà à l'indice A."))
				)
			)
			(set-date laylist nil)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List lst "\", \"" "right" t t)
					"\" ont été redéfini à l'indice A : \"CREATION DU PLAN\"."
				)
			)
		)
		((and
			(= Mod "+1")
			jsel
			(> (sslength jsel) 0)
			(setq Mod (strcase (getstring t (strcat "\nVeuillez spécifier la modification à afficher dans " (itoa (sslength jsel)) " cartouche(s) : "))))
		 )
			(if (= "" (setq Auteur (getstring (strcat "\nVeuillez spécifier l'auteur pour cette modification <" (vlax-get-property (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) 'SummaryInfo) 'Author) "> : "))))
				(setq Auteur (vlax-get-property (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) 'SummaryInfo) 'Author))
			)
			(set-date laylist nil)
			(while (< i (sslength jsel))
				(setq name (ssname jsel i)
				      att-list (get-att-list name)
				      Mod_Ind (caar (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*")) (= (cdr x) ""))) att-list))
				      lst (cons (cons (cdr (assoc 410 (entget name))) (substr Mod_Ind (strlen Mod_Ind) 1)) lst)
				      i (1+ i)
				)
				(set-att-list name (list (cons Mod_Ind Mod) (cons (strcat "AUTEUR_" (substr Mod_Ind (strlen Mod_Ind) 1)) Auteur)))
			)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List (mapcar '(lambda (x) (strcat (car x) " (" (cdr x) ")")) lst) "\", \"" "right" t t)
					"\" ont été modifiés."
				)
			)
		)
		((and
			(= Mod "-1")
			jsel
			(> (sslength jsel) 0)
			(repeat (setq i (sslength jsel))
				(setq name (ssname jsel (setq i (1- i)))
				      att-list (cons (cons name (sort-cons (vl-remove-if-not '(lambda (x) (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_[B-F],AUTEUR_[B-F]"))) (get-att-list name)))) att-list)
				)
			)
			(setq Mod (ListBox "Commande MODCART : Sélection des modifications à retirer"
					   (strcat "Veuillez sélectionner les modifications à retirer dans " (itoa (sslength jsel)) " cartouche(s) :")
					   (DXF_List (mapcar 'cdr (vl-remove-if '(lambda (x) (or (wcmatch (strcase (car x)) "AUTEUR_*") (wcmatch (strcase (cdr x)) ""))) (apply 'append (mapcar 'cdr att-list)))) nil nil t nil)
					   0
					   2
				  )
			)
		 )
			(set-date laylist nil)
			(foreach lst att-list
				(setq name (car lst)
				      lst (cdr lst)
				      mod-list (mapcar 'cdr (vl-remove-if '(lambda (x) (wcmatch (strcase (car x)) (strcase "AUTEUR_*"))) lst))
				      aut-list (mapcar 'cdr (vl-remove-if '(lambda (x) (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*"))) lst))
				      Mod_Ind (apply 'append (mapcar '(lambda (x) (vl-all-position x mod-list)) Mod))
				      mod-list (append (nth-remove mod-list (mapcar '1+ Mod_Ind)) (progn (setq l nil) (repeat (length Mod_Ind) (setq l (cons "" l)))))
				      aut-list (append (nth-remove aut-list (mapcar '1+ Mod_Ind)) (progn (setq l nil) (repeat (length Mod_Ind) (setq l (cons "" l)))))
				      Mod_Ind "A"
				      mod-list (mapcar '(lambda (x) (cons (strcat "MODIFICATIONS_IND_" (setq Mod_Ind (Sup-Incr Mod_Ind 1))) (strcase x))) mod-list)
				      Mod_Ind "A"
				      aut-list (mapcar '(lambda (x) (cons (strcat "AUTEUR_" (setq Mod_Ind (Sup-Incr Mod_Ind 1))) (strcase x))) aut-list)
				      lst (append aut-list mod-list)
				)
				(set-att-list name lst)
				(setq att-list (get-att-list name)
				      Mod_Ind (substr (caar (vl-remove-if-not '(lambda (x) (and (wcmatch (strcase (car x)) (strcase "MODIFICATIONS_IND_*")) (= (cdr x) ""))) att-list)) (strlen "MODIFICATIONS_IND_*") 1)
				      laylist (subst (strcat (cdr (assoc 410 (entget name))) " (" (Sup-Incr Mod_Ind -1) ")") (cdr (assoc 410 (entget name))) laylist)
				)
			)
			(prompt (strcat "\n"
					(itoa (sslength jsel))
					" cartouches présents sur les présentations \""
					(DXF_List laylist "\", \"" "right" t t)
					"\" ont été modifiés."
				)
			)
		)
		((or (null laylist)
		     (null jsel)
		     (= (sslength jsel) 0)
		 )
			(prompt "\nErreur: Commande MODCART annulée...")
		)
		(prompt (strcat "\nAucune modification apportée pour le(s) "
				(itoa (sslength jsel))
				" cartouche(s) présents sur la/les présentation(s) \""
				(DXF_List laylist "\", \"" "right" t t)
				"\"..."
			)
		)
	)
	(princ)

)

Bisous,
Luna

Bonjour Luna

Quand j’exécute le lisp j'ai le message d'erreur suivant : erreur: no function definition: DXF_LIST

Bonne journée

Luna · le 23 décembre 2021

c'est parfaitement normal, ce programme n'est pas adapté pour fonctionner de manière générale, donc je l'ai uniquement posté en temps qu'exemple mais pas pour être exécuter étant donné qu'il ne fonctionnera pas vraiment. Du coup il y a certaine utilisation de fonctions perso qui ne sont pas définies dans l'exemple.

Bisous,
Luna

Netparty · le 24 décembre 2021

Il y a 18 heures, Luna a dit :

c'est parfaitement normal, ce programme n'est pas adapté pour fonctionner de manière générale, donc je l'ai uniquement posté en temps qu'exemple mais pas pour être exécuter étant donné qu'il ne fonctionnera pas vraiment. Du coup il y a certaine utilisation de fonctions perso qui ne sont pas définies dans l'exemple.

Bisous,
Luna

Bonjour Luna

Pourrais-tu me guider sur ce que je dois modifier pour l'adapter à mon cas

Merci

bonne journée

Luna · le 24 décembre 2021

Et bien aucune idée, j'ai besoin d'un .dwg d'exemple avec ton cartouche et la méthode de fonctionnement souhaité, autrement je ne pourrais rien faire...

Bisous,
Luna

Netparty · le 24 décembre 2021

il y a 25 minutes, Luna a dit :

Et bien aucune idée, j'ai besoin d'un .dwg d'exemple avec ton cartouche et la méthode de fonctionnement souhaité, autrement je ne pourrais rien faire...

Bisous,
Luna

Bonjour Luna

Voici mon fichier, j'aimerai récupérer les attributs suivant du bloc : N°AFFAIRE, NIVEAU, TECHNIQUE, NUMERO, DERIND pour avoir un nom de présentation :

N°AFFAIRE-NIVEAU-TECHNIQUE-NUMERO-DERIND

Merci

Dessin2.dwg

Luna · le 24 décembre 2021

Coucou,

Ma commande NAMECART étant un peu vieillote, j'ai fait une refonte complète et déclaré 100% des fonctions localement pour son bon fonctionnement. Au début de la définition de la commande, il y a une zone de définition des paramètres utilisateur (les commentaires sont là pour aider à la situer et à la remplir correctement). Dans la version ci-dessous j'ai déjà défini les paramètres utilisateurs pour ton utilisation perso, mais si jamais le nom de ton bloc change, si tu as plusieurs nom de bloc, ou si tu souhaites changer le modèle du nom des présentations, tu suis les indications dans les commentaires pour ne pas faire de bêtises.

(defun c:NAMECART (/ ListBox lst2str SelDynBlock setLayoutName setLayoutPos AttList2Name BlockName LayoutName)
;--- Définition utilisateur pour le bon fonctionnement et l'adaptation du programme aux besoins de chacun.                                          ;
;--•  BlockName, chaîne de caractères comprise entre guillemets "" spécifiant le nom du ou des blocs servant à renommer les présentations.          ;
;           -> Les caractères spéciaux (cf. "Wild-Card Characters Reference") sont autorisés ! Utilisation de la fonction (wcmatch)                 ;
;           -> Plusieurs nom et/ou clés de recherche peuvent être spécifiés en les séparant par une virgule ","                                     ;
;           -> Ex. :  "CARTOUCHE"                                                                                                                   ;
;                     "Cartouche*"                                                                                                                  ;
;                     "A0-Paysage*Cartouche,A0-Portrait*Cartouche"                                                                                  ;
;--•  LayoutName, liste dont l'ordre et le type de chaque élément permet de servir de modèle d'appelation pour les présentations.                   ;
;           -> Ne SURTOUT PAS modifier/supprimer la fonction (quote) ni modifier le nombre et la position des parenthèses () !!!                    ;
;           -> Le nom des étiquettes d'attributs ne doivent pas être compris entre guillemet "", écrire directement le nom des étiquettes           ;
;           -> Les chaînes de caractères correspondent aux chaînes de caractères de séparation si vous désirez en mettre, tout est autorisé du      ;
;              moment que les chaînes de séparation sont entre guillemets ""                                                                        ;
;           -> Le nombre d'éléments dans la liste est libre, il peut contenir autant d'attribut que souhaité, autant de chaînes de séparation que   ;
;              souhaité et l'ordre entre les différents élément est également libre                                                                 ;
;           -> Ex. :  N°AFFAIRE "-" NIVEAU "-" TECHNIQUE "-" NUMERO "-" DERIND                                                                      ;
;                     (getvar "DWGNAME") "_" PHASE "_" Indice "-" PLANCHE "_" TITRE1 TITRE2                                                         ;
  (setq
    BlockName "CARTOUCHE" ;--•  Définition du ou des noms des blocs cartouche
    LayoutName (quote (N°AFFAIRE "-" NIVEAU "-" TECHNIQUE "-" NUMERO "-" DERIND)) ;--•  Définition de la méthode d'appelation des présentation
  )
;--- Fin de la définition des paramètres utilisateurs.                                                                                              ;
  (defun ListBox (title msg lst value flag / str2lst tmp file DCL_ID choice tlst)
    (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)
      )
    )
    (setq tmp (vl-filename-mktemp "tmp.dcl")
          file (open tmp "w")
          tlst lst
    )
    (write-line
      (strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";")
      file
    )
    (write-line
      ":edit_box{key=\"filter\";}"
      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 ":text{key=\"count\";}" file)
    (write-line "spacer;ok_cancel;}" file)
    (close file)
    (setq DCL_ID (load_dialog tmp))
    (if (not (new_dialog "ListBox" DCL_ID))
      (exit)
    )
    (set_tile "filter" "*")
    (set_tile "count" (strcat (itoa (length lst)) " / " (itoa (length lst))))
    (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
      "filter"
      "(start_list \"lst\")
      (mapcar 'add_list (setq tlst (vl-list-search $value lst)))
      (end_list)
      (set_tile \"count\" (strcat (itoa (length tlst)) \" / \" (itoa (length lst))))"
    )
    (action_tile
        "accept"
        "(or 	(= (get_tile \"lst\") \"\")
          (if (= 2 flag)
            (progn
              (foreach n (str2lst (get_tile \"lst\") \" \")
                (setq choice (cons (nth (atoi n) tlst) choice))
              )
              (setq choice (reverse choice))
            )
            (setq choice (nth (atoi (get_tile \"lst\")) tlst))
          )
        )
        (done_dialog)"
    )
    (start_dialog)
    (unload_dialog DCL_ID)
    (vl-file-delete tmp)
    choice
  )

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

  (defun SelDynBlock (BlockName sslist / jsel i name)
    (cond
      ((null sslist)
        (setq sslist (list "_X" (list '(0 . "INSERT") (cons 2 (strcat "`*U*," BlockName)))))
      )
      ((or (not (listp (last sslist))) (and (listp (last sslist)) (vl-list-length (car (last sslist)))))
        (setq sslist (append sslist (list '(0 . "INSERT") (cons 2 (strcat "`*U*," BlockName)))))
      )
      ((and (listp (last sslist)) (null (vl-list-length (car (last sslist)))))
        (setq
          sslist
            (append
              (reverse (cdr (reverse sslist)))
              (list
                (if (assoc 0 (last sslist))
                  (subst '(0 . "INSERT") (assoc 0 (last sslist)) (last sslist))
                  (append (last sslist) '((0 . "INSERT")))
                )
              )
            )
          sslist
            (append
              (reverse (cdr (reverse sslist)))
              (list
                (if (assoc 2 (last sslist))
                  (subst (cons 2 (strcat "`*U*," BlockName)) (assoc 2 (last sslist)) (last sslist))
                  (append (last sslist) (list (cons 2 (strcat "`*U*," BlockName))))
                )
              )
            )
        )
      )
    )
    (if (setq jsel (apply 'ssget sslist))
      (repeat (setq i (sslength jsel))
        (setq name (ssname jsel (setq i (1- i))))
        (if
          (not
            (and
              (= (getpropertyvalue name "ClassName") "")
              (wcmatch (getpropertyvalue name "BlockTableRecord/Name") BlockName)
            )
          )
          (ssdel name jsel)
        )
      )
    )
    jsel
  )

  (defun setLayoutName (layout str / getLayoutList ll)
    (defun getLayoutList (/ l ll)
      (vlax-for l (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
        (setq ll (cons (cons (vla-get-Name l) l) ll))
      )
      (reverse ll)
    )
    (setq ll (getLayoutList))
    (if (and (/= str layout) (assoc layout ll))
      (if (not (assoc str ll))
        (vla-put-name (cdr (assoc layout ll)) str)
        (progn
          (while (assoc str ll)
            (cond
              ((wcmatch str "* (#)")
                (setq str (strcat (substr str 1 (- (strlen str) 2)) (itoa (1+ (atoi (substr str (- (strlen str) 1) 1)))) ")"))
              )
              ((wcmatch str "* (##)")
                (setq str (strcat (substr str 1 (- (strlen str) 3)) (itoa (1+ (atoi (substr str (- (strlen str) 2) 2)))) ")"))
              )
              (T
                (setq str (strcat str " (2)"))
              )
            )
          )
          (vla-put-name (cdr (assoc layout ll)) str)
        )
      )
    )
  )

  (defun setLayoutPos (/ i l ll)
    (setq
      i 0
      ll (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (mapcar '(lambda (l) (vla-put-TabOrder (vla-item ll l) (setq i (1+ i)))) (layoutlist))
    (princ)
  )

  (defun AttList2Name (l name / attlist)
    (if
      (setq
        attlist
          (mapcar
            '(lambda (a) (cons (vla-get-tagstring a) (vla-get-textstring a)))
            (vlax-invoke (vlax-ename->vla-object name) 'getAttributes)
          )
      )
      (mapcar
        '(lambda(x)
          (if (= (type x) 'SYM)
            (if (assoc (vl-princ-to-string x) attlist)
              (cdr (assoc (vl-princ-to-string x) attlist))
              ""
            )
            (eval x)
          )
        )
        l
      )
    )
  )

  (initget "Active Toutes Sélection")
  (if (null (setq c (getkword "\nQuelle(s) présentation(s) souhaitez-vous rennomer [Active/Toutes/Sélection] <Active> ? ")))
    (setq c "Active")
  )
  (cond
    ((= c "Active") (setq ll (list (getvar "CTAB"))))
    ((= c "Toutes") (setq ll (layoutlist)))
    ((= c "Sélection")
      (setq
        ll
          (ListBox
            "Sélection des présentations"
            "Veuillez sélectionner une ou plusieurs présentation :"
            (vl-sort (layoutlist) '<)
            (getvar "CTAB")
            2
          )
      )
    )
  )
  (foreach l ll
    (if (and (setq jsel (SelDynBlock BlockName (list "_X" (list (cons 410 l))))) (= (sslength jsel) 1))
      (progn
        (setq name (ssname jsel 0))
        (setLayoutName l (lst2str (AttList2Name LayoutName name) ""))
      )
    )
  )
  (setLayoutPos)
)

Cela devrait répondre à tes besoins (et probablement aux besoins d'autres personnes) concernant la numérotation des présentations.

Bisous,
Luna

Netparty · le 24 décembre 2021

il y a 27 minutes, Luna a dit :

Coucou,

Ma commande NAMECART étant un peu vieillote, j'ai fait une refonte complète et déclaré 100% des fonctions localement pour son bon fonctionnement. Au début de la définition de la commande, il y a une zone de définition des paramètres utilisateur (les commentaires sont là pour aider à la situer et à la remplir correctement). Dans la version ci-dessous j'ai déjà défini les paramètres utilisateurs pour ton utilisation perso, mais si jamais le nom de ton bloc change, si tu as plusieurs nom de bloc, ou si tu souhaites changer le modèle du nom des présentations, tu suis les indications dans les commentaires pour ne pas faire de bêtises.

(defun c:NAMECART (/ ListBox lst2str SelDynBlock setLayoutName setLayoutPos AttList2Name BlockName LayoutName)
;--- Définition utilisateur pour le bon fonctionnement et l'adaptation du programme aux besoins de chacun.                                          ;
;--•  BlockName, chaîne de caractères comprise entre guillemets "" spécifiant le nom du ou des blocs servant à renommer les présentations.          ;
;           -> Les caractères spéciaux (cf. "Wild-Card Characters Reference") sont autorisés ! Utilisation de la fonction (wcmatch)                 ;
;           -> Plusieurs nom et/ou clés de recherche peuvent être spécifiés en les séparant par une virgule ","                                     ;
;           -> Ex. :  "CARTOUCHE"                                                                                                                   ;
;                     "Cartouche*"                                                                                                                  ;
;                     "A0-Paysage*Cartouche,A0-Portrait*Cartouche"                                                                                  ;
;--•  LayoutName, liste dont l'ordre et le type de chaque élément permet de servir de modèle d'appelation pour les présentations.                   ;
;           -> Ne SURTOUT PAS modifier/supprimer la fonction (quote) ni modifier le nombre et la position des parenthèses () !!!                    ;
;           -> Le nom des étiquettes d'attributs ne doivent pas être compris entre guillemet "", écrire directement le nom des étiquettes           ;
;           -> Les chaînes de caractères correspondent aux chaînes de caractères de séparation si vous désirez en mettre, tout est autorisé du      ;
;              moment que les chaînes de séparation sont entre guillemets ""                                                                        ;
;           -> Le nombre d'éléments dans la liste est libre, il peut contenir autant d'attribut que souhaité, autant de chaînes de séparation que   ;
;              souhaité et l'ordre entre les différents élément est également libre                                                                 ;
;           -> Ex. :  N°AFFAIRE "-" NIVEAU "-" TECHNIQUE "-" NUMERO "-" DERIND                                                                      ;
;                     (getvar "DWGNAME") "_" PHASE "_" Indice "-" PLANCHE "_" TITRE1 TITRE2                                                         ;
  (setq
    BlockName "CARTOUCHE" ;--•  Définition du ou des noms des blocs cartouche
    LayoutName (quote (N°AFFAIRE "-" NIVEAU "-" TECHNIQUE "-" NUMERO "-" DERIND)) ;--•  Définition de la méthode d'appelation des présentation
  )
;--- Fin de la définition des paramètres utilisateurs.                                                                                              ;
  (defun ListBox (title msg lst value flag / str2lst tmp file DCL_ID choice tlst)
    (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)
      )
    )
    (setq tmp (vl-filename-mktemp "tmp.dcl")
          file (open tmp "w")
          tlst lst
    )
    (write-line
      (strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";")
      file
    )
    (write-line
      ":edit_box{key=\"filter\";}"
      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 ":text{key=\"count\";}" file)
    (write-line "spacer;ok_cancel;}" file)
    (close file)
    (setq DCL_ID (load_dialog tmp))
    (if (not (new_dialog "ListBox" DCL_ID))
      (exit)
    )
    (set_tile "filter" "*")
    (set_tile "count" (strcat (itoa (length lst)) " / " (itoa (length lst))))
    (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
      "filter"
      "(start_list \"lst\")
      (mapcar 'add_list (setq tlst (vl-list-search $value lst)))
      (end_list)
      (set_tile \"count\" (strcat (itoa (length tlst)) \" / \" (itoa (length lst))))"
    )
    (action_tile
        "accept"
        "(or 	(= (get_tile \"lst\") \"\")
          (if (= 2 flag)
            (progn
              (foreach n (str2lst (get_tile \"lst\") \" \")
                (setq choice (cons (nth (atoi n) tlst) choice))
              )
              (setq choice (reverse choice))
            )
            (setq choice (nth (atoi (get_tile \"lst\")) tlst))
          )
        )
        (done_dialog)"
    )
    (start_dialog)
    (unload_dialog DCL_ID)
    (vl-file-delete tmp)
    choice
  )

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

  (defun SelDynBlock (BlockName sslist / jsel i name)
    (cond
      ((null sslist)
        (setq sslist (list "_X" (list '(0 . "INSERT") (cons 2 (strcat "`*U*," BlockName)))))
      )
      ((or (not (listp (last sslist))) (and (listp (last sslist)) (vl-list-length (car (last sslist)))))
        (setq sslist (append sslist (list '(0 . "INSERT") (cons 2 (strcat "`*U*," BlockName)))))
      )
      ((and (listp (last sslist)) (null (vl-list-length (car (last sslist)))))
        (setq
          sslist
            (append
              (reverse (cdr (reverse sslist)))
              (list
                (if (assoc 0 (last sslist))
                  (subst '(0 . "INSERT") (assoc 0 (last sslist)) (last sslist))
                  (append (last sslist) '((0 . "INSERT")))
                )
              )
            )
          sslist
            (append
              (reverse (cdr (reverse sslist)))
              (list
                (if (assoc 2 (last sslist))
                  (subst (cons 2 (strcat "`*U*," BlockName)) (assoc 2 (last sslist)) (last sslist))
                  (append (last sslist) (list (cons 2 (strcat "`*U*," BlockName))))
                )
              )
            )
        )
      )
    )
    (if (setq jsel (apply 'ssget sslist))
      (repeat (setq i (sslength jsel))
        (setq name (ssname jsel (setq i (1- i))))
        (if
          (not
            (and
              (= (getpropertyvalue name "ClassName") "")
              (wcmatch (getpropertyvalue name "BlockTableRecord/Name") BlockName)
            )
          )
          (ssdel name jsel)
        )
      )
    )
    jsel
  )

  (defun setLayoutName (layout str / getLayoutList ll)
    (defun getLayoutList (/ l ll)
      (vlax-for l (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
        (setq ll (cons (cons (vla-get-Name l) l) ll))
      )
      (reverse ll)
    )
    (setq ll (getLayoutList))
    (if (and (/= str layout) (assoc layout ll))
      (if (not (assoc str ll))
        (vla-put-name (cdr (assoc layout ll)) str)
        (progn
          (while (assoc str ll)
            (cond
              ((wcmatch str "* (#)")
                (setq str (strcat (substr str 1 (- (strlen str) 2)) (itoa (1+ (atoi (substr str (- (strlen str) 1) 1)))) ")"))
              )
              ((wcmatch str "* (##)")
                (setq str (strcat (substr str 1 (- (strlen str) 3)) (itoa (1+ (atoi (substr str (- (strlen str) 2) 2)))) ")"))
              )
              (T
                (setq str (strcat str " (2)"))
              )
            )
          )
          (vla-put-name (cdr (assoc layout ll)) str)
        )
      )
    )
  )

  (defun setLayoutPos (/ i l ll)
    (setq
      i 0
      ll (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (mapcar '(lambda (l) (vla-put-TabOrder (vla-item ll l) (setq i (1+ i)))) (layoutlist))
    (princ)
  )

  (defun AttList2Name (l name / attlist)
    (if
      (setq
        attlist
          (mapcar
            '(lambda (a) (cons (vla-get-tagstring a) (vla-get-textstring a)))
            (vlax-invoke (vlax-ename->vla-object name) 'getAttributes)
          )
      )
      (mapcar
        '(lambda(x)
          (if (= (type x) 'SYM)
            (if (assoc (vl-princ-to-string x) attlist)
              (cdr (assoc (vl-princ-to-string x) attlist))
              ""
            )
            (eval x)
          )
        )
        l
      )
    )
  )

  (initget "Active Toutes Sélection")
  (if (null (setq c (getkword "\nQuelle(s) présentation(s) souhaitez-vous rennomer [Active/Toutes/Sélection] <Active> ? ")))
    (setq c "Active")
  )
  (cond
    ((= c "Active") (setq ll (list (getvar "CTAB"))))
    ((= c "Toutes") (setq ll (layoutlist)))
    ((= c "Sélection")
      (setq
        ll
          (ListBox
            "Sélection des présentations"
            "Veuillez sélectionner une ou plusieurs présentation :"
            (vl-sort (layoutlist) '<)
            (getvar "CTAB")
            2
          )
      )
    )
  )
  (foreach l ll
    (if (and (setq jsel (SelDynBlock BlockName (list "_X" (list (cons 410 l))))) (= (sslength jsel) 1))
      (progn
        (setq name (ssname jsel 0))
        (setLayoutName l (lst2str (AttList2Name LayoutName name) ""))
      )
    )
  )
  (setLayoutPos)
)

Cela devrait répondre à tes besoins (et probablement aux besoins d'autres personnes) concernant la numérotation des présentations.

Bisous,
Luna

Re Luna

Super boulot, je t'en remercie

Passe une bonne journée

[LISP/Diesel ou Full Lisp] Renommer des onglets et des folios dans un cartouche automatiquement

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante