Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Rotation de N Blocs en fonction d une Valeur d Attribut

lecrabe

Par lecrabe
dans Routines LISP

 Partager

Messages recommandés

Luna Experienced

Luna

Posté(e)
Posté(e)

Coucou,

 

Je ne suis pas vraiment sûre de mon coup, mais ceci devrait fonctionner...

;--- Nom de la commande									[]-----------------------[] AttProperties []-----------------------[]										;
;--- Date de création		> 02/03/2021																								;
;--- Dernière modification	> 05/03/2021																								;
;--- Auteur(e)			> Luna																									;
;--- Version			> 2.0.0																									;
;--- Classe			> "DtObj"																								;
;																													;
;--- But et domaine d'application																									;
;	> En raison du nombre important de demandes pour modifier les propriétés des blocs standards et/ou dynamiques à partir des valeurs contenues dans des attributs, il s'est avéré utile de généraliser ces multiples demandes	;
;	en une unique commande. Cette commande se doit d'être suffisamment intuitive, simple d'utilisation, complète dans son domaine d'exécution et rapide. Le principe de la commande est simple puisqu'après avoir sélectionner un	;
;	bloc référent (possédant des attributs), il suffit de définir les attributs ayant une relation directe avec une propriété modifiable depuis la liste DXF d'une référence de bloc et de lui associer la propriété adéquate via	;
;	une boîte de dialogue. Grâce à la variable globale *BdD-Return*, le nom de la définition de bloc ainsi que les données paramétrées dans la boîte de dialogue sont conservée pour la session et par dessin. Cela permet de	;
;	lancer plusieurs fois la commande sans devoir paramétrer de nouveau l'ensemble des données.																	;
;	Cette commande est applicable dans de nombreux domaines comme par exemple l'attribut "ALT" ayant un lien direct avec la position Z de chaque point topo.									;
;																													;
;--- Fonctionnement global																										;
;	> La commande se décompose en 3 temps :																								;
;		- Sélection d'un bloc référent selon certains critères																					;
;			Aucune distinction entre un bloc standard ou dynamique (exclusion des réseaux grâces à la présence obligatoire d'attributs) et une boucle est définie pour s'assurer d'une sélection, sans mettre fin à		;
;			l'exécution du programme prématurément. En fonction de la première exécution ou non de la commande, une valeur par défaut sera disponible pour s'épargner la sélection d'un bloc (dessin ou liste).		;
;			Ainsi, au premier lancement, la sélection autorisée d'un bloc référent se fera soit par sélection d'un bloc visible dans l'espace de travail du dessin en cours, soit au travers d'une liste à choix unique	;
;			parmi l'ensemble des définitions de blocs présentes dans le dessin en cours (= option "Nom").															;
;			Pour les exécutions suivantes, les mêmes choix seront disponibles ainsi qu'une valeur par défaut (= ENTER à vide) correspondant à la précédente définition de bloc utilisée par le programme.			;
;																													;
;		- Définition des relations entre valeur d'attribut et propriétés																			;
;			Une boîte de dialogue découpée en 3 colonnes va permettre l'attribution des propriétés en fonction du nom de l'attribut. Ainsi la première colonne correspond à la liste des attributs du bloc référent, qui	;
;			se présente sous la forme d'une liste de cases à cocher ou décocher pour déterminer si oui ou non le programme devra travailler avec cet attribut. La seconde colonne permet donc de définir la liaison ou	;
;			l'association entre chaque attribut sélectionné et une propriété de la référence de bloc. La dernière colonne permet uniquement d'apporter des informations complémentaires en fonction de la propriété choisie.;
;			Il est tout à fait possible de sélectionner un ou plusieurs attributs mais chaque attribut ne peut être lié qu'à une seule propriété. Il est également possible d'affecter une même propriété à plusieurs	;
;			attributs différents, bien que cela ne vaudra qu'à définir la propriété via la dernière occurrence fonctionnelle parmi la liste.										;
;			Il est possible de mettre fin au programme en sélectionnant le bouton "Cancel". Une "Aide" est disponible au besoin (en cours d'édition pour plus d'information). Pour continuer, il suffit de "valider".	;
;																													;
;		- Sélection des références de blocs devant être mises à jour																				;
;			Pour cela, 2 niveaux de sélection sont définis par le programme. Si le 1er niveau est vide, le 2nd niveau sera alors exécuté et si le 2nd niveau est vide également, le programme s'arrête.			;
;			Le niveau 1 correspond à une sélection manuelle des blocs (la pré-sélection est possible au besoin) qui sera alors filtrée de telle sorte que seuls les blocs possédant des attributs et portant le nom du bloc	;
;			référent (+ blocs anonymes dynamiques) soient autorisés. Si l'utilisateur appuie sur ENTER, le 2nd niveau s'enclenche pour cette fois-ci sélectionner la totalité des références portant ce nom-là.		;
;			Chaque référence sera alors modifiée en fonction de la valeur des attributs spécifiés auparavant pour mettre à jour les propriétés. Certaines propriétés nécessitent des informations supplémentaires comme par	;
;			exemple il est possible de mettre un bloc uniformément à l'échelle en ne définissant qu'un seul attribut grâce au complément d'information "Echelle uniforme". Attention également à la propriété de couleur ou	;
;			aux unités choisies pour la rotation (l'axe 0 et le sens angulaire sont différents entre des angles en degrés ou en grades !).											;
;																													;
;--- Modifications apportées par rapport à la version précédente																					;
;	> Premier jet pour l'aide de la boîte de dialogue et ajout du taux de réussite des définitions de bloc.																;
;																													;

(defun c:ATTPROPERTIES	(/	*error*   flt_tbl   vla-collection->list   get-att-list   ListBox   str2lst   lst2str   dcl_accept   dcl_help   dcl_PAtoCI   LM:RGB->True   LM:RGB->ACI   LM:acapp;--- Définition locale de fonctions	;;
			jsel																		;--- Variables locales pour	jeux de sélection	;;
			name   file																	;--- Variables locales pour	nom d'entités		;;
			lst   att-list   tmp-list															;--- Variables locales pour	listes			;;
			att   tag   value   filename   p														;--- Variables locales pour	chaînes de caractères	;;
			i   n   c   dcl_ID   r   g   b   e   s														;--- Variables locales pour	valeurs numériques	;;
			input   stop   x   v   a															;--- Variables locales pour	entrées utilisateur	;;
			; *BdD-Return*																	;--- Variables globales pour conservations des données	;;
		)

(prompt (strcat "\n[]============= LANCEMENT DE ATTPROPERTIES =============[]"
		"\nInitialisation en cours..."
		"\n"
	)
)

;; Début de la définition de la fonction (*error*), qui est une fonction AutoCAD existante donc impérativement la déclarer en variable locale !											;;
(defun *error* (msg)

	(if file (setq file (close file)))				;--- Ferme le fichier .dcl si ouvert															;;
	(if filename (setq filename (vl-file-delete filename)))		;--- Supprime le fichier .dcl si existant														;;
	(prompt msg)							;--- Affiche l'erreur qu'AutoCAD a enregistré en dernier												;;
	(princ)

) ; End of (defun *error*)																									;;

;; Début de la définition de la fonction (flt_tbl) 																						;;
(defun flt_tbl (tbl search / lst name)

	(while (setq name (tblnext tbl (not name)))
		(if (wcmatch (strcase (setq name (cdr (assoc 2 name)))) (strcase search))
			(setq lst (cons name lst))
		)
	)
	lst
	
) ; End of (defun flt_tbl)																									;;

;; Début de la définition de la fonction (vla-collection->list) 																				;;
(defun vla-collection->list (collection / lst)

	(vlax-for item collection
		(setq lst (cons (cons (vla-get-name item) (vlax-vla-object->ename item)) lst))
	)
	(reverse lst)

) ; End of (defun vla-collection->list)																								;;

; Début de la définition de la fonction (get-att-list) 																						;;
(defun get-att-list (name / ent att-list)

	(if (= (cdr (assoc 0 (entget name))) "BLOCK")
		(progn
			(setq ent (cdr (assoc -2 (entget name))))
			(while ent
				(if (= (cdr (assoc 0 (entget ent))) "ATTDEF")
					(setq att-list (cons (cdr (assoc 2 (entget ent))) att-list))
				)
				(setq ent (entnext ent))
			)
		)
	)
	att-list

) ; End of (defun get-att-list)																									;;

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

) ; End of (defun ListBox)																									;;

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

) ; End of (defun str2lst)																									;;

;; Début de la définition de la fonction (lst2str)																						;;
(defun lst2str (lst sep pos)

        (if pos
		(vl-string-right-trim sep (apply 'strcat (mapcar '(lambda (s) (strcat s sep)) lst)))
		(vl-string-left-trim sep (apply 'strcat (mapcar '(lambda (s) (strcat sep s)) lst)))
	)

) ; End of (defun str2lst)																									;;

;; Début de la définition de la fonction (Remove-Double)																					;;
(defun Remove-Double (lst1 / lst2)

	(while (car lst1)
		(setq Lst2 (cons (car lst1) lst2)
		      Lst1 (vl-remove (car lst1) lst1)
		)
	)
	(reverse lst2)

) ; End of (defun Remove-Double)																								;;

;; Début de la définition de la fonction (dcl_accept)																						;;
(defun dcl_accept (att-list lst / a r)

	(foreach a (reverse att-list)
		(if (= (get_tile a) "1")
			(setq r (cons (list a (nth (atoi (get_tile (strcat "pa:" a))) (mapcar 'car lst)) (atoi (get_tile (strcat "ci:" a)))) r))
		)
	)
	r

) ; End of (defun dcl_accept)																									;;

;; Début de la définition de la fonction (dcl_help)																						;;
(defun dcl_help (/ p)

	(alert	(strcat	"La commande ATTPROPERTIES permet l'édition de certaines propriétés à partir de la valeur des attributs spécifiés pour chaque référence de bloc."
			"\nPour se faire, il suffit de renseigner les attributs à prendre en compte et de leur relation avec les propriétés via cette boîte de dialogue."
			"\nElle se décompose en 3 colonnes distinctes :"
			"\n[]**********************************************************************[]"
			"\n   \"Liste des attributs\" :"
			"\n        Permet de sélectionner le(s) attributs que l'on souhaite utiliser pour redéfinir les propriétés des références de blocs."
			" Pour cela, une simple case à cocher/décocher permet d'activer ou non la relation vers la propriété."
			"\n[]**********************************************************************[]"
			"\n   \"Propriété associée\" :"
			"\n        Permet de sélectionner dans une liste déroulante l'une des propriétés modifiable que l'on souhaite redéfinir en fonction de la valeur de l'attribut situé à sa gauche."
			" Pour cela, choisir la propriété adaptée à notre besoin dans la liste des choix possibles (cf. ci-dessous). Attention à bien sélectionner les propriétés pour déclencher la 3ème colonne type !"
			"\n[]**********************************************************************[]"
			"\n   \"Compléments d'information\" :"
			"\n        Certaines propriétés peuvent s'avérer plus complexes que d'autres et nécessitent un certain formatage ou d'informations supplémentaires pour fonctionner correctement."
			" En fonction du nom de la propriété, ces informations complémentaires seront requises autrement la liste déroulante sera grisée."
			"\n"
			"\nVoici la liste actuelle des propriétés définies :"
			(apply 'strcat (mapcar '(lambda (p) (strcat "\n   - " (car p) ", acceptant les valeurs comme suit :" (caddr p))) lst))
			"\n***L'aide concernant la définition des valeurs acceptées par le programme en fonction des propriétés est en cours d'édition !***"
			"\n"
			"\nAuteur(e)	: Luna"
			"\nDate		: 05/03/2021"
			"\nVersion	: 1.1.0"
		)
	)

) ; End of (defun dcl_help)																									;;

;; Début de la définition de la fonction (dcl_PAtoCI)																						;;
(defun dcl_PAtoCI (v a /)

	(cond
		((= v "0")
			(mode_tile (strcat "ci:" a) 0)
			(start_list (strcat "ci:" a))
			(mapcar 'add_list '("AutoCAD Color Index" "RGB"))
			(end_list)
		)
		((member v '("9" "10" "11"))
			(mode_tile (strcat "ci:" a) 0)
			(start_list (strcat "ci:" a))
			(mapcar 'add_list '("Echelle non uniforme" "Echelle uniforme"))
			(end_list)
		)
		((= v "12")
			(mode_tile (strcat "ci:" a) 0)
			(start_list (strcat "ci:" a))
			(mapcar 'add_list '("Degrés" "Grades"))
			(end_list)
		)
		(t
			(mode_tile (strcat "ci:" a) 1)
			(start_list (strcat "ci:" a))
			(mapcar 'add_list '(""))
			(end_list)
		)
	)

) ; End of (defun dcl_PAtoCI)																									;;

;; RGB -> True  -  Lee Mac																									;;
;; Args: r,g,b - [int] Red, Green, Blue values																							;;
(defun LM:RGB->True ( r g b )

	(logior (lsh (fix r) 16) (lsh (fix g) 8) (fix B))

) ; End of (defun LM:RGB->True)																									;;

;; RGB -> ACI  -  Lee Mac																									;;
;; Args: r,g,b - [int] Red, Green, Blue values																							;;
(defun LM:RGB->ACI ( r g b / c o )

	(if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
		(progn
			(setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g B) (vla-get-colorindex o))))
			(vlax-release-object o)
			(if (vl-catch-all-error-p c)
				(prompt (strcat "\nError: " (vl-catch-all-error-message c)))
				c
			)
		)
	)

	(defun LM:acapp nil

		(eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
		(LM:acapp)

	)

) ; End of (defun LM:RGB->ACI)																									;;

;;																												;;
;; Définition de la liste de correspondance entre les noms de propriété et le code DXF référent																	;;
;;																												;;
(setq lst
	(list
;;;		"Général"				; "General"																					;;
	      (list	"Couleur"		;	"Color"																					;;
			62			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique dont sa partie entière est comprise entre 0 et 256 (= option \"ACI\")"				;		;;
				"\n|		ou bien une suite de 3 nombres répondant au même critère précédent et séparés par une \",\" (= Option \"RGB\", aucun espace toléré !)."				;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			Option AutoCAD Color Index (ACI) -> \"0\", \"256\", \"144\", \"10\", \"12.3\", \"7\", ..."								;		;;
				"\n|			Option Red,Green,Blue (RGB) -> \"0,0,0\", \"255,122,74\", ... (si un autre séparateur est utilisé, la couleur ne pourra pas être redéfinie)"		;		;;
				"\n|		Les valeurs \"DuCalque\" et \"DuBloc\" sont respectivement \"256\" et \"0\" en option ACI, toutes autres valeurs ne seront pas fonctionnelles."			;		;;
			)			;																						;;
	      )	; 	End of "Color"																								;;
	      (list	"Calque"		;	"Layer"																					;;
			8			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter tout type de valeur à l'exception des caractères spéciaux (\"#\", \"@\", \".\", \"*\", \"?\", \"~\", \"`\", ...)."	;		;;
				"\n|		Si le nom de calque n'existe pas dans la liste de calques du dessin courant, un nouveau calque portant ce nom sera alors créé avec les propriétés par défaut."	;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0\", \"Calque n°1\", \"144\", ..."															;		;;
			)			;																						;;
	      )	; 	End of "Layer"																								;;
	      (list	"Type de ligne"		;	"Linetype"																				;;
			6			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute chaîne de caractères appartenant à la liste suivante, correspondant à la liste des types de lignes du dessin :"	;		;;
				"\n|		"																				;		;;
				(vl-string-right-trim "\", " (apply 'strcat (mapcar '(lambda (l) (strcat "\"" (car l) "\", "))											;		;;
				(vla-collection->list (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)))))))											;		;;
				"\n|		Des valeurs n'appartenant pas à la liste ci-dessus ne seront pas fonctionnelles !"										;		;;
			)			;																						;;
	      )	;	 End of "Linetype"																							;;
	      (list	"Epaisseur de ligne"	;	"Lineweight"																				;;
			370			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique correspondant à l'épaisseur en mm multipliée par 100 (entiers uniquement)."			;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0.13 mm\" correspond à une valeur de \"13\", \"1.58 mm\" correspond à une valeur de \"158\", ..."							;		;;
				"\n|		Les valeurs \"DuCalque\", \"DuBloc\" et \"Par Défaut\" sont respectivement \"-1\", \"-2\" et \"-3\", toutes autres valeurs ne seront pas fonctionnelles."	;		;;
			)			;																						;;
	      )	; 	End of "Lineweight"																							;;
	      (list	"Transparence"		;	"Transparency"																				;;
			440			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique dont sa partie entière est comprise entre 0 et 90."						;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0\", \"14\", \"88\", ..."																;		;;
				"\n|		Les valeurs \"DuCalque\" et \"DuBloc\" sont respectivement \"\" et \"100\", toutes autres valeurs ne seront pas fonctionnelles."				;		;;
			)			;																						;;
	      )	; 	End of "Transparency"																							;;
