Sélection des sous objets d'un bloc

Elun · le 22 juillet 2019

Bonjour,

C'est la première fois que je poste un sujet donc je vais essayer d'être le plus clair possible :

J'ai déjà développer quelques routines LISP (je débute encore) dont une me permettant d'extraire une liste d'informations issues d'un fichier EXCEL et je travaille actuellement sur une commande me permettant de mettre à jour la liste des calques présents dans un fichier DWG.

Il s'agit d'un programme pour mon entreprise qui a un gabarit AutoCAD avec des calques et des blocs et qui a plusieurs versions (2016, 2018 et bientôt 2020). Cette liste de calque a évolué entre chaque toolkit et donc les projets qui ont démarré sur le toolkit 2016 par exemple n'ont pas une liste à jour.

Pour cela, j'ai dans un fichier EXCEL, une liste de calques (pouvant évoluer, ce qui me permettra d'avoir un toolkit dynamique) et je dois ensuite renommer, créer ou supprimer des calques en fonction de cette liste. Actuellement j'ai déjà bien avancé sur le sujet mais il me reste encore 2 ou 3 bugs à corriger mais si un calque obsolète se trouve dans un bloc, un simple (ssget "_X") ne suffit pas.

Or comme mon programme est déjà suffisamment lourd comme ça (ouvre 3 fois un fichier EXCEL pour en extraire les listes + sélection de toutes les entités d'un fichier et modification de leur propriétés), je voudrais éviter d'avoir à ouvrir chaque bloc à l'aide de l'éditeur pour en sélectionner les objets.

Cette commande n'est qu'une étape car elle me sert pour une autre commande qui me permet de geler ou libérer une liste de calques spécifique en fonction de l'indice que l'on affecte à une présentation. Cette liste est également issue du fichier EXCEL pour avoir la possibilité de faire évoluer la commande en même temps que le toolkit évolue.

Je me doute que je ne suis pas très clair, mais c'est pas toujours évident d'être clair et concis. ^^"

Voici la fonction me permettant de lire mon fichier EXCEL selon différentes méthodes :

;--- Fonction d'ouverture d'un fichier Excel nommé ExFile et de la feuille MyTabl
(defun MSX_Open (Exfile Mytabl)

(setq MyFile (findfile Exfile))
(if (/= MyFile nil)
	(progn
		(setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
		(vla-put-visible ExcelApp :vlax-false)
		(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)
		(setq Active_WkB (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") MyFile)))
	)
)
(if (/= ExcelApp nil)
	(progn
		(setq Active_Sht (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property Active_WkB "Sheets") "Item" MyTabl)))
		(if (not (vl-catch-all-error-p Active_Sht))
			(vlax-invoke-method Active_Sht "Activate")
			(setq Active_Sht nil)
		)
	)
	(setq Active_Sht nil)
)

)

;--- Fonction de lecture de la valeur d'une cellule pointée d'un fichier Excel
;--- Fonction en lien avec la fonction (MSX_Open)
(defun GetCell (Cell_name)

(if (/= ExcelApp nil)
	(progn
		(setq Active_Rng (vlax-get-property (vlax-get-property Active_Sht 'Cells) "Range" Cell_name))
		(setq Active_Cell (vlax-variant-value (vlax-get-property Active_Rng 'Value2)))
	)
	(setq Active_Cell nil)
)
Active_Cell

)

;--- Fonction de fermeture du fichier Excel et de l'application Excel + supression des variables de la mémoire
;--- Fonction EN COURS DE DEVELOPPEMENT issue de Marc'Antonio
(defun MSX_Quit ()

(if (not (vlax-object-released-p ExcelApp))					; Vérifie si l'application Excel n'est pas déchargée.
	(progn												; 
		(if Active_Rng
			(progn
				(vlax-object-released-p Active_Rng)
				(vlax-release-object Active_Rng)
			)
		)
		(if Active_Sht
			(progn
				(vlax-object-released-p Active_Sht)
				(vlax-release-object Active_Sht)
			)
		)
		(if Active_WkB
			(progn
				(vlax-object-released-p Active_WkB)
				(vlax-invoke-method Active_WkB 'Close)
				(vlax-release-object Active_WkB)
			)
		)
		(vlax-invoke-method ExcelApp 'QUIT)
		(vlax-release-object ExcelApp)
	)
)
(setq ExFile nil MyTabl nil MyFile nil ExcelApp nil Active_WkB nil Active_Sht nil Active_Rng nil Active_Cell nil)

)

(defun anytos (any)

(cond
	((= (type any) 'STR) any)
	((= (type any) 'INT) (itoa any))
	((= (type any) 'REAL) (rtos any))
)

)

;--- ExFile correspondant au nom d'un fichier présent dans les chemins de support (ex : "UBS-Projet LISP.lsp")
;--- MyTabl correspondant au nom d'une feuille Excel (ex : "Feuil1")
;--- Type_lst correspondant au type de recherche à effectuer sur la feuille ("Tab_H", "Tab_V", "Cell_V" ou "Cell_H")
;--- Value correspondant à une chaîne de caractères ou un nombre que l'on cherche dans une cellule Excel (ex : "Toiture" ou "UBS*" ou "*100*" ...)
;--- Ask_Cell_R correspondant à l'indice de ligne pour la première cellule recherchée (en haut à gauche) (ex : 1, 56, ...)
;--- Ask_Cell_C correspondant à l'indice de colonne pour la première cellule recherchée (en haut à gauche) (ex : "B", "AH", ...)
;--- Rtn_Cell_R correspondant à l'indice de ligne pour la première donnée à récupérer (en haut à gauche) (ex : 12, 56, ...)
;--- Rtn_Cell_C correspondant à l'indice de colonne pour la première donnée à récupérer (en haut à gauche) (ex : "B", "AH", ...)
;--- La recherche requiert d'avoir des lignes et/ou des colonnes continues (pas de cellules vides au milieu de la liste à établir)
;--- La méthode "Tab_H" correspond à récupérer une cellule équivalente à Value dans une colonne spécifiée et retourne la liste des cellules dans la ligne correspondante à partir d'une colonne spécifiée.
;--- La méthode "Tab_V" correspond à récupérer une cellule équivalente à Value dans une ligne spécifiée et retourne la liste des cellules dans la colonne correspondante à partir d'une ligne spécifiée.
;--- La méthode "Cell_H" correspond à récupérer une liste de cellules équivalentes à Value dans une colonne spécifiée et retourne le résultat équivalent de la cellule à la même ligne pour une colonne spécifiée.
;--- La méthode "Cell_V" correspond à récupérer une liste de cellules équivalentes à Value dans une ligne spécifiée et retourne le résultat équivalent de la cellule à la même colonne pour une ligne spécifiée.

(defun ExcelReader_List (ExFile MyTabl Type_lst Value Ask_Cell_C Ask_Cell_R Rtn_Cell_C Rtn_Cell_R / i_C i_R Max_C Max_R Ask_Cell)

(setq Excel_List nil)
(MSX_Open Exfile MyTabl)
(cond
	((= Type_lst "Tab_H")
		(progn
			(setq i_R Ask_Cell_R)
			(while (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))
				(setq i_R (SupIncr i_R 1))
			)
			(setq Max_R i_R)
			(setq i_R Ask_Cell_R)
			(while (< i_R Max_R)
				(if (wcmatch (anytos (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))) (anytos Value))
					(progn
						(setq Ask_Cell_R i_R)
						(setq Ask_Cell (strcat Ask_Cell_C (rtos Ask_Cell_R 2 0)))
						(setq i_R Max_R)
					)
					(setq i_R (SupIncr i_R 1))
				)
			)
			(if (null Ask_Cell) (prompt (strcat "\nValeur recherchée non répertoriée dans le document Excel \"" ExFile "\"")))
			(setq i_C Rtn_Cell_C)
			(while (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))
				(setq i_C (SupIncr i_C 1))
			)
			(setq Max_C i_C)
			(setq i_C Rtn_Cell_C)
			(while (/= i_C Max_C)
				(setq Excel_List (cons (anytos (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))) Excel_List))
				(setq i_C (SupIncr i_C 1))
			)
		)
	)
	((= Type_lst "Tab_V")
		(progn
			(setq i_C Ask_Cell_C)
			(while (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))
				(setq i_C (SupIncr i_C 1))
			)
			(setq Max_C i_C)
			(setq i_C Ask_Cell_C)
			(while (/= i_C Max_C)
				(if (wcmatch (anytos (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))) (anytos Value))
					(progn
						(setq Ask_Cell_C i_C)
						(setq Ask_Cell (strcat Ask_Cell_C (rtos Ask_Cell_R 2 0)))
						(setq i_C Max_C)
					)
					(setq i_C (SupIncr i_C 1))
				)
			)
			(if (null Ask_Cell) (prompt (strcat "\nValeur recherchée non répertoriée dans le document Excel \"" ExFile "\"")))
			(setq i_R Rtn_Cell_R)
			(while (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))
				(setq i_R (SupIncr i_R 1))
			)
			(setq Max_R i_R)
			(setq i_R Rtn_Cell_R)
			(while (< i_R Max_R)
				(setq Excel_List (cons (anytos (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))) Excel_List))
				(setq i_R (SupIncr i_R 1))
			)
		)
	)
	((= Type_lst "Cell_V")
		(progn
			(setq i_C Ask_Cell_C)
			(while (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))
				(setq i_C (SupIncr i_C 1))
			)
			(setq Max_C i_C)
			(setq i_C Ask_Cell_C)
			(while (/= i_C Max_C)
				(if (wcmatch (anytos (GetCell (strcat i_C (rtos Ask_Cell_R 2 0)))) (anytos Value))
					(setq Excel_List (cons (anytos (GetCell (strcat i_C (rtos Rtn_Cell_R 2 0)))) Excel_List))
				)
				(setq i_C (SupIncr i_C 1))
			)
		)
	)
	((= Type_lst "Cell_H")
		(progn
			(setq i_R Ask_Cell_R)
			(while (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))
				(setq i_R (SupIncr i_R 1))
			)
			(setq Max_R i_R)
			(setq i_R Ask_Cell_R)
			(while (< i_R Max_R)
				(if (wcmatch (anytos (GetCell (strcat Ask_Cell_C (rtos i_R 2 0)))) (anytos Value))
					(setq Excel_List (cons (anytos (GetCell (strcat Rtn_Cell_C (rtos i_R 2 0)))) Excel_List))
				)
				(setq i_R (SupIncr i_R 1))
			)
		)
	)
	((/= Type_lst "Tab_H" "Tab_V" "Cell_H" "Cell_V")
		(progn
			(setq Excel_List "Empty")
			(prompt (strcat "\nLa méthode \"" Type_lst "\" n'a pas été programmée pour le moment.\nVeuillez vous référer aux méthodes actuellement programmées."))
		)
	)
)
(MSX_Quit)
(if (null Excel_List) (prompt "\nValeur recherchée non répertoriée dans le document Excel"))
(setq Excel_List (reverse Excel_List))
Excel_List

) ; Retourne une liste sous forme de string pouvant ensuite être exploitée par la suite soit sous format DXF, soit sous format d'atomes
;--- Fonction purement fonctionnelle

Et voici quelques fonctions nécessaires à ma commande (si j'en ai oublié dite le moi) :

(defun c:MAJCALQUE ();/ Type_Projet Old_List New_List New_Color_List New_LineType_List Old_name New_name New_color New_LineType Obj_Sel i Nb_Obj Nb_Rename Nb_Old Replace_Obj Layout_List layout Init_layout Calque_List Color_List LineType_List Excel_List)

(initget 1 "Toiture CS Ombrière Serre Synoptique")
(setq Type_Projet (getkword "\nVeuillez préciser le type de projet : [Toiture/CS/Ombrière/Serre/Synoptique]  "))
(setq Old_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Calques - " "Anciens") "U" 2 "U" 3))
(setq New_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Calques - " "Remplacement") "U" 2 "U" 3))
(setq New_Color_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Couleur - " "Remplacement") "U" 2 "U" 3))
(setq New_Linetype_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Type Ligne - " "Remplacement") "U" 2 "U" 3))
(if (open (findfile "UBS 2019 - acadiso.lin") "R")
	(command "_-LINETYPE" "CH" "*" "UBS 2019 - acadiso.lin" (while (= (getvar "CMDACTIVE") 1) (command "")))
	(prompt "\nLe fichier \"UBS 2019 - acadiso.lin\" n'a pas été trouvé.\nRisque d'erreur plus important !!!")
)
(setq i 0)
(setq Nb_Obj 0)
(setq Nb_Rename 0)
(setq Nb_Old 0)
(setq Replace_Obj 0)
(setq Layout_List (cons "Model" (layoutlist)))
(setq Init_layout (getvar "CTAB"))
(setq Supp_List nil)
(setq LineType_List (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))))
(while (< i (vl-position (last Old_List) Old_List))
	(setq Old_name (nth i Old_List))
	(setq New_name (nth i New_List))
	(setq New_color (atoi (nth i New_Color_List)))
	(setq New_LineType (nth i New_Linetype_List))
	(if (tblsearch "LAYER" Old_name)
		(cond
			((= New_name Old_name)
				(command "_LAYER" "CO" New_Color New_name "TL" New_LineType New_name "")
			)
			((tblsearch "LAYER" New_name)
				(progn
					(foreach layout Layout_List
						(if (setq Obj_Sel (ssget "_X" (list (cons 8 Old_name) (cons 410 layout))))
							(progn
								(setvar "CTAB" layout)
								(setq Nb_Obj (+ Nb_Obj (sslength Obj_Sel)))
								(if (= New_name "UBS-900-Calques obsolètes")
									(progn
										(setq Replace_Obj (+ Replace_Obj (sslength Obj_Sel)))
										(setq Supp_List (cons Old_name Supp_List))
									)
								)
								(command "_CHPROP" Obj_Sel "" "CA" New_name "")
								(command "_LAYER" "CO" New_Color New_name "TL" New_LineType New_name "")
							)
						)
					)
					(setq Nb_Old (SupIncr Nb_Old 1))
				)
			)
			((not (tblsearch "LAYER" New_name))
				(progn
					(command "_LAYER" "R" Old_name New_name "CO" New_Color New_name "TL" New_LineType New_name "")
					(setq Nb_Rename (SupIncr Nb_Rename 1))
					(setq Nb_Old (SupIncr Nb_Old 1))
				)
			)
		)
	)
	(setq i (SupIncr i 1))
)
(command "-PURGER" "CA" "*" "N")
(setq Calque_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Calques - " Type_Projet) "B" 2 "B" 3))
(setq Color_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Couleur - " Type_Projet) "B" 2 "B" 3))
(setq LineType_List (ExcelReader_List "Toolkit - Filtres.xlsm" "Liste des Calques" "Tab_V" (strcat "Type Ligne - " Type_Projet) "B" 2 "B" 3))
(setq i 0)
(while (< i (vl-position (last Calque_List) Calque_List))
	(Verif_Calque (nth i Calque_List) (atoi (nth i Color_List)) (nth i LineType_List))
	(setq i (SupIncr i 1))
)
(setvar "CTAB" Init_layout)
(alert (strcat "Le programme MAJCALQUE a trouvé "
	       (itoa Nb_Old)
	       " calques obsolètes."
	       "\nAu cours de cette opération, "
	       (itoa Nb_Rename)
	       " calques ont été renommé et "
	       (itoa Nb_Obj)
	       " objets ont changé de calque."
	       "\n"
	       "\nParmi ces objets, "
	       (itoa Replace_Obj)
	       " ont été placé sur le calque \"UBS-900-Calques obsolètes\" en raison de la purge des calques sur lesquels ils se trouvaient."
	       "\nVoici la liste des calques ayant été ou devant être purgé de ce dessin :"
	       (DXF_List Supp_List "\n  - " "left" "Trier" "")
	)
)

)

(defun Verif_Calque (name Color LineType)

(if (not (tblsearch "LAYER" name))
	(command "_LAYER" "N" name "CO" Color name "TL" LineType name "")
)

)

; Création d'une liste issue d'une "Symbol Table" selon un critère de recherche + possibilitée de faire une liste simple de forme DXF (MAJ nécessaire depuis la fonction (DXF_List) :

;--- La fonction (flt_tbl) possède 2 arguments
;--- tbl permet de définir dans quelle "Symbol Table" la recherche est effectuée.
;--- search est une chaîne de caractère correspondant au filtre que l'on souhaite appliquer à notre "Symbol Table" (ex : "UBS*" /= "*UBS" /= "UBS" ...).

;--- Renvoie une liste de la forme ("A" "B" "C" "D").
(defun flt_tbl (tbl search / name)

(setq lst_tbl nil)
(setq name (cdr (assoc 2 (tblnext tbl t))))
(while (/= name nil)
	(if (= (wcmatch name search) t)
		(setq lst_tbl (cons name lst_tbl))
	)
	(setq name (cdr (assoc 2 (tblnext tbl))))
)
(setq search nil)
lst_tbl

)

; Incrémentation d'un nombre entier ou d'un texte en fonction d'un pas défini par l'utilisateur :
;--- La fonction (SupIncr) possède 2 arguments
;--- x doit être un nombre entier ou un string correspondant à l'élément que l'on souhaite incrémenter (ex : 3, "B", "BFL", ...)
;--- pas permet de définir l'incrément que l'on doit appliquer. Usuellement on incrémente de 1 mais il est possible d'incrémenter en négatif ou en positif. Sous forme de nombre entier.

;--- Renvoie le nombre ou le texte incrémenter du pas défini (ex : (SupIncr 3 1) = 4, (SupIncr "BFL" 1) = "BFM", (SupIncr "A" 26) = "AA", ...)
;--- MAJ à réaliser pour incrémenter également les nombres réél et d'avoir un pas avec un nombre réél.
(defun SupIncr (x pas / Incr_I i)

(setq i 0)
(cond
	((and (= (type x) 'INT) (= (type pas) 'INT)) (setq Incr_i (+ x pas)))
	((and (= (type x) 'STR) (= (type pas) 'INT)) (setq Incr_i (progn (while (/= x (String_Incr i)) (setq i (1+ i))) (String_Incr (setq i (+ i pas))))))
	((and (/= (type x) (or 'INT 'STR)) (= (type pas) 'INT)) (alert "Valeur à incrémenter non conforme"))
	((/= (type pas) 'INT) (alert "Le pas nécessite un nombre entier"))
)

)

; En lien avec la fonction (SupIncr), Cela permet de renvoyer la chaîne de caractères MAJUSCULES correspondant à leur valeur ASCII :
;--- La fonction (String_Incr) possède 1 argument
;--- i correspond à la valeur de la table ASCII d'un caractère (ex : A = 0, C = 2, Z = 25, ...)

;--- Renvoie la chaîne de caractère dont la valeur ASCII a été passé en entrée.
(defun String_Incr (i / Start End)  ;; 0 -> "A", 25 -> "Z", 26 -> "AA"

(setq Start (/ i 26) End (rem i 26))
(if (= Start 0)
	(chr (+ i 65))
	(strcat (String_Incr (1- Start)) (chr (+ End 65)))
)

)

; Permet de modifier une liste de chaînes de caractères en une liste remaniée aux désirs de l'utilisateur :
;--- La fonction (DXF_List) possède 5 arguments
;--- Lst défini la liste que l'on va évaluer et modifier avec cette fonction (ex : ("Ceci" "est" "un" "exemple") )
;--- string détermine avec quelle chaîne de caractères on souhaite lier nos éléments (ex : ",", " ", "\n - ", ...)
;--- Pos détermine de quel côté on souhaite ajouter la chaîne de caractères de liaison ("left" ou "right", tout le reste renverra la List)
;--- Tri détermine si l'on souhaite trier les valeurs de la liste en entrée. Tri si la valeur de Tri est différente de "" (ex : ("Ceci" "est" "exemple" "un") )
;--- Supp détermine si l'on souhaite supprimer la chaîne de caractères de liaison à l'extrémité gauche ou droite en fonction de la valeur de Pos. Effectue la suppression si Supp est différent de "".

;--- Renvoie la liste remaniée en fonction des différents paramètres (ex : (DXF_List '("Ceci" "est" "un" "exemple") " " "right" "" "oui") = ("Ceci est un exemple") )
(defun DXF_List (Lst string Pos Tri Supp)

(setq New_List nil)
 	(if (/= Tri "")
	(setq Lst (vl-sort Lst'<))
)
(cond
	((= Pos "left")
	 	(setq New_List (apply 'strcat (mapcar '(lambda (x) (strcat string x)) Lst)))
		(if (/= Supp "")
		  	(setq New_List (vl-string-left-trim string New_List))
		)
	)
	((= Pos "right")
		(setq New_List (apply 'strcat (mapcar '(lambda (x) (strcat x string)) Lst)))
		(if (/= Supp "")
		  	(setq New_List (vl-string-right-trim string New_List))
		)
	)
	((/= Pos "right" "left") (setq New_List Lst))
)
 	New_List

)

J'ai mis en PJ un extrait des listes de calques en fonction des types de projet.

Donc pour résumer, pensez-vous qu'il existe un moyen de modifier les calques des entités présentes dans un bloc sans être obligé de passer par l'éditeur de bloc ?

En vous remerciant ;)

Elun · le 22 juillet 2019

Petit oublie de ma part, la commande en cours d'édition, c'est la commande MAJCALQUE.

(gile) · le 22 juillet 2019

Salut,

Les références de bloc insérées dans le dessin ne sont que des référence à une définition de bloc.

Les référence de bloc ne contiennent pas d'entité à proprement parler, c'est la définition de bloc qui contient les entités.

En programmation, on peut accéder directement à la définition du bloc et donc aux entités qu'elle contient.

Avec AutoLISP, la fonction tblsearch permet d'accéder aux enregistrements dans une table, par exemple :

(tblsearch "BLOCK" "nomDuBloc") renvoie une liste type DXF pour la définition du bloc "nomDuBloc", dans cette liste, le groupe DXF -2 pointe sur la première entité dans la définition du bloc. On accède aux suivantes avec entext généralement dans une boucle while.

Avec Visual LISP, on accède à la table des blocs par :

(vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) puis on accède à une définition avec la fonction vla-Item et on peut parcourir les entités contenues dans la définition avec vlax-for.

Elun · le 22 juillet 2019

Ok, merci beaucoup !!!

je ne connaissais pas entnext :P

Elun · le 29 juillet 2019

Bonjour,

Je me permet de revenir vers vous pour une petite question : Existe-t-il un moyen de spécifier si oui ou non une commande peut apparaître dans l'historique de commande ?

Ma commande MAJCALQUE à le défaut d'exécuter la commande "-CALQUE" dans une boucle while (une centaine de passage!!), or les informations saisies pour chaque calque est inutile à mes yeux pour l'utilisateur et polluent l'historique de commandes car on ne peut plus accéder aux commandes précédemment lancées.

J'ai déjà essayé de modifier CLIPROMPTUPDATE, INPUTHISTORYMODE ou CMDINPUTHISTORYMAX mais peu importe les valeurs entrées, rien ne change dans mon historique de commande ...

En vous remerciant d'avance.

(gile) · le 29 juillet 2019

En début de routine on stocke la valeur initiale de la variable système et on désactive l'écho des commandes :

(setq oldEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)

En fin de routine on restaure la valeur initiale de la variable système :

(setvar "cmdecho" oldEcho)

Le mieux d'utiliser un gestionnaire d'erreur pour garantir la restauration de la variable système au cas où une erreur survienne.

Elun · le 30 juillet 2019

Je viens de réussir mon histoire de changement de calques pour les sous entités des blocs donc encore merci (gile) !!!

En revanche je n'ai pas su comprendre la méthode Visual LISP qui est encore trop complexe à mes yeux pour le moment et je ne comprend pas comment je pourrais éviter la redondance avec (entnext) dans mon code que voici :

(defun EntityBlock_Layer (search replace / Bloc_name_List Nb_Ent Bloc_name Bloc_Data EntB EntB_DXF)

(setq Bloc_name_List (flt_tbl "BLOCK" "*")
      Nb_Ent 0
)
(foreach Bloc_name Bloc_name_List
	(setq Bloc_Data (tblsearch "BLOCK" Bloc_name)
	      EntB (cdr (assoc -2 Bloc_Data))
	      EntB_DXF (entget EntB)
	)
	(if (wcmatch (cdr (assoc 8 EntB_DXF)) search)
		(progn
			(setq EntB_DXF (subst (cons 8 replace) (assoc 8 EntB_DXF) EntB_DXF))
			(entmod EntB_DXF)
			(entupd EntB)
			(setq Nb_Ent (1+ Nb_Ent)
			      Bloc_List (cons (cdr (assoc 2 Bloc_Data)) Bloc_List)
			)
		)
	)
	(while (setq EntB (entnext EntB))
		(setq EntB_DXF (entget EntB))
		(if (wcmatch (cdr (assoc 8 EntB_DXF)) search)
			(progn
				(setq EntB_DXF (subst (cons 8 replace) (assoc 8 EntB_DXF) EntB_DXF))
				(entmod EntB_DXF)
				(entupd EntB)
				(setq Nb_Ent (1+ Nb_Ent)
				      Bloc_List (cons (cdr (assoc 2 Bloc_Data)) Bloc_List)
				)
			)
		)
	)
)

)

Je pense ne pas avoir bien saisie son fonctionnement car ça me paraît étrange de devoir faire deux fois la même chose... Pour moi (entnext) ne pourra fonctionner sur les entités des définitions de blocs que si on lui spécifie le premier élément.

Et merci également pour la variable système CMDECHO, ça va beaucoup mieux maintenant :)

Elun · le 30 juillet 2019

Et du coup, j'avais un autre question : est-il possible d'afficher une boîte de dialogue permettant d'afficher un état de progression pour une commande ?

Etant donné que ma commande MAJCALQUE est très longue en terme d'exécution, j'aimerais avoir une barre de progression qui s'affiche pendant que ma commande est en train de tourner (histoire de "rassurer" l'utilisateur que la commande est en cours d'exécution et non AutoCAD qui est en train de ramer, ce qui force les gens à bourriner la touche ECHAP ^^")

Je ne maîtrise pas beaucoup les boîtes de dialogues et je ne sais pas comment faire une pop-up qui ne nécessite pas un clic de l'utilisateur (et donc s'exécute en parallèle d'une commande, au même titre que les palettes d'outils d'AutoCAD)

Merci pour vos futures réponses.

Elun · le 1 août 2019

Bonjour,

Juste pour ceux que ça intéresse, voici la fonction que j'ai dev' pour pouvoir sélectionner l'ensemble des blocs d'un fichier et modifier le calque des sous entités s'il correspond au premier argument en le remplaçant par le calque spécifier en second argument. Ainsi les deux premier arguments sont des noms de calques (sous format string) et le 3ème c'est uniquement pour afficher ou non le message (dans la barre de commande) permettant de savoir combien d'entités ont changé de calques et dans quel(s) bloc(s). Donc le 3ème argument prend comme valeur "prompt" si on veut afficher le résultat, sinon "" (bien qu'on peut écrire tout et n'importe quoi) :

(defun BlockEntity_Layer (search replace Display / Bloc_name_List Bloc_name Bloc_Data EntB EntB_DXF)

(setq Bloc_name_List (flt_tbl "BLOCK" "*")
      Ent_Obj 0
)
(if (not Nb_Obj) (setq Nb_Obj 0))
(if (= Display "prompt") (setq Bloc_List nil))
(foreach Bloc_name Bloc_name_List
	(setq Bloc_Data (tblsearch "BLOCK" Bloc_name)
	      EntB (cdr (assoc -2 Bloc_Data))
	      EntB_DXF (entget EntB)
	)
	(if (wcmatch (cdr (assoc 8 EntB_DXF)) search)
		(progn
			(setq EntB_DXF (subst (cons 8 replace) (assoc 8 EntB_DXF) EntB_DXF))
			(entmod EntB_DXF)
			(entupd EntB)
			(setq Nb_Obj (1+ Nb_Obj)
			      Ent_Obj (1+ Ent_Obj)
			      Bloc_List (cons (cdr (assoc 2 Bloc_Data)) Bloc_List)
			)
		)
	)
	(while (setq EntB (entnext EntB))
		(setq EntB_DXF (entget EntB))
		(if (wcmatch (cdr (assoc 8 EntB_DXF)) search)
			(progn
				(setq EntB_DXF (subst (cons 8 replace) (assoc 8 EntB_DXF) EntB_DXF))
				(entmod EntB_DXF)
				(entupd EntB)
				(setq Nb_Obj (1+ Nb_Obj)
				      Ent_Obj (1+ Ent_Obj)
				      Bloc_List (cons (cdr (assoc 2 Bloc_Data)) Bloc_List)
				)
			)
		)
	)
)
(if (= Display "prompt")
	(prompt
		(strcat "\nLa fonction BlockEntity_Layer a trouvé "
			(itoa Ent_Obj)
			" objets sur le calque "
			"\""
			search
			"\""
			", remplacé par le calque "
			"\""
			replace
			"\""
			"."
			"\n"
			"\nVoici la liste des blocs ayant été modifié (les blocs dynamiques apparaîssent sous la forme \"*U###\" ou \"*D###\") :"
			(if Bloc_List (DXF_List Bloc_List "\n  - " "left" "Tri" "") "")
			"\n"
		)
	)
)

)

J'ai utiliser d'autres routines comme (flt_tbl) pour récupérer le nom des objets présent dans une symbol table ("BLOCK", "LAYER", "LINETYPE", ...) en fonction du filtre appliqué ("*" pour récupérer la totalité des objets) ou (DXF_List) qui me permet de modifier les listes en jouant avec ses arguments.

Le but principal étant de passer d'une liste de n atomes à une une chaîne de caractère en concaténant l'ensemble des éléments de la liste par un string spécifié, à droite ou à gauche de l'élément et on a le choix de trier ou non la liste en amont ainsi que de supprimer le string en début (si placé à gauche) ou en fin (si placé à droite) de la chaîne de caractère obtenue. Très utile pour moi pour les filtres de (ssget) à multi-calque/nom/... en ajoutant une "," entre chaque éléments ou simplement de trier une liste par ordre numérique/alphabétique ou dans des messages avec des listes.

Par exemple :

(DXF_List '("Ligne" "Polyligne" "Rectangle" "Cercle") "," "right" "Tri" "Sup") renvoie

--> "Cercle,Ligne,Polyligne,Rectangle"

(DXF_List '("Ligne" "Polyligne" "Rectangle" "Cercle") "," "right" "" "") renvoie

--> "Ligne,Polyligne,Rectangle,Cercle,"

(DXF_List '("Ligne" "Polyligne" "Rectangle" "Cercle") "\n - " "left" "Tri" "") renvoie

--> "\n - Cercle\n - Ligne\n - Polyligne\n - Rectangle"

Donc voici leur dev :

	; Création d'une liste issue d'une "Symbol Table" selon un critère de recherche + possibilitée de faire une liste simple de forme DXF (MAJ nécessaire depuis la fonction (DXF_List) :

;--- La fonction (flt_tbl) possède 3 arguments
;--- tbl peut actuellement prendre 3 valeurs possibles ("LAYER", "BLOCK" ou "LTYPE"), permet de définir dans quelle "Symbol Table" la recherche est effectuée.
;--- search est une chaîne de caractère correspondant au filtre que l'on souhaite appliquer à notre "Symbol Table" (ex : "UBS*" /= "*UBS" /= "UBS" ...).
;--- get défini si l'on souhaite obtenir une liste de n atomes 'STR ou une liste d'un unique atome composé de chaque élément séparé par une virgule. (Amené à disparaître)

;--- Renvoie une liste de la forme ("A" "B" "C" "D").
(defun flt_tbl (tbl search / name)

(setq lst_tbl nil)
(setq name (cdr (assoc 2 (tblnext tbl t))))
(while (/= name nil)
	(if (= (wcmatch name search) t)
		(setq lst_tbl (cons name lst_tbl))
	)
	(setq name (cdr (assoc 2 (tblnext tbl))))
)
(setq search nil)
lst_tbl

)

	; Permet de modifier une liste de chaînes de caractères en une liste remaniée aux désirs de l'utilisateur :
;--- La fonction (DXF_List) possède 5 arguments
;--- Lst défini la liste que l'on va évaluer et modifier avec cette fonction (ex : ("Ceci" "est" "un" "exemple") )
;--- string détermine avec quelle chaîne de caractères on souhaite lier nos éléments (ex : ",", " ", "\n - ", ...)
;--- Pos détermine de quel côté on souhaite ajouter la chaîne de caractères de liaison ("left" ou "right", tout le reste renverra la List)
;--- Tri détermine si l'on souhaite trier les valeurs de la liste en entrée. Tri si la valeur de Tri est différente de "" (ex : ("Ceci" "est" "exemple" "un") )
;--- Supp détermine si l'on souhaite supprimer la chaîne de caractères de liaison à l'extrémité gauche ou droite en fonction de la valeur de Pos. Effectue la suppression si Supp est différent de "".

;--- Renvoie la liste remaniée en fonction des différents paramètres (ex : (DXF_List '("Ceci" "est" "un" "exemple") " " "right" "" "oui") = ("Ceci est un exemple") )
(defun DXF_List (Lst string Pos Tri Supp)

(setq New_List nil)
 	(if (/= Tri "")
	(setq Lst (vl-sort Lst'<))
)
(cond
	((= Pos "left")
	 	(setq New_List (apply 'strcat (mapcar '(lambda (x) (strcat string x)) Lst)))
		(if (/= Supp "")
		  	(setq New_List (vl-string-left-trim string New_List))
		)
	)
	((= Pos "right")
		(setq New_List (apply 'strcat (mapcar '(lambda (x) (strcat x string)) Lst)))
		(if (/= Supp "")
		  	(setq New_List (vl-string-right-trim string New_List))
		)
	)
	((/= Pos "right" "left") (setq New_List Lst))
)
 	New_List

)

En espérant que ça aide quelqu'un ^^'

Connexion

Sélection des sous objets d'un bloc

Messages recommandés

Elun

Elun

(gile)

Elun

Elun

(gile)

Elun

Elun

Elun

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante