Luna

J'ai vu chat, c'est parfait ! Merci beaucoup ! ♥ Bisous, Luna

Coucou, La commande FUSCALQUE fonctionne parfaitement bien en effet ce qui permet par exemple de passer les anciens calques sur les récents ou bien de les fusionner sur le calque "0". Il existe une méthode beaucoup plus..."bourrine" mais avec une perte de données : SUPCALQUE. A utiliser avec précaution car cette commande supprime définitivement le calque, peu importe ce qu'il y a dessus. Donc si le but c'est de supprimer un calque (et donc les objets situés dessus), c'est parfait ! Sinon, FUSCALQUE permet de "sauvegarder" les éventuels objets sur un autre calque. Mais aucunes de ces méthodes permettent d'aller à la pêche aux informations malheureusement donc si tu veux faire un traitement manuel des objets pour soit les sauvegarder dans un autre calque, soit les supprimer, il faudra créer un programme :3 3 choix possibles donc : 1°) Supprimer définitivement un calque et ses occupants (purge complète) -> SUPCALQUE 2°) Supprimer définitivement un calque en sauvegardant ses occupants sur un autre -> FUSCALQUE 3°) Repérer les occupants d'un calque pour traitement manuel -> (à créer) 4°) La réponse D ^^ Je te laisse faire ton choix :3 Bisous, Luna

Coucou, Dans les petits bonus qui pourraient être intéressant pour "améliorer" la fluidité du forum, se serait d'avoir la barre des menus (en haut du site) en mode fixe par rapport à l'écran. Le même principe que l'on pourrait avoir sur un classeur excel et que l'on fige une colonne ou une rangée, si l'on défile les cellules, les colonnes (ou rangées) figées restent visibles sans cesse. Cela permettrait de ne plus avoir à remonter tout en haut de la page pour accéder de nouveau au menu, profil, search, etc :3 Je trouve dommage que l'on ne puisse plus voir directement dans le forum/topic les personnes présentes sur cette page, c'est plutôt pratique car d'un simple coup d'oeil on pouvait savoir si une réponse/question a été vue et si une réponse est finalement déjà en cours d'édition ^^" Pour la partie "code", une barre de défilement horizontale (lorsque le code est plus large que la fenêtre d'affichage) et/ou un bouton pour sélectionner l'ensemble du code présent dans une fenêtre de code (bon je reconnais que cette fonctionnalité je l'ai découverte sur le site de LeeMac et il faut reconnaître que c'est bien pratique lorsqu'on veut copier/coller un programme un peu long dans un éditeur pour le tester ^^" Ce sera tout pour moi ! Bisous, Luna

le (str2lst) fonctionne très bien avec les "#" (excepté justement pour le " perdu au milieu de la chaîne qui génère une erreur, mais si on n'en tient pas compte, tout baigne !) :3

Coucou, Alors premièrement si on regarde la liste DXF d'un calque ayant une couleur ACI (de 0 à 255) On sait que le code DXF associé est le code DXF 62 (ici 1 = "rouge"). Cependant, une couleur RGB fait appel à un code supplémentaire, le code 420 : Et si on pousse encore plus loin, les catalogues font appel au code 430 en plus (format 'STR)...Bref, plus la couleur devient complexe, et plus sa liste DXF se complexifie ! Après je pense à cela sous forme de liste DXF, mais étant donné que tu utilises les (command) et non (entmake), cela ne correspond qu'à une simple solution de contournement, à voir A quel moment ton programme ne fonctionne pas exactement ? La (command) fonctionne bien chez moi donc après le soucis peut provenir d'ailleurs...tu es sûr que chaque ligne de ton fichier correspond à une définition d'un seul et unique calque ? Car tu fais la vérification sur le (cadr ListLine) pour la "," mais possiblement que ton (cadr) ne pointe pas la couleur obligatoirement et auquel cas, le format n'est pas le bon donc échec de la (command)... De plus j'ai remarqué sur ton exemple de fichier que l'un de tes nom de calque possède un ", donc cela peut complètement break la chaîne de caractère et générer une erreur...^^" Bisous, Luna

Je ne vois pas de code spécifique dédié à la définition de l'unité d'affichage donc selon moi, avec une facteur de conversion de 1.0 ("cf") les valeurs d'aires sont exprimées en fonction de l'unité métrique définie dans le dessin (INSUNITS). Mais bon après AutoCAD ne fait pas de "conversion" métrique lorsqu'on modifie le format en cours de route, il fonctionne en nombre d'unités sans tenir compte de l'unité définie (par exemple, une ligne de longueur 10 fera 10m si INSUNITS vaut 6 et 10mm si l'on change INSUNITS à 4). Autrement dit, il n'y a aucune raison que les valeurs inscrites dans la table diffère des valeurs inscrites dans le fichier ou même des valeurs récupérables via les propriétés de l'objet. J'ai lancé le programme sur une dessin simple et le résultat est identique, que se soit la table ou le fichier... Donc je ne saurais expliquer que ton fichier possède des résultats en m², la table affiche des résultats en mm² alors que les propriétés de l'objet devraient afficher l'aire en cm² >w< Désolée ^^"

Coucou, Si je comprends bien la démarche de LeeMac lors de la création de son programme, la partie "Adjustement" correspondant à la définition fixée des variables permet de jouer sur certains paramètres sans forcément de demander à l'utilisateur de les définir à chaque utilisation. De ce fait, la variable cf 1.0 ;; Area Conversion Factor (e.g. 1e-6 = mm2->m2) permet de définir le facteur (avec un exemple pour le passage de mm² en m², il faut un facteur de 1e-6). Ce facteur est appliqué strictement de la même manière, que se soit pour la création du fichier ou de la table...via : (strcat ap (rtos (* cf (vla-get-area p1)) 2) as) et (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as) Je suppose donc qu'en modifiant la première ligne (dans la partie "Adjustement") sur le facteur correspondant cela devrait pouvoir régler le soucis. Cependant, c'est étrange que le programme répertorie les résultats avec une unité différentes selon la commande étant donnée que le facteur utilisé est identique...Cela peut éventuellement provenir de la valeur de la variable système INSUNITS (les unités métriques du dessins) qui va influer le résultat dans un cas et pas dans l'autre...Tu es bien à 4 pour INSUNITS ou bien à 6 ? Bisous, Luna

Et bien tout ce que je puis dire c'est.. excellent travail !! Cette remise à neuf est vraiment prometteuse <3 Bisous, Luna

Je poste également cette petite fonction qui permet d'alléger la lecture des listes (mais cela reste limiter par le nombre de ligne autorisées dans l'historique de commandes) : ;--- Nom de la fonction []-----------------------[] prompt-list []-----------------------[] ;--- Date de création > 08/03/2021 ;--- Dernière modification > 22/03/2021 ;--- Auteur(e) > Luna ;--- Version > 1.0.0 ;--- Classe > "BaLst" ;--- But et domaine d'application ; ; > Permet d'afficher une liste de manière plus lisible dans l'historique de commande en ajoutant des alinéas. ; ; ; ;--- Déclaration des arguments ; ; La fonction (prompt-list) possède 2 argument(s) : ; ; ¤ lst > correspond à la liste que l'on souhaite afficher ; ; (type lst) = 'LST | Ex. : (entget (entlast)), ((0 1) 2 (3 4) (5 6 7) 8 (9)), ... ; ; ¤ fun > correspond au tri qu'on désire appliquer à la liste et correspond à la fonction associée à (vl-sort) ; ; (type fun) = 'SYM | Ex. : '<, '>, '(lambda (x) ...), ... ; ; ; ;--- Retour ; ; La fonction (prompt-list) renvoie nil, cependant elle permet d'afficher son résultat au fur et à mesure de son exécution dans ; ; l'historique de commande. ; ; Ex. : (prompt-list (entget (entlast)) nil) renvoie nil, en affichant sur la ligne de commande : ; ; ( ; ; (-1 . <Nom d'entité: 414a0c40>) ; ; (0 . "INSERT") ; ; (5 . "30342C") ; ; (102 . "{ACAD_XDICTIONARY") ; ; (360 . <Nom d'entité: 414a0c50>) ; ; (102 . "}") ; ; (330 . <Nom d'entité: 414a0940>) ; ; (100 . "AcDbEntity") ; ; (67 . 1) ; ; (410 . "Présentation4") ; ; (8 . "0") ; ; (62 . 5) ; ; (48 . 0.1) ; ; (100 . "AcDbBlockReference") ; ; (2 . "*U1890") ; ; ( ; ; 10 ; ; 267.0 ; ; 390.0 ; ; 0.0 ; ; ) ; ; (41 . 1.0) ; ; (42 . 1.0) ; ; (43 . 1.0) ; ; (50 . 0.513301) ; ; (70 . 0) ; ; (71 . 0) ; ; (44 . 0.0) ; ; (45 . 0.0) ; ; ( ; ; 210 ; ; 0.0 ; ; 0.0 ; ; 1.0 ; ; ) ; ; ) ; ; ; ;--- Modifications apportées par rapport à la version précédente ; ; > Création de la fonction. ; ; ; (defun prompt-list (lst fun / space l i) (defun space (n / str) (setq str "") (repeat n (setq str (strcat str " ")) ) str ) (defun lstprompt (lst / l) (prompt (strcat "\n" (space (* (1- i) 3)) "(")) (foreach l (if fun (vl-sort lst fun) lst) (if (and (listp l) (vl-list-length l)) (progn (setq i (1+ i)) (lstprompt l) (setq i (1- i))) (prompt (strcat "\n" (space (* i 3)) (vl-prin1-to-string l))) ) ) (prompt (strcat "\n" (space (* (1- i) 3)) ")")) ) (setq i 1) (lstprompt lst) (princ) ) Bisous, Luna

Coucou, Dans un premier temps, un grand merci pour votre travail afin de faire vivre ce site (ou plutôt forum, car il s'agit parfaitement de cela !) car cela représente beaucoup de temps et d'efforts qui restent bien trop souvent dans l'ombre ! C'est une très bonne nouvelle de voir que le forum continue de vivre à travers le temps et ce depuis sa création, il est une référence pour un grand nombre de métiers et de personnes qui partagent les mêmes centres d'intérêts et passion ! Je suppose que cela est encore un peu tôt et que ces mises à jours ont provoqués quelques erreurs donc c'est surtout pour informer : Suis-je la seule à ne plus pouvoir accéder au forum "LISP & Visual LISP" ? (Alors que je peux accéder aux sous-forums, ce qui ne fait aucun sens..) Encore merci ! Bisous, Luna

Coucou, Afin d'apprendre la gestion des listes DXF et la manière dont on peut récupérer certaines infos en fonction des types d'entités, j'ai bien souvent été obligée de regarder les listes DXF de ces entités via (entget). Le soucis c'est que l'affichage de ces listes se font sur une seule ligne et lorsqu'il faut se balader d'une entité à une autre, cela peut s'avérer un peu long et fastidieux >w< Ce n'est que récemment que je me suis écrit cette fonction (je suis une quiche en récursivité donc c'est forcément optimisable/améliorable mais bon...^^") pour me faciliter mes recherches et études d'entités AutoCAD. Je me suis dit que cela pourrait éventuellement intéresser quelques personnes donc je la poste ici :3 ;--- Nom de la fonction []-----------------------[] Explore-DXF []-----------------------[] ;--- Date de création > 22/02/2021 ;--- Dernière modification > 05/04/2021 ;--- Auteur(e) > Luna ;--- Version > 2.1.0 ;--- Classe > "DtObj" ;--- But et domaine d'application ; ; > ; ; ; ;--- Déclaration des arguments ; ; La fonction (Explore-DXF) possède 3 argument(s) : ; ; ¤ entlist > correspond à la list DXF de l'entité que l'on souhaite explorer. ; ; (type entlist) = 'LST | Ex. : (entget (car (entsel))), (entget (car (entsel)) "*"), ... ; ; ; ; ¤ n > correspond au nombre limite de niveau d'exploration que l'on autorise. Cela peut permettre d'éviter ; ; les boucles intempestives lors de l'exploration ou bien de limiter le temps d'exécution de la fonction. ; ; Cette variable doit donc forcément être un nombre entier positif, sachant que les risques de boucles ; ; peuvent survenir à presque tous les niveaux, à partir du niveau 3 ou plus. ; ; (type n) = 'INT | Ex. : 1, 2, 5, ... ; ; ; ; ¤ lst > correspond à la liste des codes DXF que l'on souhaite développer pour l'exploration, permettant de ; ; filtrer certains codes DXF que l'on peut juger superflus pour l'exploration en cours. ; ; (type lst) = 'LST | Ex. : '(330 331 340 350 360), '(330 360), ... ; ; ; ; ¤ flag > permet de définir si l'on souhaite générer un fichier .txt pour l'extraction et la sauvegarde des ; ; données. ; ; (type flag) = 'SYM | Ex. : T si l'on souhaite l'export, nil sinon. ; ; ; ;--- Retour ; ; La fonction (Explore-DXF) renvoie l'ensemble des listes DXF des entités correspondant à la recherche demandée dans l'historique ; ; de commande sous forme de liste lisible et ordonnée. La fonction en elle même ne renvoie rien à la fin de l'exécution. ; ; Ex. : (explore-dxf (car (entsel)) 1 '(330 340 350 360) T) renvoie ; ;Explore DXF in progress from "CIRCLE" (<Nom d'entité: 88a0a680>) : ; ; (-1 . <Nom d'entité: 88a0a680>) ; ; (0 . CIRCLE) ; ; (330 . <Nom d'entité: 37f2c9f0>) ; ; (5 . 4924D0) ; ; (100 . AcDbEntity) ; ; (67 . 0) ; ; (410 . Model) ; ; (8 . UBS-900-Fenêtre de Présentation) ; ; (48 . 0.5) ; ; (100 . AcDbCircle) ; ; (10 1.90099e+06 3.16223e+06 236.333) ; ; (40 . 1.1) ; ; (210 0.0 0.0 1.0) ; ; ; ;-> "BLOCK_RECORD" (<Nom d'entité: 37f2c9f0>) at 330 code, from "CIRCLE" object : ; ; (-1 . <Nom d'entité: 37f2c9f0>) ; ; (0 . BLOCK_RECORD) ; ; (5 . 1F) ; ; (102 . {ACAD_XDICTIONARY) ; ; (360 . <Nom d'entité: 37f2dcd0>) ; ; (102 . }) ; ; (330 . <Nom d'entité: 37f2c810>) ; ; (100 . AcDbSymbolTableRecord) ; ; (100 . AcDbBlockTableRecord) ; ; (2 . *Model_Space) ; ; (360 . <Nom d'entité: 37f2ca00>) ; ; (340 . <Nom d'entité: 37f2ca20>) ; ; (70 . 0) ; ; (280 . 1) ; ; (281 . 0) ; ; ; ;End of exploration... ; ; ; ;--- Modifications apportées par rapport à la version précédente ; ; > Ajout de la variable flag et de la possibilité de générer un fichier .txt pour l'extraction et la sauvegarde des données DXF. ; ; ; (defun Explore-DXF (entlist n lst flag / space DXF-prompt entlist e i file str s c) (defun space (n / str) (setq str "") (repeat n (setq str (strcat str " ")) ) str ) ;; End of (defun space) (defun DXF-prompt (entlist i code e / str e) (setq str (strcat s (itoa c) "." (space (* i 2)) "\"" (cdr (assoc 0 entlist)) "\" (" (vl-prin1-to-string (cdr (assoc -1 entlist))) ") at " (itoa code) " code, from \"" e "\" object : " ) ) (if (and flag file str ) (write-line (strcat "\n" str "\n") file) (prompt (strcat "\n" str "\n|")) ) (mapcar '(lambda (e) (setq str (strcat (space (+ (* (1+ i) 2) 5)) (vl-prin1-to-string e))) (if (and flag file str ) (write-line str file) (prompt (strcat str "\n|")) ) ) entlist ) (if (<= (setq i (1+ i)) n) (progn (setq s (strcat s (itoa c) ".") c 0 ) (foreach e entlist (cond ((and (member (car e) lst) (= (type (cdr e)) 'ENAME) (entget (cdr e)) (setq c (1+ c)) ) (DXF-prompt (entget (cdr e)) i (car e) (cdr (assoc 0 entlist))) ) ) ) (if (< (strlen s) 3) (setq c 0 s "" ) (setq c (atoi (substr s (+ 2 (vl-string-position (ascii ".") (substr s 1 (1- (strlen s))) nil t)) (1- (strlen s)))) s (substr s 1 (1+ (vl-string-position (ascii ".") (substr s 1 (1- (strlen s))) nil t))) ) ) ) ) (setq i (1- i)) ) ;; End of (defun DXF-prompt) (setq i 0 s "" c 0 ) (setq str (strcat "Explore DXF in progress from \"" (cdr (assoc 0 entlist)) "\" (" (vl-prin1-to-string (cdr (assoc -1 entlist))) ") : " ) ) (if (and flag (setq file (getfiled "Save file - DXF export" (strcat (getvar "DWGPREFIX") (rtos (getvar "CDATE") 2 0) "_" (vl-filename-base (getvar "DWGNAME")) " - " (cdr (assoc 0 entlist)) ".txt") "txt" 45 ) ) (setq file (open file "w")) str ) (write-line (strcat str "\n") file) (prompt (strcat "\n" str "\n|")) ) (mapcar '(lambda (e) (setq str (strcat (space (+ i 6)) (vl-prin1-to-string e))) (if (and flag file str ) (write-line str file) (prompt (strcat str "\n|")) ) ) entlist ) (if (> n 0) (foreach e entlist (cond ((and (member (car e) lst) (= (type (cdr e)) 'ENAME) (entget (cdr e)) (setq c (1+ c)) ) (DXF-prompt (entget (cdr e)) (setq i 1) (car e) (cdr (assoc 0 entlist))) ) ) ) ) (if (and flag file ) (write-line "\nEnd of exploration..." file) (prompt "\nEnd of exploration...") ) (if (and file (not (close file)) ) (prompt "\nFile has been created !") ) (princ) ) A vrai dire, je remercie VDH-Bruno car je me suis inspirée d'un de ses messages pour écrire cette fonction :) Explore-DXF (2.1.0 - 05-04-2021).LSP Bisous, Luna

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

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

Hihi ♥ Une fois que je suis lancée, j'ai bien du mal à m'arrêter donc je vais tout de même regarder la possibilité de prendre en compte plusieurs blocs différents, j'ai un peu peur dans le cas où, le nombre d'attributs est trop important et les dimensions de la BdD dépassent des limites visibles de l'écran (j'ai le même problème avec ma fenêtre "help") et du coup je ne sais pas comment ajouter un scroller sur une BdD (mais l'exercice est intéressant ^^) Donc nah, je vais tout de même essayer d'améliorer un peu ce programme :3 Pour la fonctionnalité inverse, à voir si j'ai le courage de le faire >o< Mais merci beaucoup de te préoccuper de ma petite personne, c'est gentil ! :) Bisous, Luna

Coucou, Le soucis actuel c'est que l'écriture de la BdD se fait sur une liste d'attribut récupérée à partir d'un bloc, donc si l'on sélectionne plusieurs blocs, comment construire cette liste ? Faut-il prendre uniquement les attributs en communs, ou bien tous les attributs de tous les blocs ? La sélection de plusieurs blocs ne permettra probablement pas la conservation des données et donc le remplissage par défaut lors de la sélection du bloc référent ou du remplissage de la BdD... Je peux essayer de creuser le sujet mais je vais avoir besoin d'infos sur le rendu attendu et les modifications acceptables :3 Bisous, Luna

Vouih je comprend tout à fait, à vrai dire je n'ai pas compris si le problème se pose au moment de l'Autoload des fichiers LISP ou bien à l'utilisation des commandes LISP développées par Denis pour pouvoir insérer correctement les blocs devant se trouver dans un dossier spécifique. Ma solution ne s'applique que pour la partie blocs (cela suppose que le chemin de support a été spécifié). En revanche, si le but c'est de charger les fichiers LISP alors je ne vois pas le problème d'utiliser la commande APPLOAD et spécifier le fichier via la valise) >w< Ce n'est pas compliqué et de toute façon, on y est un peu obligé, quelque soit l'emplacement du fichier.. Bisous, Luna

Mais cela suppose que le chemin de recherche des fichiers de support a été spécifié par l'utilisateur...et j'avoue ne pas bien comprendre, tu dois être en mesure de trouver le dossier qui contient les lisps, ou bien celui qui contient les blocs ? Et surtout, si vous ne possédez aucun dossiers partagés, comment s'assurer que tous les utilisateurs ont bien la dernière version de tes fichiers ? Parce que si les chemins de support n'ont pas été spécifié, cela risque d'être un casse tête chinois >w< Bisous, Luna

Coucou, Essaye de ce côté-ci : (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object)))) Avec l'éditeur LISP et l'espion à partir de l'objet (vlax-get-acad-object), on peut se balader comme on veut depuis l'espion (ce qui m'a permis de retrouver chat !) donc en utilisant le séparateur ";" pour décomposer les chemins de recherches, tu devrais pouvoir isoler les chemins spécifiques pour retrouver ton emplacement "\MesLisp\Blocs" et recomposer le chemin complet en fonction des machines :3 Bisous, Luna

Je vois vouih, cependant je ne vois pas vraiment l'intérêt de faire "Prop2Att" > "ATTOUT" > modification > "ATTIN" > "AttProperties"... Mais autrement je comprends parfaitement l'utilité d'une fonction reverse, c'est toujours utile ! N'ayant pas cette utilisation des blocs dans mon travail, j'ai un peu de mal à voir les cas concrets d'utilisation de ces commandes mais au vu de la demande, je suppose qu'il y en a plusieurs :3 Bon du coup j'ai corrigé quelques bugs que j'ai pu rencontrer et (bon le message d'aide il va falloir que je regarde pour une list_box avec scroller mais mes compétences en DCL sont trop limitées... ;--- Nom de la commande []-----------------------[] AttProperties []-----------------------[] ; ;--- Date de création > 02/03/2021 ; ;--- Dernière modification > 05/03/2021 ; ;--- Auteur(e) > Luna ; ;--- Version > 1.1.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 get-att-list ListBox 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 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 / str2lst tmp file DCL_ID 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) ) ) ; End of (defun str2lst) ;; (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) ;; ;; 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 (initget "Nom") (setq input (entsel (strcat "\nSélectionner le bloc référent [ Nom ] <" (car *BdD-Return*) "> : "))) ) ) ) (setq input (car *BdD-Return*)) ) ( (and (not *BdD-Return*) ; Dans le cas du premier lancement de la commande, aucune valeur par défaut ;; (progn (initget "Nom") (setq input (entsel "\nSélectionner le bloc référent [ Nom ] : ")) ) ) input ) (input t) ) (cond ((= input "Nom") ; Si l'on choisi le keyword "Nom", permet de sélectionner un nom de bloc via BdD ;; (setq input (ListBox "Sélection du bloc de référence" "Veuillez choisir le nom du bloc de référence" tmp-list nil 1 ) ;--- Génération d'une boîte de dialogue pour la sélection d'un bloc de référence ;; ) ) ((listp input) ; Si l'utilisateur a sélectionné un objet dans le dessin et non un keyword ;; (setq input (car input)) (if (and (= (cdr (assoc 0 (entget input))) "INSERT") ;--- Vérifie qu'il s'agit d'un bloc ;; (assoc 66 (entget input)) ;--- Vérifie qu'il possède des attributs ;; ) (setq input (getpropertyvalue input "BlockTableRecord/Name")) ;--- Récupération de l'EffectiveName ;; (setq input nil) ;--- Retour dans la boucle car objet incorrect ;; ) ) ((= (type input) 'STR) input) ; Si l'utilisateur utilise la valeur par défaut, déjà fonctionnelle auparavant ;; ) (setq name (tblobjname "BLOCK" input)) ; Vérification de l'existance d'un bloc portant ce nom ;; (setq att-list (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 \\\"" input "\\\"\";") (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 " }") (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*) input) (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 input 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 (= input (getpropertyvalue name "BlockTableRecord/Name")) (setq c (1+ c))); Vérification de l'EffectiveName avec le bloc référent 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) ) Avec cela, je prends en compte tes remarques donc désormais les blocs ayant fonctionné totalement ou partiellement seront sélectionnés à la fin, tu as un retour plus précis sur la réussite ou non de la commande par rapport au nombre de blocs portant le bon nom dans la sélection ! Bon il reste toujours ce soucis de transparence que je n'arrive pas à inverser... Mise à part cela, je pense que cette version est relativement stable (si on fait abstraction du message d'aide qui n'est pas lisible dans sa globalité...) Bisous, Luna

Coucou, Merci pour tes retours ! Vouih actuellement je n'ai défini aucune vérification sur la modification réussi ou échouée sur les blocs donc aucun compteur réel de blocs modifiés... J'ai prévu de le rajouter (lorsque j'aurais compris mon problème de n, sûrement un (setq n (1+ n)) en dehors d'un (defun) sur un fichier autoload...) mais je voulais justement savoir si un simple "88 /105 blocs ont été modifiés avec succès" ou si je devais ajouter "Bloc ... (Handle_ID : ...), échec de la modification de propriété \"...\" pour la valeur d'attribut \"...\"" pour chaque erreur rencontrée en gros ^^" Pour la visualisation des blocs modifiés (une fois la vérification de modification réussie), je ne pense pas qu'une couleur forcée soit la solution car cela serait contradictoire avec la propriété "Couleur" redéfinissable... En revanche, ce que je fais très souvent sur mes programmes c'est de rendre active la sélection finale afin de pouvoir les isoler ensuite pour un check-up plus rapide :3 Concernant la propriété de rotation, j'ai pris comme hypothèse tes commentaires Donc je ne tiens absolument pas compte des unités angulaires du dessin (je pourrais pour la valeur par défaut dans la liste), et si on choisi l'option "Degrés" alors on a l'axe à 0° vers l'Est et sens trigo alors que l'option "Grades" on aura l'axe à 0g vers le Nord et sens inverse trigo (donc angle différent entre les propriétés et la valeur d'attribut) Je commence également à me poser la question sur le fait que les propriétés dynamiques d'un bloc pourrait également servir de redéfinition de certaines propriétés... (je pense notamment à une boussole ayant une propriété angulaire qui pourrait définir sa rotation) mais bon, il s'agit là de version 2.0 voire 3.0 ! faudrait déjà que je termine la 1.0 xD Bisous, Luna

Coucou, J'ai remarqué l'existence d'un code très intéressant, le code DXF 66 ! Je n'avais pas bien fait attention à ceci mais si un bloc possède des attributs, ce code 66 vaut 1, sinon ce code 66 n'existe pas. Autrement dit, pour un programme qui nécessite obligatoirement de bloc avec attributs ce code est du pain béni car il supprime de ce fait les réseaux anonymisés mais conserve les blocs dynamiques ! Bref j'ai tout de même filtre le nom des blocs comme avant (l'effectiveName + les blocs dynamiques) pour ne conserver que les blocs standard avec la bonne dénomination ou tous les blocs dynamique pour vérifier ensuite. Mais en éjectant les réseaux, je n'ai plus de problème d'erreur sur la récupération de l'EffectiveName donc normalement de ce côté-ci, aucun problème ! Je suis actuellement en train de fournir davantage d'informations utile via le bouton "Help" pour justement savoir le formatage autorisé en fonction des propriétés. Cela permettra d'y voir un peu plus clair ^^" Est-il utile de récupérer une liste beaucoup plus détaillée sur les blocs modifiés (comme par exemple, pour chaque bloc marquer si la liste n'a été mise à jour par rapport à telle propriété pour telle valeur ?) ou cela est suffisant ? Je suis un peu une maniaque des retours sur ligne de commandes donc c'est toujours bien d'avoir un avis externe pour le coup xD Ravie que cette version fonctionne (enfin) même si du coup chat m'a fait de nombreux ctrl+z >w< Bisous, Luna

Vui, tout était fonctionnel hier soir, puis j'ai eu une soudaine envie de simplifier le code sans re-tester ensuite avant de le publier sur CADxp >w< Pour couronner le tout, j'ai un bug d'incrémentation de variable pour le moins étrange donc il m'est impossible de tester mon programme correctement... ;--- Nom de la commande []-----------------------[] AttProperties []-----------------------[] ; ;--- Date de création > 02/03/2021 ; ;--- Dernière modification > 05/03/2021 ; ;--- Auteur(e) > Luna ; ;--- Version > 1.0.3 ; ;--- 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 ; ; > Correction de bugs mineurs et reprise de la version 1.0.1 en raison d'un bug récurent insolvable ! ; ; ; (defun c:ATTPROPERTIES (/ *error* flt_tbl get-att-list ListBox 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 dcl_ID r g b ;--- Variables locales pour valeurs numériques ;; input 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 (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 / str2lst tmp file DCL_ID 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) ) ) ; End of (defun str2lst) ;; (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) ;; ;; 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))) lst)) "\n" "\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.0.2" ) ) ) ; 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" ;; '("Couleur" 62) ; '("Color" 62) ;; '("Calque" 8) ; '("Layer" 8) ;; '("Type de ligne" 6) ; '("Linetype" 6) ;; '("Epaisseur de ligne" 370) ; '("Lineweight" 370) ;; '("Transparence" 440) ; '("Transparency" 440) ;; ;;; "Visualisation 3D" ; "3D Visualization" ;; '("Matériau" 347) ; '("Material" 347) ;; ;;; "Géométrie" ; "Geometry" ;; '("Position X" 10) ; '("Position X" 10) ;; '("Position Y" 10) ; '("Position Y" 10) ;; '("Position Z" 10) ; '("Position Z" 10) ;; '("Echelle X" 41) ; '("Scale X" 41) ;; '("Echelle Y" 42) ; '("Scale Y" 42) ;; '("Echelle Z" 43) ; '("Scale Z" 43) ;; ;;; "Divers" ; "Miscs" ;; '("Rotation" 50) ; '("Rotation" 50) ;; ) ) (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 (initget "Nom") (setq input (entsel (strcat "\nSélectionner le bloc référent [ Nom ] <" (car *BdD-Return*) "> : "))) ) ) ) (setq input (car *BdD-Return*)) ) ( (and (not *BdD-Return*) ; Dans le cas du premier lancement de la commande, aucune valeur par défaut ;; (progn (initget "Nom") (setq input (entsel "\nSélectionner le bloc référent [ Nom ] : ")) ) ) input ) (input t) ) (cond ((= input "Nom") ; Si l'on choisi le keyword "Nom", permet de sélectionner un nom de bloc via BdD ;; (setq input (ListBox "Sélection du bloc de référence" "Veuillez choisir le nom du bloc de référence" tmp-list nil 1 ) ;--- Génération d'une boîte de dialogue pour la sélection d'un bloc de référence ;; ) ) ((listp input) ; Si l'utilisateur a sélectionné un objet dans le dessin et non un keyword ;; (setq input (car input)) (if (and (= (cdr (assoc 0 (entget input))) "INSERT") ;--- Vérifie qu'il s'agit d'un bloc ;; (assoc 66 (entget input)) ;--- Vérifie qu'il possède des attributs ;; ) (setq input (getpropertyvalue input "BlockTableRecord/Name")) ;--- Récupération de l'EffectiveName ;; (setq input nil) ;--- Retour dans la boucle car objet incorrect ;; ) ) ((= (type input) 'STR) input) ; Si l'utilisateur utilise la valeur par défaut, déjà fonctionnelle auparavant ;; ) (setq name (tblobjname "BLOCK" input)) ; Vérification de l'existance d'un bloc portant ce nom ;; (setq att-list (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 \\\"" input "\\\"\";") (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 " }") (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*) input) (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 input 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 i (sslength jsel)) (setq name (ssname jsel (setq i (1- i)))) (if (= input (getpropertyvalue name "BlockTableRecord/Name")) ; Vérification de l'EffectiveName avec le bloc référent pour la prise en compte des blocs dynamiques ;; (mapcar '(lambda (att / tag property info value n) (setq tag (car att) property (cadr att) info (caddr att) value (getpropertyvalue name tag) n -1 ) (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) ;; (entmod (subst (cons 62 (LM:RGB->ACI (atoi r) (atoi g) (atoi B))) (assoc 62 (entget name)) (entget name))) (entmod (append (entget name) (list (cons 62 (LM:RGB->ACI (atoi r) (atoi g) (atoi B)))))) ) (if (assoc 420 (entget name)) ; Code DXF "TrueColor" (facultatif) ;; (entmod (subst (cons 420 (LM:RGB->True (atoi r) (atoi g) (atoi B))) (assoc 420 (entget name)) (entget name))) (entmod (append (entget name) (list (cons 420 (LM:RGB->True (atoi r) (atoi g) (atoi B)))))) ) ) ((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) ;; (entmod (subst (cons 62 (atoi value)) (assoc 62 (entget name)) (entget name))) (entmod (append (entget name) (list (cons 62 (atoi value))))) ) ) ) ) ; End of "Color" property ;; ((= property (car (nth 1 lst))) ; Propriété "Layer" ;; (entmod (subst (cons (cadr (nth 1 lst)) value) (assoc (cadr (nth 1 lst)) (entget name)) (entget name))) ) ; 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) ;; (entmod (subst (cons (cadr (nth 2 lst)) value) (assoc (cadr (nth 2 lst)) (entget name)) (entget name))) (entmod (append (entget name) (list (cons (cadr (nth 2 lst)) value)))) ) ) ; 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) ;; (entmod (subst (cons (cadr (nth 3 lst)) (atoi value)) (assoc (cadr (nth 3 lst)) (entget name)) (entget name))) (entmod (append (entget name) (list (cons (cadr (nth 3 lst)) (atoi value))))) ) ) ; 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" ;; (not (setq tmp-list nil)) (member (strcase value) (mapcar '(lambda (x) (strcase (car x)) ) (vlax-for x (vla-get-materials (vla-get-activedocument (vlax-get-acad-object))) (setq tmp-list (cons (cons (vlax-get-property x 'Name) (vlax-vla-object->ename x)) tmp-list)) ) ) ) (setq value (cdr (assoc value tmp-list))) ) (if (assoc (cadr (nth 5 lst)) (entget name)) ; Code DXF (facultatif) ;; (entmod (subst (cons (cadr (nth 5 lst)) value) (assoc (cadr (nth 5 lst)) (entget name)) (entget name))) (entmod (append (entget name) (list (cons (cadr (nth 5 lst)) value)))) ) ) ; 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))))) ) (entmod (subst (cons (cadr (nth 6 lst)) value) (assoc (cadr (nth 6 lst)) (entget name)) (entget name))) ) ; 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))))) ) (entmod (subst (cons (cadr (nth 7 lst)) value) (assoc (cadr (nth 7 lst)) (entget name)) (entget name))) ) ; 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))) ) (entmod (subst (cons (cadr (nth 8 lst)) value) (assoc (cadr (nth 8 lst)) (entget name)) (entget name))) ) ; End of "Position_Z" property ;; ( (and (= property (car (nth 9 lst))) ; Propriété "Scale_X" ;; (distof value) ) (cond ((= 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 ;; ) ((= info 0) ; Type "Echelle non uniforme" ;; (entmod (subst (cons (cadr (nth 9 lst)) (distof value)) (assoc (cadr (nth 9 lst)) (entget name)) (entget name))) ; X ;; ) ) ) ; End of "Scale_X" property ;; ( (and (= property (car (nth 10 lst))) ; Propriété "Scale_Y" ;; (distof value) ) (cond ((= 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 ;; ) ((= info 0) ; Type "Echelle non uniforme" ;; (entmod (subst (cons (cadr (nth 10 lst)) (distof value)) (assoc (cadr (nth 10 lst)) (entget name)) (entget name))) ; Y ;; ) ) ) ; End of "Scale_Y" property ;; ( (and (= property (car (nth 11 lst))) ; Propriété "Scale_Z" ;; (distof value) ) (cond ((= 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 ;; ) ((= info 0) ; Type "Echelle non uniforme" ;; (entmod (subst (cons (cadr (nth 11 lst)) (distof value)) (assoc (cadr (nth 11 lst)) (entget name)) (entget name))) ; Z ;; ) ) ) ; End of "Scale_Z" property ;; ( (and (= property (car (nth 12 lst))) ; Propriété "Rotation" ;; (distof value) ) (cond ((= 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))) ) ((= 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))) ) ) ) ; End of "Rotation" property ;; ) ) 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 ;; ) ) (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 " (itoa (sslength jsel)) " bloc(s) dénommés \"" input "\" ont été traités à partir des attributs suivants :" (apply 'strcat (mapcar '(lambda (a) (strcat "\n - " (car a))) att-list)) ) ) ) ) ) (exit) ) (princ) ) Essaye avec cela mais si tu as également la variable n qui s'incrémente à chaque évaluation quelconque, je ne sais pas d'où vient le soucis >n< (j'ai littéralement un (setq n -1) et mon espion est en mesure de me dire n = 1, et si j'ai (setq n -1 i 0 lst nil) alors n = 4 !!?!) Bon je vais abandonner la variable n, elle me plante tout...j'ai corrigé le code qui avait un bug sur la position Z.. Bisous, Luna

Coucou, Disons que l'exercice était vraiment intéressant sur de nombreux points alors mon cerveau moulinait beaucoup trop pour pouvoir dormir correctement et ayant beaucoup de travail, fallait bien trouver des heures libres xD Mais maintenant chat va beaucoup mieux ! D'ailleurs je n'étais pas bien réveillée hier soir car j'ai complètement raté l'utilisation de la fonction (dcl_PAtoCI) et sur la génération de la BdL donc j'ai corrigé le programme (encore) pour qu'il n'y ait plus de soucis :3 Bon après pour le principe, elle reste encore incomplète sur certains point et notamment la définition des valeurs d'attribut, je ne sais pas si les valeurs que j'ai autorisée sont correctes ou bien si l'on peut générer des erreurs. Donc merci pour vos retours ! <3 Bisous, Luna

Coucou, Bon du coup j'ai bien avancé sur la généralisation de la demande avec la commande ATTPROPERTIES : ;; CODE INCORRECT cf. post#32 ;; Donc si une âme charitable était en mesure de me faire cette fonction inverse chat serait vraiment instructif ! <3 Autrement, la commande ci-dessus fonctionne correctement chez moi, mais je n'ai pas forcément le temps de la tester en profondeur et encore moins de la pousser dans ses retranchements pour en déterminer ses limites donc si jamais cela vous intéresse, un petit backup m'aiderait beaucoup ! Je vais essayer de générer une Aide un peu plus fournie pour déterminer les valeurs acceptables par le programme pour fonctionner et également si vous avez des remarques sur d'éventuelles informations supplémentaires (voire fonctionnalités supplémentaires) n'hésitez pas !! Bisous, Luna

Coucou, Question à part mais...pourquoi utiliser des lignes pour former un rectangle fermé (donc 4 objets distincts) alors qu'une polyligne fermée (donc 1 objet) revient strictement au même avec des propriétés supplémentaires ? Si je comprend bien, tu voudrais ne pas avoir à sélectionner toi-même les 4 lignes ? Parce que je ne vois pas vraiment comment sélectionner de manière automatique les 4 lignes qui forment un beau rectangle (ou du moins pas de manière simple). Ne serait-il pas plus simple de sélectionner une ligne et à partir des sommets de cette lignes, sélectionner les 3 lignes suivantes (à la manière de dominos) ? Nous sommes d'accord que les lignes forment un rectangle de manière visible (aucune projection d'intersection à faire pour dessiner le rectangle) ? Pour moi, l'utilisation des polylignes reste la plus appropriée (une commande JOINDRE sur les lignes juxtaposées permettront de générer automatiquement des rectangles et sera plus simple à gérer ensuite).. Parce que au final, le but du programme est d'économiser des clics mais dans l'exécution du programme tel que je le perçois, tu devras cliquer une première fois au centre du rectangle pour sélectionner tes lignes, puis une seconde fois sur un sommet du rectangle pour générer la diagonale et cela pour chacun des rectangles (au mieux)... Or pour dessiner une diagonale, il faut cliquer sur le premier sommet, et sur le second pour chaque rectangle ! Il n'y a aucune économie, ou alors je n'ai pas compris le programme et je m'en excuse >w< Bisous, Luna