;;;		"Visualisation 3D"			; "3D Visualization"																				;;
	      (list	"Matériau"		;	"Material"																				;;
			347			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute chaîne de caractères appartenant à la liste suivante, correspondant à la liste des matériaux du dessin :"	;		;;
				"\n|		"																				;		;;
				(vl-string-right-trim "\", " (apply 'strcat (mapcar '(lambda (l) (strcat "\"" (car l) "\", "))											;		;;
				(vla-collection->list (vla-get-materials (vla-get-activedocument (vlax-get-acad-object)))))))											;		;;
				"\n|		Des valeurs n'appartenant pas à la liste ci-dessus ne seront pas fonctionnelles !"										;		;;
			)			;																						;;
	      )	; 	End of "Material"																							;;
;;;		"Géométrie"				; "Geometry"																					;;
	      (list	"Position X"		;	"Position X"																				;;
			10			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant au coordonnées absolues dans le repère SCG."		;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0.000\", \"43.4856\", \"-453.4865\", ..."														;		;;
			)			;																						;;
	      )	; 	End of "Position X"																							;;
	      (list	"Position Y"		;	"Position Y"																				;;
			10			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant au coordonnées absolues dans le repère SCG."		;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0.000\", \"43.4856\", \"-453.4865\", ..."														;		;;
			)			;																						;;
	      )	; 	End of "Position Y"																							;;
	      (list	"Position Z"		;	"Position Z"																				;;
			10			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant au coordonnées absolues dans le repère SCG."		;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"0.000\", \"43.4856\", \"-453.4865\", ..."														;		;;
			)			;																						;;
	      )	;	 End of "Position Z"																							;;
	      (list	"Echelle X"		;	"Scale X"																				;;
			41			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant à une coefficient d'échelle."				;		;;
				"\n|		Il est possible de choisir l'option \"Echelle uniforme\" pour affecter la même valeur d'échelle dans l'axe X, Y et Z."						;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"1.000\", \"0.4856\", \"-5.72\", ..."														;		;;
				"\n|		Un bloc ayant été créé en échelle uniforme (propriétés de mise à l'échelle Y et Z grisées) peut tout de même posséder des valeurs d'échelle non uniforme."	;		;;
			)			;																						;;
	      )	; 	End of "Scale X"																							;;
	      (list	"Echelle Y"		;	"Scale Y"																				;;
			42			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant à une coefficient d'échelle."				;		;;
				"\n|		Il est possible de choisir l'option \"Echelle uniforme\" pour affecter la même valeur d'échelle dans l'axe X, Y et Z."						;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"1.000\", \"0.4856\", \"-5.72\", ..."														;		;;
				"\n|		Un bloc ayant été créé en échelle uniforme (propriétés de mise à l'échelle Y et Z grisées) peut tout de même posséder des valeurs d'échelle non uniforme."	;		;;
			)			;																						;;
	      )	; 	End of "Scale Y"																							;;
	      (list	"Echelle Z"		;	"Scale Z"																				;;
			43			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant à une coefficient d'échelle."				;		;;
				"\n|		Il est possible de choisir l'option \"Echelle uniforme\" pour affecter la même valeur d'échelle dans l'axe X, Y et Z."						;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			-> \"1.000\", \"0.4856\", \"-5.72\", ..."														;		;;
				"\n|		Un bloc ayant été créé en échelle uniforme (propriétés de mise à l'échelle Y et Z grisées) peut tout de même posséder des valeurs d'échelle non uniforme."	;		;;
			)			;																						;;
	      )	; 	End of "Scale Z"																							;;
;;;		"Divers"				; "Miscs"																					;;
	      (list	"Rotation"		;	"Rotation"																				;;
			50			;																						;;
			(strcat	"\n|		Cette propriété est en mesure d'accepter toute valeur numérique positive ou négative et correspondant à un angle de rotation."					;		;;
				"\n|		Deux options sont alors possibles pour déterminer le type d'angle souhaité (en fonction du domaine d'application), qui sont \"Degrés\" et \"Grades\"."		;		;;
				"\n|		Exemples :"																			;		;;
				"\n|			Option Degrés -> Le programme considère l'axe de 0° dans la direction Est du SCG et une rotation dans le sens trigonométrique."				;		;;
				"\n|			\"90\", \"21.14\", \"-5.72\", ... l'angle spécifié correspond ainsi à l'angle d'AutoCAD affiché"							;		;;
				"\n|			Option Grades -> Le programme considère l'axe de 0g dans la direction Nord du SCG et une rotation dans le sens des aiguilles d'une montre."		;		;;
				"\n|			\"90\", \"21.14\", \"-5.72\", ... l'angle spécifié correspond ainsi à l'angle d'AutoCAD affiché"							;		;;
				"\n|		Le programme ne prend pas en compte les unités angulaires actuellement formatés dans le dessin en cours."							;		;;
			)			;																						;;
	      )	; 	End of "Rotation"																							;;
	)
) ; End of (list [...]) servant de base pour l'écriture du fichier																				;;
(setq tmp-list (flt_tbl "BLOCK" "*")			;--- Génère la liste de l'ensemble des définitions de blocs du dessin courant												;;
)
;;																												;;
;; Définitition obligatoire d'un bloc de référence et récuperation de l'EffectiveName du bloc ainsi que la liste des attributs de ce dernier											;;
;;																												;;
(while
	(not (and
		(cond
			( (and	*BdD-Return*			; Dans le cas d'un second lancer, permet d'utiliser l'ancienne valeur par défaut										;;
				(not	(progn
						(if input (prompt (strcat "\nBloc(s) référent(s) = " (lst2str input ", " t))))
						(initget "Nom Stop")
						(setq stop (entsel (strcat "\nSélectionner le bloc référent [ Nom / Stop ] <" (car *BdD-Return*) "> : ")))
					)
				)
			  )
				(setq stop "Stop"
				      input (str2lst (car *BdD-Return*) ",")
				)
			)
			( (and	(not *BdD-Return*)		; Dans le cas du premier lancement de la commande, aucune valeur par défaut											;;
				(progn
					(if input (prompt (strcat "\nBloc(s) référent(s) = " (lst2str input ", " t))))
					(initget "Nom Stop")
					(setq stop (entsel "\nSélectionner le bloc référent [ Nom / Stop ] : "))
				)
			  )
				stop
			)
			(input t)
		)
		(cond
			((= stop "Nom")			; Si l'on choisi le keyword "Nom", permet de sélectionner un nom de bloc via BdD											;;
				(setq stop
					(ListBox "Sélection du/des bloc(s) de référence"
						 "Veuillez choisir le nom du/des bloc(s) de référence :"
						 tmp-list
						 nil
						 2
					)		;--- Génération d'une boîte de dialogue pour la sélection d'un bloc de référence											;;
				)
				(if input (setq input (append input stop)) (setq input stop))
				(setq stop "Stop")
				input
			)
			((listp stop)			; Si l'utilisateur a sélectionné un objet dans le dessin et non un keyword												;;
				(setq stop (car stop))
				(if (and (= (cdr (assoc 0 (entget stop))) "INSERT")	;--- Vérifie qu'il s'agit d'un bloc													;;
					 (assoc 66 (entget stop))			;--- Vérifie qu'il possède des attributs												;;
				    )
					(setq stop (getpropertyvalue stop "BlockTableRecord/Name"))	;--- Récupération de l'EffectiveName											;;
					(setq stop nil)					;--- Retour dans la boucle car objet incorrect												;;
				)
				(if input (setq input (append input (list stop))) (setq input (list stop)))
			)
			((= (type input) 'STR)		; Si l'utilisateur utilise la valeur par défaut, déjà fonctionnelle auparavant												;;
				(setq input (list input))
			)
			( (and	(= stop "Stop")
				input
			  )
				input
			)
		)
		(= stop "Stop")
		(setq name (mapcar '(lambda (n) (tblobjname "BLOCK" n)) input))	; Vérification de l'existance d'un bloc portant ce nom												;;
		(setq att-list (remove-double (apply 'append (mapcar 'get-att-list name))))	; Récupération de la liste de l'ensemble des noms d'attributs de la définition de bloc						;;
	)) ; End of (not (and [...] ) )																								;;
	(prompt "\nSélection invalide.")
) ; End of (while [...] ) destiné à la sélection obligatoire d'un bloc de référence pour récupérer le nom et la liste des attributs du bloc											;;

;;																												;;
;; Ecriture du fichier .dcl temporaire et lancement de la boîte de dialogue pour la bonne exécution du programme														;;
;;																												;;
(if (and
	(setq filename (vl-filename-mktemp "DCL-ATTPROPERTIES.dcl"))
	(setq file (open filename "W"))
	(mapcar
		'(lambda (l) (write-line l file))
		(list
			(strcat "BdDAttProperties:dialog {label=\"Boîte de dialogue : Attribution des propriétés de \\\"" (lst2str input ", " t) "\\\"\";")
			(strcat "	:row {")
			(strcat "		:boxed_column {")
			(strcat "			label= \"Liste des attributs\";")
			(strcat "			fixed_width= true;")
			(strcat "			width= " (itoa (+ (apply 'max (mapcar 'strlen att-list)) 5)) ";")
			(apply 'strcat	(mapcar
						'(lambda (a)
			(strcat "			:toggle{" "\n"
				"				label= \"\\\"" a "\\\"\";" "\n"
				"				key= \"" a "\";" "\n"
				"			}"
			)
						)
						(vl-sort att-list '<)
					) ; End of (mapcar [...]) destiné à générer une case à cocher pour chaque attribut													;;
			) ; End of (apply [...]) pour l'adaptativité de la boîte de dialogue en fonction des attributs du bloc référent												;;
			(strcat "		}")
			(strcat "		:boxed_column {")
			(strcat "			label= \"Propriété associée\";")
			(strcat "			fixed_width= true;")
			(strcat "			width= " (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'car lst))) 5)) ";")
			(apply 'strcat	(mapcar
						'(lambda (p)
			(strcat "			:popup_list{" "\n"
				"				key= \"pa:" p "\";" "\n"
				"			}"
			)
						)
						(vl-sort att-list '<)
					) ; End of (mapcar [...]) destiné à générer une liste déroulante pour chaque attribut													;;
			) ; End of (apply [...]) pour l'adaptativité de la boîte de dialogue en fonction des attributs du bloc référent												;;
			(strcat "		}")
			(strcat "		:boxed_column {")
			(strcat "			label= \"Complément d'information\";")
			(strcat "			fixed_width= true;")
			(strcat "			width= " (itoa 30) ";")
			(apply 'strcat	(mapcar
						'(lambda (c)
			(strcat "			:popup_list{" "\n"
				"				label= \"Type \";" "\n"
				"				key= \"ci:" c "\";" "\n"
				"			}"
			)
						)
						(vl-sort att-list '<)
					) ; End of (mapcar [...]) destiné à générer une liste déroulante pour chaque attribut													;;
			) ; End of (apply [...]) pour l'adaptativité de la boîte de dialogue en fonction des attributs du bloc référent												;;
			(strcat "		}")
;;				(strcat "		:slider{")																					;;
;;				(strcat "			key= \"Scroll\";")																			;;
;;				(strcat "			layout= vertical;")																			;;
;;				(strcat "			small_increment= 1;")																			;;
;;				(strcat "			big_increment= " (itoa (length att-list)) ";")																;;
;;				(strcat "			value= " (itoa (length att-list)) ";")																	;;
;;				(strcat "			max_value= " (itoa (length att-list)) ";")																;;
;;				(strcat "		}")																						;;
			(strcat "	}")
			(strcat "	:spacer{}")
			(strcat "	ok_cancel_help;")
			(strcat "}")
		) ; End of (list [...]) déterminant chaque ligne à écrire dans le fichier .dcl																	;;
	) ; End of (mapcar [...]) destiné à l'écriture adaptative de la boîte de dialogue en fonction des attributs du bloc référent												;;
	(null (close file))
	(> (setq dcl_ID (load_dialog filename)) 0)
	(new_dialog "BdDAttProperties" dcl_ID)
    ) ; End of (and [...]) destiné à la création, écriture et chargement du fichier .dcl temporaire																;;
	(progn
		(foreach att (setq att-list (vl-sort att-list '<))
			(start_list (strcat "pa:" att))
			(mapcar 'add_list (mapcar 'car lst))
			(end_list)
			(set_tile att "0")
			(if (and *BdD-Return*
				 (= (car *BdD-Return*) (lst2str input "," t))
				 (member att (mapcar 'car (cdr *BdD-Return*)))
			    )
				(progn
					(set_tile att "1")
					(set_tile (strcat "pa:" att) (itoa (vl-position (cadr (assoc att (cdr *BdD-Return*))) (mapcar 'car lst))))
					(mode_tile (strcat "pa:" att) 0)
					(dcl_PAtoCI (itoa (vl-position (cadr (assoc att (cdr *BdD-Return*))) (mapcar 'car lst))) att)
					(set_tile (strcat "ci:" att) (itoa (last (assoc att (cdr *BdD-Return*)))))
				)
				(progn
					(mode_tile (strcat "pa:" att) 1)
					(mode_tile (strcat "ci:" att) 1)
				)
			)
			(action_tile att
				(strcat	"(if (= \"1\" $value)
						(progn
							(mode_tile \"pa:" att "\" 0)
							(mode_tile \"ci:" att "\" 0)
						)
						(progn
							(mode_tile \"pa:" att "\" 1)
							(mode_tile \"ci:" att "\" 1)
						)
					)"
				)
			)
			(action_tile (strcat "pa:" att)
					(strcat	"(cond
							((= $value \"0\")
								(mode_tile (strcat \"ci:" att "\") 0)
								(start_list (strcat \"ci:" att "\"))
								(mapcar 'add_list '(\"AutoCAD Color Index\" \"RGB\"))
								(end_list)
							)
							((member $value '(\"9\" \"10\" \"11\"))
								(mode_tile (strcat \"ci:" att "\") 0)
								(start_list (strcat \"ci:" att "\"))
								(mapcar 'add_list '(\"Echelle non uniforme\" \"Echelle uniforme\"))
								(end_list)
							)
							((= $value \"12\")
								(mode_tile (strcat \"ci:" att "\") 0)
								(start_list (strcat \"ci:" att "\"))
								(mapcar 'add_list '(\"Degrés\" \"Grades\"))
								(end_list)
							)
							(t
								(mode_tile (strcat \"ci:" att "\") 1)
								(start_list (strcat \"ci:" att "\"))
								(mapcar 'add_list '(\"\"))
								(end_list)
							)
						)"
					)
			)
		)
		(action_tile "accept" "(setq att-list (dcl_accept att-list lst)) (done_dialog 1)")
		(action_tile "cancel" "(setq att-list nil) (done_dialog 0)")
		(action_tile "help" "(dcl_help)")
		(start_dialog)
		(unload_dialog dcl_ID)
		(setq filename (vl-file-delete filename))
		(if (and att-list
			 (setq *BdD-Return* (cons (setq input (lst2str input "," t)) att-list))										; Conservation des données paramétrées dans la BdD	;;
			 (null (prompt (strcat "\nVeuillez sélectionner les blocs du nom de \"" input "\", ENTER pour sélectionner toutes les occurrences.")))
			 (or (setq jsel (ssget (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat input ",`*U*")))))	; Sélection Niveau 1 -> Sélection manuelle filtrée sur des blocs avec attributs et nom correct (ou dyn)	;;
			     (setq jsel (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat input ",`*U*")))))	; Sélection Niveau 2 -> Sélection totale filtrée sur les blocs avec attributs et nom correct (ou dyn)	;;
			 )
		    )
			(progn
				(repeat (setq c 0 n 0 s 0 e 0 i (sslength jsel))
					(setq name (ssname jsel (setq i (1- i))))
					(if (and (member (getpropertyvalue name "BlockTableRecord/Name") (str2lst input ",")) (setq c (1+ c))); Vérification de l'EffectiveName pour la prise en compte des blocs dynamiques	;;
						(mapcar
							'(lambda (att / tag property info value)
								(setq tag (car att)
								      property (cadr att)
								      info (caddr att)
								      value (getpropertyvalue name tag)
								)
								(cond
									((= property (car (nth 0 lst)))		; Propriété "Color"												;;
										(cond
											( (and	(= info 1)								; Type "R,G,B"						;;
												(wcmatch value "*`,*`,*")
												(setq p (vl-string-position (ascii ",") value))
												(setq r (substr value 1 p))
												(setq g (substr value (+ 2 p) (- (vl-string-position (ascii ",") value nil t) (1+ p))))
												(setq b (substr value (+ 2 (vl-string-position (ascii ",") value nil t))))
												(apply 'and (mapcar '(lambda (c) (and (>= (atoi c) 0) (<= (atoi c) 256))) '(r g B)))
											  )
												(if (assoc 62 (entget name))		; Code DXF "ACI Color" (facultatif)							;;
													(if (entmod (subst (cons 62 (LM:RGB->ACI (atoi r) (atoi g) (atoi B))) (assoc 62 (entget name)) (entget name)))
														(setq n (+ n 0.5))
													)
													(if (entmod (append (entget name) (list (cons 62 (LM:RGB->ACI (atoi r) (atoi g) (atoi B))))))
														(setq n (+ n 0.5))
													)
												)
												(if (assoc 420 (entget name))		; Code DXF "TrueColor" (facultatif)							;;
													(if (entmod (subst (cons 420 (LM:RGB->True (atoi r) (atoi g) (atoi B))) (assoc 420 (entget name)) (entget name)))
														(setq n (+ n 0.5))
													)
													(if (entmod (append (entget name) (list (cons 420 (LM:RGB->True (atoi r) (atoi g) (atoi B))))))
														(setq n (+ n 0.5))
													)
												)
											)
											((and (= info 0) (distof value) (>= (atoi value) 0) (<= (atoi value) 256))	; Type "AutoCAD Color Index (ACI)"			;;
												(if (assoc 62 (entget name))		; Code DXF "ACI Color" (facultatif)							;;
													(if (entmod (subst (cons 62 (atoi value)) (assoc 62 (entget name)) (vl-remove (assoc 420 (entget name)) (entget name))))
														(setq n (1+ n))
													)
													(if (entmod (append (entget name) (list (cons 62 (atoi value)))))
														(setq n (1+ n))
													)
												)
											)
										)
									) ; End of "Color" property																;;
									((= property (car (nth 1 lst)))		; Propriété "Layer"												;;
										(if (entmod (subst (cons (cadr (nth 1 lst)) value) (assoc (cadr (nth 1 lst)) (entget name)) (entget name)))
											(setq n (1+ n))
										)
									) ; End of "Layer" property																;;
									( (and	(= property (car (nth 2 lst)))	; Propriété "Linetype"												;;
										(member (strcase value) (mapcar 'strcase (append (flt_tbl "LTYPE" "*") '("DuCalque" "ByLayer" "DuBloc" "ByBlock"))))
									  )
										(if (assoc (cadr (nth 2 lst)) (entget name))		; Code DXF (facultatif)									;;
											(if (entmod (subst (cons (cadr (nth 2 lst)) value) (assoc (cadr (nth 2 lst)) (entget name)) (entget name)))
												(setq n (1+ n))
											)
											(if (entmod (append (entget name) (list (cons (cadr (nth 2 lst)) value))))
												(setq n (1+ n))
											)
										)
									) ; End of "Linetype" property																;;
									( (and	(= property (car (nth 3 lst)))	; Propriété "Lineweight"											;;
										(distof value)
									  )
										(if (assoc (cadr (nth 3 lst)) (entget name))		; Code DXF (facultatif)									;;
											(if (entmod (subst (cons (cadr (nth 3 lst)) (atoi value)) (assoc (cadr (nth 3 lst)) (entget name)) (entget name)))
												(setq n (1+ n))
											)
											(if (entmod (append (entget name) (list (cons (cadr (nth 3 lst)) (atoi value)))))
												(setq n (1+ n))
											)
										)
									) ; End of "Lineweight" property															;;
									( (and	(= property (car (nth 4 lst)))	; Propriété "Transparency"											;;
										(distof value)			; ATTENTION LA TRANSPARENCE EST ACTUELLEMENT NON FONCTIONNELLE !						;;
										(>= (atoi value) -2)		; ATTENTION LA TRANSPARENCE EST ACTUELLEMENT NON FONCTIONNELLE !						;;
										(<= (atoi value) 90)		; ATTENTION LA TRANSPARENCE EST ACTUELLEMENT NON FONCTIONNELLE !						;;
									  )
									) ; End of "Transparency" property															;;
									( (and	(= property (car (nth 5 lst)))	; Propriété "Material"												;;
										(member	value (setq tmp-list (vla-collection->list (vla-get-materials (vla-get-activedocument (vlax-get-acad-object))))))
										(setq value (cdr (assoc value tmp-list)))
									  )
										(if (assoc (cadr (nth 5 lst)) (entget name))		; Code DXF (facultatif)									;;
											(if (entmod (subst (cons (cadr (nth 5 lst)) value) (assoc (cadr (nth 5 lst)) (entget name)) (entget name)))
												(setq n (1+ n))
											)
											(if (entmod (append (entget name) (list (cons (cadr (nth 5 lst)) value))))
												(setq n (1+ n))
											)
										)
									) ; End of "Material" property																;;
									( (and	(= property (car (nth 6 lst)))	; Propriété "Position_X"											;;
										(distof value)
										(setq value (list (distof value) (caddr (assoc (cadr (nth 6 lst)) (entget name))) (last (assoc (cadr (nth 6 lst)) (entget name)))))
									  )
										(if (entmod (subst (cons (cadr (nth 6 lst)) value) (assoc (cadr (nth 6 lst)) (entget name)) (entget name)))
											(setq n (1+ n))
										)
									) ; End of "Position_X" property															;;
									( (and	(= property (car (nth 7 lst)))	; Propriété "Position_Y"											;;
										(distof value)
										(setq value (list (cadr (assoc (cadr (nth 7 lst)) (entget name))) (distof value) (last (assoc (cadr (nth 7 lst)) (entget name)))))
									  )
										(if (entmod (subst (cons (cadr (nth 7 lst)) value) (assoc (cadr (nth 7 lst)) (entget name)) (entget name)))
											(setq n (1+ n))
										)
									) ; End of "Position_Y" property															;;
									( (and	(= property (car (nth 8 lst)))	; Propriété "Position_Z"											;;
										(distof value)
										(setq value (list (cadr (assoc (cadr (nth 8 lst)) (entget name))) (caddr (assoc (cadr (nth 8 lst)) (entget name))) (distof value)))
									  )
										(if (entmod (subst (cons (cadr (nth 8 lst)) value) (assoc (cadr (nth 8 lst)) (entget name)) (entget name)))
											(setq n (1+ n))
										)
									) ; End of "Position_Z" property															;;
									( (and	(= property (car (nth 9 lst)))	; Propriété "Scale_X"												;;
										(distof value)
									  )
										(cond
											( (and	(= info 1)								; Type "Echelle uniforme"				;;
												(entmod (subst (cons (cadr (nth 9 lst)) (distof value)) (assoc (cadr (nth 9 lst)) (entget name)) (entget name)))	; X	;;
												(entmod (subst (cons (cadr (nth 10 lst)) (distof value)) (assoc (cadr (nth 10 lst)) (entget name)) (entget name)))	; Y	;;
												(entmod (subst (cons (cadr (nth 11 lst)) (distof value)) (assoc (cadr (nth 11 lst)) (entget name)) (entget name)))	; Z	;;
											  )
												(setq n (1+ n))
											)
											((= info 0)									; Type "Echelle non uniforme"				;;
												(if (entmod (subst (cons (cadr (nth 9 lst)) (distof value)) (assoc (cadr (nth 9 lst)) (entget name)) (entget name)))	; X	;;
													(setq n (1+ n))
												)
											)
										)
									) ; End of "Scale_X" property																;;
									( (and	(= property (car (nth 10 lst)))	; Propriété "Scale_Y"												;;
										(distof value)
									  )
										(cond
											( (and	(= info 1)								; Type "Echelle uniforme"				;;
												(entmod (subst (cons (cadr (nth 9 lst)) (distof value)) (assoc (cadr (nth 9 lst)) (entget name)) (entget name)))	; X	;;
												(entmod (subst (cons (cadr (nth 10 lst)) (distof value)) (assoc (cadr (nth 10 lst)) (entget name)) (entget name)))	; Y	;;
												(entmod (subst (cons (cadr (nth 11 lst)) (distof value)) (assoc (cadr (nth 11 lst)) (entget name)) (entget name)))	; Z	;;
											  )
												(setq n (1+ n))
											)
											((= info 0)									; Type "Echelle non uniforme"				;;
												(if (entmod (subst (cons (cadr (nth 10 lst)) (distof value)) (assoc (cadr (nth 10 lst)) (entget name)) (entget name)))	; Y	;;
													(setq n (1+ n))
												)
											)
										)
									) ; End of "Scale_Y" property																;;
									( (and	(= property (car (nth 11 lst)))	; Propriété "Scale_Z"												;;
										(distof value)
									  )
										(cond
											( (and	(= info 1)								; Type "Echelle uniforme"				;;
												(entmod (subst (cons (cadr (nth 9 lst)) (distof value)) (assoc (cadr (nth 9 lst)) (entget name)) (entget name)))	; X	;;
												(entmod (subst (cons (cadr (nth 10 lst)) (distof value)) (assoc (cadr (nth 10 lst)) (entget name)) (entget name)))	; Y	;;
												(entmod (subst (cons (cadr (nth 11 lst)) (distof value)) (assoc (cadr (nth 11 lst)) (entget name)) (entget name)))	; Z	;;
											  )
												(setq n (1+ n))
											)
											((= info 0)									; Type "Echelle non uniforme"				;;
												(if (entmod (subst (cons (cadr (nth 11 lst)) (distof value)) (assoc (cadr (nth 11 lst)) (entget name)) (entget name)))	; Z	;;
													(setq n (1+ n))
												)
											)
										)
									) ; End of "Scale_Z" property																;;
									( (and	(= property (car (nth 12 lst)))	; Propriété "Rotation"												;;
										(distof value)
									  )
										(cond
											( (and	(= info 1)								; Type "Grades" (0g = Nord | sens = non-trigo)		;;
												(entmod (subst (cons (cadr (nth 12 lst)) (/ (* (- 100.0 (distof value)) pi) 200.0)) (assoc (cadr (nth 12 lst)) (entget name)) (entget name)))
											  )
												(setq n (1+ n))
											)
											( (and	(= info 0)								; Type "Degrés" (0g = Est | sens = trigo)		;;
												(entmod (subst (cons (cadr (nth 12 lst)) (/ (* (distof value) pi) 180.0)) (assoc (cadr (nth 12 lst)) (entget name)) (entget name)))
											  )
												(setq n (1+ n))
											)
										)
									) ; End of "Rotation" property																;;
								) ; End of (cond [...]) destiné à redéfinir les propriétés													;;
							)
							att-list
						)
						(setq jsel (ssdel name jsel))		; Dans le cas d'un bloc dynamique, supprime l'entité du jeu de sélection si l'EffectiveName est différent				;;
					)
					(cond
						((= (rtos n) (rtos (length att-list))) (setq s (1+ s)))
						((and (< n (length att-list)) (> n 0)) (setq e (1+ e)))
						((= n 0) (setq jsel (ssdel name jsel)))
					)
				)
				(command "_ATTSYNC" "N" input)				; Pour mettre à jour la position des attributs ne se mettant pas à jour obligatoirement après modification de la liste DXF		;;
				(prompt (strcat "\nFin de l'exécution..."
						"\nUn total de "
						(if (and (= s 0) (> e 0))
							""
							(strcat (itoa s)
								" / "
								(itoa c)
								" bloc(s) traité(s) avec succès"
							)
						)
						(if (or (= 0 s e) (and (> s 0) (> e 0)))
							" et "
							""
						)
						(if (/= s c)
							""
							(strcat	(itoa e)
								" / "
								(itoa c)
								" bloc(s) ont été partiellement traité(s)"
							)
						)
						", dénommé(s) \""
						input
						"\" à partir des attributs suivants :"
						(apply 'strcat (mapcar '(lambda (a) (strcat "\n   - " (car a))) att-list))
					)
				)
				(sssetfirst nil jsel)
			)
		)
	)
	(exit)
)
(princ)

)

 

C'est très brouillon et le risque d'erreur est plus élevé (nombre d'attribut trop importants, type de valeur différent selon le nom du bloc, etc) mais bon...Pour le coup je n'ai pas fait l'intersection des listes d'attributs, c'est uniquement si l'attribut existe il prend la nouvelle valeur sinon on s'en moque. Et ainsi on peut modifier des blocs même s'ils ne possède pas l'attribut en question. A voir, sinon je ferais une intersection si c'est inutile et trop lourd en terme de BdD.

 

Bisous,

Luna

Lien vers le commentaire
Partager sur d’autres sites
  • Réponses 62
  • Créé
  • Dernière réponse

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Messages populaires

Steven
Steven

Salut Luna, Je viens de découvrir ton lisp. Je ne dirais qu'une seule chose... TOP !!!

Images postées

Luna Experienced

Luna

Posté(e)
Posté(e)

Lorsque tu dois sélectionner tes blocs, as-tu l'option "Stop" ?

La manière dont j'ai procédé, c'est de conserver la sélection existante donc on sélectionne les références une à une si on fait chat à la souris dans l'espace objet (tu dois avoir la liste des blocs sélectionnés au dessus de ta ligne de commande), et auquel cas, tu boucles dans la sélection singulière jusqu'à choisir l'option "Stop". Sinon tu choisis l'option "Nom" pour sélectionner toutes tes références depuis le nom du bloc et dans ce cas, tu le fait via une BdD de sélection multiple.

Dans le cas d'un second lancement de commande, tu as l'option par défaut qui sélectionnera selon les anciens paramètres.

 

La sélection unique de plusieurs ref' en même temps nécessite beaucoup plus de modification et une question supplémentaire...à voir si cela est viable mais encore une fois...l'écriture de la BdD n'est ABSOLUMENT pas adaptée pour fonctionner avec 150 attributs donc le but c'est justement de limiter le nombre de références de blocs...

 

Bisous,

Luna

Lien vers le commentaire
Partager sur d’autres sites
  • 4 semaines après...
Steven Rising Star

Steven

Posté(e)
Posté(e)

Salut Luna,

Je viens de découvrir ton lisp.

Je ne dirais qu'une seule chose...

TOP !!!

content-29.gif

  • Like 1

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites
Steven Rising Star

Steven

Posté(e)
Posté(e)

J'ai dû louper un truc.

J'avais créé deux blocs avec 2 noms différents.

Je les ai supprimé puis purger.

J'ai créé un nouveau bloc avec un nouveau nom et quand je lance lisp, il garde en valeur par défaut les noms des deux anciens blocs. Lorsque je sélectionne le nouveau, j'ai çà comme retour: 

type d'argument incorrect: lentityp nil

 

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites
Luna Experienced

Luna

Posté(e)
Posté(e)

Coucou,

Normalement le programme conserve le(s) nom(s) des blocs utilisés lors du dernier lancement de la commande. Donc le(s) nom(s) précédemment utilisés sont proposés par défaut mais rien n'empêche d'en choisir d'autres à la place normalement...

Je regarderais chat plus en détails plus tard, mais il ne me semble pas que le programme interdise la sélection d'un autre bloc si on ne veut pas la valeur par défaut...

Ce qui est sûr c'est que le soucis vient donc du (entget) car un (entsel) n'a pas réussi à récupérer le nom d'un bloc...
As-tu une idée de la ligne qui génère ce bug ? sinon je regarderais chat ce we.

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets


×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité