Luna

Coucou, Je peux te proposer ceci : (defun c:Layoutname (/ n e c jsel i name txt layout) (setq i 0 e '(3.0 3.0 0.0) c '(40.0 23.0 0.0) n (if (< (setq n (length (layoutlist))) 10) (strcat "0" (itoa n)) (itoa n))) (vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (if (/= (vla-get-name layout) "Model") (vla-put-name layout (strcat "#" (itoa (setq i (1+ i)))))) ) (vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (if (/= (vla-get-name layout) "Model") (progn (vla-put-name layout (setq name (strcat "Folio" (if (< (setq i (vla-get-taborder layout)) 10) (strcat "0" (itoa i)) (itoa i)) "-" n))) (if (and (setq jsel (ssget "_X" (list '(0 . "MTEXT") '(8 . "0") (cons 410 name) '(-4 . ">,>,=") (cons 10 (mapcar '- c e)) '(-4 . "<,<,=") (cons 10 (mapcar '+ c e))))) (= (sslength jsel) 1) (setq txt (ssname jsel 0)) ) (entmod (subst (cons 1 (strcat "FOLIO " (vl-string-subst "/" "-" (substr name 6)))) (assoc 1 (entget txt)) (entget txt))) ) ) ) ) (princ) ) Je ne sais pas vraiment le contexte de ton fichier mais si j'ai bien compris, cela devrait être un bon début je pense. Il faut simplement modifier le code DXF 0 et 8 si jamais ils ne correspondent pas à ton entité texte et ensuite les paramètres pour la sélection des textes (il me semble qu'ils ont une position fixe) tu as les variables c et e. La variable c correspond aux coordonnées arrondies de ton point d'insertion du texte (pas besoin d'être précis au dixième près) et la variable e correspond à la précision de ta sélection. Par exemple sur les valeurs supposées ci-dessus, (40.0 23.0 0.0) signifie que ton point d'insertion du texte est à ces coordonnées (arrondies à l'entier) et (3.0 3.0 0.0) signifie que tu effectues une sélection à +/- 3.0 unités en X ou Y par rapport aux coordonnées (40.0 23.0 0.0). Plus les valeurs de la variable e sont élevées et plus il y a un risque de sélectionner d'autres textes (auquel cas, les textes ne seront pas mis à jour), et inversement si les valeurs sont faibles, alors tu risques de ne pas sélectionner le texte. Il faut donc trouver le juste milieu qui fonctionne correctement avec ton fichier. A savoir que la sélection du texte peut s'effectuer même si le point d'insertion de ton texte ne se situe pas dans la zone de sélection, ce qui compte c'est l'emprise du texte (similaire au masque d'arrière-plan du texte au facteur 1.0). Bisous, Luna

Je pense juste qu'il manque la définition de la fonction (getatt) utilisée par PHILPHIL dans sa commande. Bisous, Luna

Coucou, lili, il me semble que CEP3 n'existe en effet pas, en revanche CEP vouih ^^" Bisous, Luna

Coucou, Je n'avais pas demandé mais si cela provient de la commande "INSERER" uniquement, alors ATTDIA éventuellement qui gère justement la BdD lors de l'insertion d'un bloc... Autrement, je ne vois pas bien d'où le soucis peut provenir.. a ma connaissance, il n'y a que les variables systèmes ATTDIA (spécifique à l'insertion d'un bloc), CMDDIA (pour certaines BdD, mais je n'ai pas la liste des commandes impactées) et FILEDIA (la fenêtre d'exploration des fichiers). Je doute que le soucis proviennent du code LISP étant donné que cela fonctionne sur les autres PC, donc cela vient de l'espace de travail, ou bien de la version d'AutoCAD (mais je doute que vous ayez un seul poste à jour) donc je n'ai pas mieux à te proposer, désolée.. Personnellement rebcao a édité des fichiers PDF excellents répertoriant l'ensemble des variables systèmes ou de problèmes récurrents d'AutoCAD, je te conseille de les consulter : http://www.rebcao.fr/docs-rebcao/variables_systemes_AutoCAD_2Mxx-TOUTES_les_VARIABLES.pdf http://www.rebcao.fr/docs-rebcao/TOP_QUIZ_des_Galeres_AutoCAD_probleme_question_solution.pdf Bisous, Luna

Coucou, Personnellement, j'ai déjà eu à utiliser le "-" devant le nom d'un commande car justement elle n'utilisait pas par défaut la version en ligne de commande du coup j'ai pris l'habitude de toujours appeler les commandes avec "-"... Je rejoins Lecrabe, car AutoCAD 2021 a eu droit à quelques modifications par rapport à l'IDE et à son fonctionnement donc la variable LISPSYS peut avoir des impacts divers.. Autrement as-tu tout de même essayer d'invoquer la commande avec un "-" ? Sinon, tu peux regarder la variable système CMDDIA qui gère l'affichage pour certaines commandes :3 Bisous, Luna

Oki, donc à chaque fois que tu créé, supprime ou modifie l'ordre d'un onglet, il te faut relancer la commande à chaque fois ? Pour l'exemple, voici le programmes et les fonctions que j'utilise : ; Renomme la présentation en fonction des données paramétrées dans le cartouche de la présentation : ;--- Cette commande permet de récupérer le code projet et la phase à partir du nom du fichier DWG de la forme Cxxxx_x_x_* et l'indice projet, la planche et le titre du plan dans le cartouche ;--- On peut soit renommer la présentation active, soit l'ensemble des présentations ;--- On peut soit les renommer de manière détaillée "Cxxxx_x_xxxx-xx_*" soit de manière simplifiée "xxxx.xx" ; Modification le 04/08/2020 - ajout de l'option "Sélection" pour renommer un nombre partiel de présentations (defun c:NAMECART (/ Choix name jsel i Code_Projet Vis_Phase Phase Ind_Projet Planche_Projet Titre_Projet layout-list layout acadDoc acadDocSummaryInfo DWG_name Explode_name Name_List DWG_Prop_Code Name) (setq acadDoc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) acadDocSummaryInfo (vlax-get-property acadDoc 'SummaryInfo) DWG_name (getvar "DWGNAME") Phase (substr DWG_name (+ 2 (vl-string-position (ascii "_") DWG_name)) 1) Code_Projet (substr DWG_name 1 5) ) (cond ((= Phase "S") (setq Vis_Phase "ESQ")) ((= Phase "A") (setq Vis_Phase "APS")) ((= Phase "E") (setq Vis_Phase "APD")) ((= Phase "C") (setq Vis_Phase "DCE")) ((= Phase "X") (setq Vis_Phase "EXE")) ((= Phase "D") (setq Vis_Phase "DOE")) (Phase (setq Vis_Phase "Masquer")) ) (initget "Active Toutes Sélection") (if (null (setq Choix (getkword "\nQuelles présentations souhaitez-vous renommer [Active/Toutes/Sélection] <Active> ? "))) (setq Choix "Active") ) (cond ((= Choix "Active") (if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 (getvar "CTAB"))))) (= (sslength jsel) 1)) (progn (sssetfirst nil nil) (setq name (ssname jsel 0)) (setq Name_List name Att_List (Get-att-list name) Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List))) Planche_Projet (cdr (assoc "PLANCHE" Att_List)) Titre_Projet (cdr (assoc "TITRE_2" Att_List)) ) (if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)))) (setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase) ) (if (or (= Code_Projet "[...]") (= Vis_Phase "Masquer") (= Ind_Projet "") (= Titre_Projet "") (vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*"))) ) (alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation." "\nCela peut provenir des éléments suivants :" "\n - Indice du plan non renseigné" "\n - Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier" "\n - Titre principal comportant des caractères non autorisés" "\n (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )" "\n" "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci." ) ) (progn (initget "Détaillé Simplifié") (if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer la présentation [Détaillé/Simplifié] <Détaillé> ? "))) (setq Type_name "Détaillé") ) (cond ((or (and (= Type_name "Détaillé") (= (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet))) (and (= Type_name "Simplifié") (= (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet))) ) (prompt (strcat "\nLa présentation \"" (getvar "CTAB") "\" possède déjà la bonne dénomination.")) ) ((= Type_name "Détaillé") (Set-layout-name (getvar "CTAB") (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet))) ((= Type_name "Simplifié") (Set-layout-name (getvar "CTAB") (strcat Ind_Projet "-" Planche_Projet))) ) ) ) ) (cond ((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation " (getvar "CTAB") "."))) ((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation " (getvar "CTAB") "."))) ) ) ) ((member Choix '("Toutes" "Sélection")) (progn (cond ((= Choix "Toutes") (setq layout-list (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil)) ) ((= Choix "Sélection") (setq layout-list (ListBox "NAMECART : Sélection des présentations" "Veuillez définir la ou les présentation(s) à renommer :" (DXF_List (vl-remove-if '(lambda (x) (member (strcase x) '("TOOLKIT" "TRAVAIL"))) (layoutlist)) nil nil t nil) (getvar "CTAB") 2 ) ) ) ) (initget "Détaillé Simplifié") (if (null (setq Type_name (getkword "\nComment souhaitez-vous nommer les présentations [Détaillé/Simplifié] <Détaillé> ? "))) (setq Type_name "Détaillé") ) (foreach layout layout-list (if (and (setq jsel (Select-filter "BLC" "Cartouche*" "_X" (list (cons 410 layout)))) (= (sslength jsel) 1)) (progn (sssetfirst nil nil) (setq name (ssname jsel 0)) (setq Name_List (cons name Name_List) Att_List (Get-att-list name) Ind_Projet (vl-string-right-trim " -" (cdr (assoc "N°_DESSIN" Att_List))) Planche_Projet (cdr (assoc "PLANCHE" Att_List)) Titre_Projet (cdr (assoc "TITRE_2" Att_List)) ) (if (null (vl-catch-all-error-p (vl-catch-all-apply 'setpropertyvalue (list name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase)))) (setpropertyvalue name (strcat "AcDbDynBlockProperty" "Visibilité1") Vis_Phase) ) (if (or (= Code_Projet "[...]") (= Vis_Phase "Masquer") (= Ind_Projet "") (= Titre_Projet "") (vl-position t (mapcar '(lambda (x) (wcmatch (strcase Titre_Projet) (strcase x))) '("*`,*" "*`?*" "*`;*" "*`/*" "*`:*" "*`\*" "*`**" "*`=*" "*``*"))) ) (alert (strcat "Le programme a échoué lorsqu'il a renommé la présentation \"" layout "\"." "\nCela peut provenir des éléments suivants :" "\n - Indice du plan non renseigné" "\n - Phase non renseignée ou mal positionnée (7ème caractère) dans le nom du fichier" "\n - Titre principal comportant des caractères non autorisés" "\n (ex : \",\" \"?\" \";\" \"/\" \":\" \"\\\" \"*\" \"=\" \"`\" )" "\n" "\nVeuillez corriger ces informations avant de relancer la commande si une erreur provient bien de l'un de ces éléments, merci." ) ) (cond ((or (and (= Type_name "Détaillé") (= layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet))) (and (= Type_name "Simplifié") (= layout (strcat Ind_Projet "-" Planche_Projet))) ) (prompt (strcat "\nLa présentation \"" layout "\" possède déjà la bonne dénomination.")) ) ((= Type_name "Détaillé") (Set-layout-name layout (strcat Code_Projet "_" Phase "_" Ind_Projet "-" Planche_Projet "_" Titre_Projet))) ((= Type_name "Simplifié") (Set-layout-name layout (strcat Ind_Projet "-" Planche_Projet))) ) ) ) (cond ((or (= jsel nil) (= (sslength jsel) 0)) (alert (strcat "Aucun cartouche n'a été trouvé sur la présentation \"" layout "\"."))) ((> (sslength jsel) 1) (alert (strcat "Plusieurs cartouches se trouvent sur la présentation \"" layout "\"."))) ) ) ) ) ) ) (set-layout-pos) (princ) ) ; Permet de récupérer la liste des présentations sous forme de liste : ;--- La fonction (Get-Layout-list) possède aucun argument ;--- Renvoie une liste composée de paire pointée avec le premier élément de la paire correspondant au nom de la présentation, le second au VLA-Object de cette présentation (defun Get-Layout-list (/ layout layout-list) (vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (setq layout-list (cons (cons (vla-get-name layout) layout) layout-list)) ) (reverse layout-list) ) ; Permet de renommer une présentation sans utiliser la fonction (command) : ;--- La fonction (Set-Layout-Name) possède 2 arguments ;--- layout correspond au nom de la présentation à renommer ;--- name correspond au nouveau nom de la présentation ;--- Renvoie le nouveau nom de la présentation ou nil en cas d'échec (defun Set-Layout-Name (layout name / layout-list) (setq layout-list (get-layout-list)) (if (assoc layout layout-list) (if (not (assoc name layout-list)) (progn (vla-put-name (cdr (assoc layout layout-list)) name) (prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\".")) name ) (progn (while (assoc name layout-list) (cond ((wcmatch name "* (#)") (setq name (strcat (substr name 1 (- (strlen name) 2)) (itoa (1+ (atoi (substr name (1- (strlen name)) 1)))) ")")) ) ((wcmatch name "* (##)") (setq name (strcat (substr name 1 (- (strlen name) 3)) (itoa (1+ (atoi (substr name (- (strlen name) 2) 2)))) ")")) ) (t (setq name (strcat name " (2)")) ) ) ) (vla-put-name (cdr (assoc layout layout-list)) name) (prompt (strcat "\nLa présentation \"" layout "\" a été renommée en \"" name "\".")) name ) ) (progn (prompt (strcat "\nLa présentation \"" layout "\" n'existe pas...")) (princ) ) ) ) ; Récupère une liste de paires pointées de l'ensemble des attributs du bloc spécifié en argument et de leur valeur correspondantes : ;--- La fonction (Get-att-list) possède 1 arguments ;--- e_name correspond au nom de l'entité ciblée ;--- Renvoie une liste de paires pointées composées chacunes du nom de l'attribut et de sa valeur (ex : (("CODEPROJET" "C2244") ("N°_DESSIN" "1030 -") ("TITRE_2" "CALEPINAGE DES MODULES PV")) ) ;; Modification mineure 21/09/2020 (defun Get-att-list (name / Att Att_List) (if (= (cdr (assoc 0 (entget name))) "INSERT") (setq Att_List (mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke (vlax-ename->vla-object name) 'getattributes))) (prompt (strcat "\nErreur : Le nom d'entité spécifié ne fait pas référence à un bloc." "\nIl fait référence à : " (cdr (assoc 0 (entget e_name))) ".\n" ) ) ) ) ;--- LISP de bonusCAD publié sur CADXP.com le 11/01/2016 11:34 ;--- Version modifiée de la fonction (ListBox), possède 5 arguments ;--- title correspond à l'entête de la boîte de dialogue ;--- msg correspond au message affiché au dessus de la liste ;--- lst correspond à la liste à afficher ;--- value correspond à la valeur définie par défaut ;--- flag correspond au type de liste souhaitée ; flag = 0 -> liste déroulante (choix unique) ; flag = 1 -> liste avec barre de défilement (choix unique) ; flag = 2 -> liste avec barre de défilement (choix multiple) ; Renvoie la liste des calques ayant été sélectionnés (defun ListBox (title msg lst value flag / tmp file DCL_ID choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{height=15;key=\"lst\";") (t "spacer;:list_box{height=15;key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" file) (close file) (setq DCL_ID (load_dialog tmp)) (if (not (new_dialog "ListBox" DCL_ID)) (exit) ) (start_list "lst") (mapcar 'add_list lst) (end_list) (set_tile "lst" (if (member value lst) (itoa (vl-position value lst)) (itoa 0))) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) lst) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) lst)) ) ) (done_dialog)" ) (start_dialog) (unload_dialog DCL_ID) (vl-file-delete tmp) choice ) ;--- LISP de bonusCAD publié sur CADXP.com le 11/01/2016 11:34 ;--- Nécessaire au bon fonctionnement de la fonction (ListBox) ci-dessus (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun get-init-layout-pos (/ i tabs lay-list lay Init_Pos-list) (vl-load-com) (setq i 0 tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) lay-list (layoutlist) ) (foreach lay (reverse lay-list) (setq Init_Pos-list (cons (cons lay (vla-get-taborder (vla-item tabs lay))) Init_Pos-list)) ) Init_Pos-list ) (defun set-layout-pos (/ i d tabs Init_Pos lay-list lay lay-move) (vl-load-com) (setq i 0 d 0 tabs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) lay-list (layoutlist) Init_Pos (get-init-layout-pos) ) (foreach lay lay-list (vla-put-taborder (vla-item tabs lay) (setq i (1+ i))) (if (/= (cdr (assoc lay Init_Pos)) i) (setq d (1+ d) lay-move (cons lay lay-move) ) ) ) (prompt (strcat "\nUn total de " (itoa (length lay-list)) " présentations ont été prises en compte." "\nSur les " (itoa (length lay-list)) ", " (itoa (length lay-move)) " présentations ont changé de position." "\nVoici la liste des présentations ayant été déplacé :" (DXF_List lay-move "\"\n - \"" "left" t nil) "\n" ) ) ) Il manque quelques fonctions (comme Select-filter ou DXF_List) donc Select-filter, tu peux la trouver ici. Je l'utilise très souvent dans mes programmes et notamment pour la sélection de blocs dynamiques ou bien d'attributs, mais si je comprend bien, tes blocs ne sont pas dynamiques donc le code DXF 2 de ton "INSERT" correspond déjà à l'effectivename donc un simple (ssget "_X" '((0 . "INSERT") (2 . "Cartouche*"))) devrait suffire pour ton cas. N'étant pas du genre à commenter mes programmes correctement, je m'en excuse d'avance. :S Dans ton cas, il peut s'avérer utile d'installer un reactor basé sur la création, modification ou suppression de l'objet présentation (je n'ai pas encore les connaissances nécessaires pour t'en donner un exemple malheureusement) autrement, je pense en effet que tu n'as pas forcément besoin d'écrire une expression DIESEL dans tes cartouches si tu dois lancer une commande à chaque présentation nouvelle ou autre. A mes yeux, un simple (setpropertyvalue name "NUM_F" fol) suffit parfaitement... Avec name l'entity name de ton cartouche contenant l'attribut "NUM_F" et fol le nom de ta présentation (après avoir subit les modifications de caractères comme souhaité. Mais avec le lancement manuel de la commande, il peut s'avérer long de relancer la commande à chaque fois et de renommer toutes les présentations sans exception car il y a le nombre total affiché... De plus, ne pas la lancer à chaque fois revient à avoir des cartouches faux à certains moments. ^^" Es-tu à l'aise avec le langage AutoLISP (ou bien ActiveX ou Visual LISP) ? Car si ce n'est pas le cas, je pense qu'il faudra aborder le problème par étape et de le scinder en plusieurs problèmes simple au lieu de le prendre de front :3 Bisous, Luna

Coucou, Petite question : il s'agit d'un cartouche issu d'un Toolkit ? Auquel cas, il suffirait je pense d'intégrer l'expression Diesel dans l'attribut correspondant et ainsi cela pourra servir de modèle à chaque création d'un nouvel onglet... Personnellement, je fonctionne autrement puisque nous avons des indices de plan en fonction des destinataires et information dans le plan. Donc j'utilise les infos du bloc cartouche pour renommer l'onglet AutoCAD, tandis que toi, tu utilises l'onglet AutoCAD pour renommer ton cartouche. :3 Pour modifier un cartouche existant (donc avant l'insertion modèle de l'expression Diesel dans l'attribut), je te suggère simplement de faire cela à partir d'un jeu de sélection construit en sélectionnant l'ensemble des cartouches présents dans le dessin (ssget "_X" '((0 . "INSERT") (2 . [...]))). Attention car si tes cartouches sont dynamiques, il te faudra vérifier l'effectivename du bloc. Et ensuite, modifier pour chaque bloc, l'attribut nommé via la fonction (setpropertyvalue). Je ne pense pas que cela soit si difficile, à moins que je n'ai pas compris la demande... S'il te faut des exemple de prog', pas de soucis :3 Bisous, Luna

Vouih absolument, le reste c'est de la fioriture pour du confort utilisateur :3 Mais je reconnais bien l'utilité du Visual sur certaines tâches qui ont le mérite d'être assez compactes à l'écriture. Bisous, Luna

Coucou, En complément de la routine de Fraid, il existe ces deux routines de Lee Mac qui sont très utiles : http://www.lee-mac.com/changeblockinsertion.html. Cela te permettra de modifier le point d'insertion de tes blocs si le point 0,0,0 n'est pas correctement adapté. Une autre solution serait de calculer la boundingbox de la sélection par layer pour déterminer le point central de cette boundingbox. Cependant, il me semble qu'il faut avoir un jeu de sélection et je ne m'y connais pas suffisamment en Visual pour modifier la routine de Fraid afin d'incorporer le calcul de Lee Mac pour la BoundingBox... Bisous, Luna

Coucou, voici ce que j'avais fait à l'époque (defun c:angdim (/ ref cmdecho pt-list-e1 pt-list-e2 name I a b c) (defun get-midpoint (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)) ) (if (and (setq ref (entsel "\nSélectionner une cotation de référence : ")) (= (cdr (assoc 0 (entget (setq ref (car ref))))) "DIMENSION") ) ref (setq ref nil) ) (initget 2 "Aucun 90 180 270") (if (setq c (getreal "\nVeuillez spécifier l'angle complémentaire [90/180/270] <Aucun> : ")) (setq c (/ (* pi c) 180.0)) ) (setq cmdecho (getvar "CMDECHO")) (while (if (and (setq pt-list-e1 (SegSel "\nVeuillez sélectionner la première polyligne : ")) (setq pt-list-e2 (SegSel "\nVeuillez sélectionner la seconde polyligne : ")) (setq I (get-intersection-from-segment pt-list-e1 pt-list-e2)) (setq a (angle I (car pt-list-e1))) (setq b (angle I (car pt-list-e2))) (cond ((and c (< (- a B) (/ pi 2.0)) (> (- a B) 0) ) (setq pt-list-e1 (list (polar I (- a c) (distance I (car pt-list-e1))) (polar I (- a c) (distance I (cadr pt-list-e1))) ) ) ) ((and c (< (- a B) pi) (> (- a B) (/ pi 2.0)) ) (setq pt-list-e1 (list (polar I (+ a c) (distance I (car pt-list-e1))) (polar I (+ a c) (distance I (cadr pt-list-e1))) ) ) ) ((and c (< (- a B) (/ pi -2.0)) (> (- a B) (* -1 pi)) ) (setq pt-list-e1 (list (polar I (- a c) (distance I (car pt-list-e1))) (polar I (- a c) (distance I (cadr pt-list-e1))) ) ) ) ((and c (< (- a B) 0) (> (- a B) (/ pi -2.0)) ) (setq pt-list-e1 (list (polar I (+ a c) (distance I (car pt-list-e1))) (polar I (+ a c) (distance I (cadr pt-list-e1))) ) ) ) ) (setq name (entmakex (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbDimension") (cons 10 (car pt-list-e1)) (cons 11 '(0 0 0)) '(70 . 34) '(71 . 5) '(100 . "AcDb2LineAngularDimension") (cons 13 (cadr pt-list-e2)) (cons 14 (car pt-list-e2)) (cons 15 (cadr pt-list-e1)) (cons 16 (get-midpoint (get-midpoint (car pt-list-e1) (cadr pt-list-e1)) (get-midpoint (car pt-list-e2) (cadr pt-list-e2)))) '(50 . 0.0) ) ) ) ) t nil ) (if ref (progn (setvar "CMDECHO" 0) (command "_MATCHPROP" ref name "") (setvar "CMDECHO" cmdecho) ) ) ) (princ) ) (defun SegSel (msg / pt dist entlist name) (if (and (setq entlist (entsel msg)) (= (cdr (assoc 0 (entget (setq name (car entlist))))) "LWPOLYLINE") (setq pt (vlax-curve-getclosestpointto name (trans (cadr entlist) 1 0))) (setq dist (vlax-curve-getdistatpoint name pt)) (setq entlist (entget name)) ) (progn (while (< (vlax-curve-getdistatpoint name (cdr (assoc 10 entlist))) dist) (setq pt (cdr (assoc 10 entlist)) entlist (cdr (member (assoc 10 entlist) entlist)) ) ) (list pt (cdr (assoc 10 entlist))) ) ) ) (defun get-intersection-from-segment (seg1 seg2 / A B C D Xa Xb Xc Xd Ya Yb Yc Yd X Y) (if (and (setq A (car seg1)) (setq B (cadr seg1)) (setq C (car seg2)) (setq D (cadr seg2)) (setq Xa (car A)) (setq Xb (car B)) (setq Xc (car C)) (setq Xd (car D)) (setq Ya (cadr A)) (setq Yb (cadr B)) (setq Yc (cadr C)) (setq Yd (cadr D)) ) (cond ((= 0 (- (* (- Xb Xa) (- Yd Yc)) (* (- Yb Ya) (- Xd Xc)))) (princ "\nLes deux segments sont colinéaires.") nil ) (t (setq Y (/ (+ (* (- (* Yb Xa) (* Ya Xb)) (- Yd Yc)) (* (- (* Yd Xc) (* Yc Xd)) (- Ya Yb))) (atof (rtos (+ (* (- Xb Xa) (- Yc Yd)) (* (- Xd Xc) (- Yb Ya))))) ) X (/ (+ (* Y (- Xa Xb)) (- (* Ya Xb) (* Yb Xa))) (atof (rtos (- Ya Yb)))) ) (list X Y) ) ) ) ) Bisous, Luna

Coucou, Concernant le (mapcar) pour la seconde boucle je pense que ceci correspond à ce que tu cherches à faire : (setq listpt (vl-remove-if '(lambda (x) (member x entl)) listpts)) Bisous, Luna

Coucou, Je ne sais pas si cela provient de là mais il semblerait que cette application "AcadX.InputManager" fasse partie de la suite Microsoft Visual Basic (VBA). J'ai en effet testé (vla-getInterfaceObject (vlax-get-acad-object) "AcadX.InputManager") sur mon AutoCAD 2019 et cela me renvoie le message "Erreur lors du chargement de l'application". J'ai trouvé cette discussion également sur un sujet similaire : https://forums.autodesk.com/t5/vba/acadx/td-p/334626 J'ai également essayé d'installer VBA sur mon environnement AutoCAD mais cela ne change rien... Il est possible que l'application est changée de nom depuis 2002 mais je n'ai pas trouvé d'article relatant de cela. Je suis donc désolée mais je n'ai pas plus d'infos... Cependant cette valeur est belle est bien sauvegardée dans le dessin.. Commande: ANGBASE Entrez une nouvelle valeur pour ANGBASE <0.0>: 17.56 Commande: Commande: RT ROTATION Angle positif courant dans SCU: ANGDIR=sens horaire contraire ANGBASE=17.56 1 trouvé(s) Spécifiez le point de base: Spécifiez l'angle de rotation ou [Copier/Référence] <60.44>: 37.89 Commande: Commande: ROTATION Angle positif courant dans SCU: ANGDIR=sens horaire contraire ANGBASE=17.56 1 trouvé(s) Spécifiez le point de base: Spécifiez l'angle de rotation ou [Copier/Référence] <20.33>: ANGBASE ne correspond pas à la valeur par défaut cependant la valeur par défaut dépend bien de ANGBASE (20.33 = 37.89 - 17.56) donc cette valeur est forcément récupérable mais je n'ai trouvé aucune variable système sur ce principe (LASTANGLE correspondant à l'angle pour la commande ARC et non ROTATION) et aucune infos en LISP/Visual pour récupérer cette info... Peut-être que des personnes plus expérimenter en Visual pourront avoir une piste mais le progID "AcadX.InputManager" ne fonctionne désormais plus... Bisous, Luna

sumimasen double post.. >w<

Coucou, Je me demande si...la raison ne vient pas plutôt du fait que l'on compare deux points (possédant chacun des coordonnées) et j'avais déjà eu un soucis similaire à cause notamment au géoréférencement de mes plans mais aussi parfois sur des écarts de précision... J'avais essayé de solutionner le problème avec cette fonction mais je ne sais pas si cela te sera utile : (defun pt-member (pt pt-list fuzz / d) (setq d (strlen (substr (vl-princ-to-string fuzz) (1+ (cond ((= (type fuzz) 'REAL) (vl-string-position (ascii ".") (vl-princ-to-string fuzz))) (t 0)))))) (if (> (length pt) (length (car pt-list))) (setq pt (reverse (cdr (reverse pt)))) ) (while (and pt-list (not (equal (mapcar '(lambda (x) (rtos x 2 d)) pt) (mapcar '(lambda (x) (rtos x 2 d)) (car pt-list)) fuzz)) ) (setq pt-list (cdr pt-list)) ) pt-list ) L'idée ici c'est de vérifier si oui ou non, un point appartient à une liste de point, avec pt le point à comparer, pt-list la liste de point à comparer et fuzz le degré de précision. Plus le fuzz est précis (ex : 0.001) et plus tu veux t'assurer de la position exacte du point. Le retour est similaire à la fonction (member) qui retourne la liste restante à partir du point correspondant à la recherche. C'était une idée comme une autre, développé en peu de temps donc probablement pas parfaite mais cela avait corrigé mon souci à l'époque. Il serait également possible de comparer les points via (distance), bref un tas d'améliorations ^^ Petite remarque, tu n'as pas besoin d'écrire (setq nompoly (cdr (assoc -1 (entget (entlast))))) étant donné que (entlast) te renvoie déjà le même résultat donc petit raccourci avec (setq nompoly (entlast)) et un autre raccourci, c'est la fonction (member) pour récupérer la liste des sommets d'une polyligne, car tu ne t'intéresse qu'au code DXF 10 donc boucler un (member) en tronquant à chaque passage dans la boucle la liste obtenue via (member), c'est plus rapide à l'exécution. Bisous, Luna

Coucou, Je pense que la réponse est dans la question pour le coup :3 The following example demonstrates how to change the first vertex of the Vertices collection. (command "._pline" "0,0" "3,3" "5,2" "") nil (setq e3 (entlast)) <Entity name: 10e2e4da0> (setpropertyvalue e3 "Vertices" 0 "EndWidth" 1.0) nil Et en regardant l'aide au complet on a ceci : (setpropertyvalue ename propertyname value [or collectionName index name val]) En fait, l'exemple que tu as utilisé montre l'utilisation de la fonction (setpropertyvalue) dans le cas où on l'applique pour une Collection (ici "Vertices collection"), qui, contrairement à une utilisation sur une propriété simple, nécessite 4 arguments en plus de l'ename au lieu de 2. Donc non, il n'est pas possible d'utiliser (setpropertyvalue) au même titre que (setq). Je ne sais pas si j'ai été suffisamment claire ^^" Edit: encore une fois (gile) a la finesse d'esprit de simplifier et clarifier les explications, merci ! Bisous, Luna

Coucou, Premièrement, plutôt que de passer par (getpropertyvalue) pour récupérer les coordonnées X et Y du point d'insertion du bloc, je pense qu'il suffit de passer par un (cdr (assoc 10 (entget (ssname s ind1)))). Ensuite, serait-il possible d'avoir un aperçu de la valeur de tes variables, listpts notamment. A quel endroit précisément as-tu une erreur ? Est-ce lors de la suppression des coordbloc de ta listpts ? Bon après si je comprend bien, tu possèdes un plan topo avec les blocs TCPOINT (un point, un attribut ALT et un attribut MAT) et tu souhaites être en mesure de placer automatiquement ces blocs sur des polylignes existantes (issues d'un relevé) en incrémentant le matricule par rapport à la dernière valeur de matricule insérée et en plaçant ces blocs sur tous les sommets de polylignes (sauf s'il y a déjà un bloc à cet emplacement), c'est bien chat ? Si c'est bien cela, alors comment définis-tu l'altitude (attribut ALT) lors de l'insertion ? S'agit-il de polylignes "LWPOLYLINE" ou bien "POLYLINE" 3D ? Car en fonction du type de polyligne à lire, les sommets ne sont pas récupérables de la même manière.. Bisous, Luna

Coucou, Juste si tu as des entités qui sont supprimées en bordure de ta zone de sélection, essaie un (ssget) en "_CP" et non "_WP", chat sera plus agressif. Autrement, la méthode fonctionne très bien de la sorte et il ne me semble pas qu'il existe un moyen plus rapide pour faire des intersection de jeux de sélection.. Bisous, Luna

Coucou, J'ai également pensé à la fonction (vlax-curve-getclosestpointto), cependant si je comprend bien la demande de jujugeometre et l'application de la fonction Visual...cela ne pourra pas correspondre. Pour moi la fonction Visual récupère la projection orthogonal d'un point quelconque sur un objet linéaire spécifique...En d'autre termes, la ligne en question à déjà été sélectionnée par le programme, or le soucis ici c'est justement de "trouver" la ligne en question... Dans tous les cas cette fonction te sera utile pour trouver la distance minimale (via les fonction (min) et (distance)) mais si tu cherches également à déterminer la ligne la plus proche, je regarderais parmi les filtres de la fonction (ssget) associée aux code -4. Pour cela, tu peux aller voir le site/cours de (gile) qui traite de ce sujet (Chapitre 16.4 Filtre de sélection, page 39 sur le PDF "Introduction à AutoLISP") mais également sur le site de Didier (https://www.da-code.fr/ssget/) qui en parle un peu aussi. Je n'ai pas testé personnellement, mais je suis sûre que tu devrais pouvoir limiter ton jeu de sélection en limitant les coordonnées du code DXF 10 via des coordonnées relatives à la position de ton bloc. Cela devrait réduire le nombre d'entité à traiter pour la comparaison des point obtenus via (vlax-curve-getClosestPointTo) :3 Autrement tu peux voir les références en anglais pour étayer tes recherches comme AfraLISP ou LeeMac pour ne citer qu'eux... ^^ Bisous, Luna

Coucou, Pour commencer, ton dessin ne possède plus aucun bloc et l'ensemble des définitions de blocs ont été bien purgées ? Car parfois le soucis vient simplement du fait qu'un objet possède cette propriété mais apparaît en tant que sous objet et donc non sélectionnable par un (ssget)... Ensuite le fait de modifier sa définition ne signifie pas qu'il va disparaître, Olivier à raison, il faudrait ajouter une (command "_-PURGE") à la fin pour purger ce type de ligne (à condition que aucun objet n'y fasse référence). A quel moment obtiens-tu ce message d'erreur ? Bisous, Luna

En réponse à rebcao Le visual LISP est quelque peu particulier et les listes ne sont pas réellement sous forme de liste comme en vanilla, mais sous forme de #<safearray...> et les valeurs quelconques sous forme de #<variant...> mais mes compétences en Visual sont très limitées (car inexistantes :3 ). Personnellement, la propriété de position n'a pas vraiment besoin de Visual LISP pour être récupérée, puisqu'elle est directement lisible via la liste DXF (entget name) associée au code DXF 10 sous forme de liste donc plus rapidement exploitable pour un programme basé sur le langage vanilla. Autrement, pour répondre à cette question précisément il faudrait écrire ceci : (vlax-safearray->list (vlax-variant-value (vla-get-position name))) Et là tu retrouves ta liste de coordonnées comme souhaitée. (ici name correspond au nom VLA-Object du marqueur, donc après la conversion (vlax-ename->vla-object (car (entsel))) !) Chat commence à devenir compliqué si les sujets s'étendent sur plusieurs forums à la fois ^^" Bisous,Luna

Il y a également moyen de récupérer ces propriétés en fouillant un peu plus les listes DXF mais le code est un peu plus long si jamais il y a besoin de passer par du LISP vanilla : (setq name (car (entsel))) (setq coor (cdr (assoc 304 (entget (cdr (assoc -2 (entget (cdr (assoc 360 (reverse (entget (cdr (assoc 330 (entget name)))))))))))))) (setq lat (substr coor 1 (vl-string-position (ascii "\\") coor))) (setq lon (substr coor (+ 2 (vl-string-position (ascii "P") coor)))) Voili voilou, c'est tout ce que j'ai pu trouvé... Bisous, Luna

Coucou, Bon si je comprend bien la demande, tu souhaites exporter (fichier .csv, tableau AutoCAD, ... ?) les positions géographiques d'un ensemble de Marqueurs de position en associant les coordonnées géographiques au nom du marqueur, c'est bien cela ? Ne pouvant pas vraiment répondre sur le forum AutoDesk, et en reprenant les points de la discussion, le LISP ne permet pas de récupérer les valeurs de longitude et latitude de l'objet de manière directe (que se soit la liste DXF obtenue via (entget) ou les propriétés de l'objet via (getpropertyvalue)...) donc le Visual Lisp semble la solution la plus adéquat. En passant par (vlax-dump-object), on retrouve bien les propriétés que l'on cherche "Latitude" et "Longitude" sous format string. Donc ces propriétés peuvent facilement être récupérable via (setq name (vlax-ename->vla-object (car (entsel)))) (setq lon (vla-get-Longitude name)) (setq lat (vla-get-Latitude name)) Ensuite on peut exploiter ces données soit en passant par la liste DXF de l'objet et le code 1 pour associer le nom du marqueur aux coordonnées (attention, la liste DXF de l'objet POSITIONMARKER possède 2 listes pointées au code 1, et celle qui nous intéresse est la seconde donc penser à faire (cdr (assoc 1 (reverse (entget name)))) pour avoir la bonne valeur), soit via la même fonction (vla-get-Textstring name) et ensuite exporter cela sous le format souhaité. Faut-il donc exporter ces valeurs dans un champ ou bien un fichier .csv ? A savoir qu'il n'y a pas forcément besoin de programmation pour définir un champ directement dans AutoCAD car avec un champ objet, on peut récupérer les propriétés Latitude, ou Longitude directement et semble s'écrire de la manière : Ainsi, le problème se pose plutôt dans l'obtention de cet ObjId afin de lier le bon marqueur avec le bon champ. Pour ce point, je manque de réponses car je m'y suis déjà pencher mais je n'ai pas vraiment eu le temps de fouiller correctement donc les adeptes de Visual LISP devraient pouvoir le savoir (je doute que cette ID soit facilement récupérable en LISP vanilla, s'il est récupérable). Le champ peut ainsi être contenu dans n'importe quel objet affichant un texte (MTEXT, TEXT, ATTRIBUT, ...) permettant d'être à jour en cas de modifications et la récupération de l'ObjectID n'est nécessaire que dans le cas d'un traitement de plusieurs Marqueurs pour éviter la liaison des données à la mano qui est tout à fait faisable également en insérant un champ "Latitude" et "Longitude" en sélectionnant le marqueur lié. :3 Cela correspond bien à ta demande, ou bien me suis-je égarée ? Bisous, Luna

Oh pardon, petite erreur de grammaire ^^" Corrigé normalement (jusqu'au prochain problème) :3 Bisous Luna

Coucou ! Vouih pas de soucis :3 (defun c:ATTCOL (/ remove-double jsel i e name tag color n lst) ; Supprime les doublons au sein d'une liste spécifiée en argument : ;--- La fonction (Remove-Double) possède 1 argument ;--- lst1 correspond à la liste devant être évaluée pour la suppression des doublons ;--- Renvoie la liste modifiée sans ses doublons (defun Remove-Double (lst1 / lst2) (while (car lst1) (setq Lst2 (cons (car lst1) lst2) Lst1 (vl-remove (car lst1) lst1) ) ) (reverse lst2) ) (if (or (setq jsel (ssget '((0 . "INSERT")))) ; si pré-sélection ou sélection manuelle (setq jsel (ssget "_X" '((0 . "INSERT")))) ; si pas de sélection manuelle, alors prise en compte de la totalité des blocs ) (progn (setq n 0 i (sslength jsel) e i ) (if (= (setq tag (getstring "Veuillez spécifier le nom d'attribut pour la couleur <\"COLOR\"> : ")) "") (setq tag "COLOR") ) (repeat i (setq name (ssname jsel (setq i (1- i)))) (if (and (null (vl-catch-all-error-p (setq color (vl-catch-all-apply 'getpropertyvalue (list name tag))))) (cond ((assoc 62 (entget name)) (entmod (subst (cons 62 (atoi color)) (assoc 62 (entget name)) (entget name))) ) ((not (assoc 62 (entget name))) (entmod (append (entget name) (list (cons 62 (atoi color))))) ) ) ) (setq n (1+ n) lst (cons (getpropertyvalue name "BlockTableRecord/Name") lst) ) (ssdel name jsel) ) ) (sssetfirst nil jsel) (setq lst (apply 'strcat (mapcar '(lambda (str) (strcat "\n - " str)) (vl-sort (remove-double lst) '<)))) (alert (strcat "\nUn total de " (itoa n) " / " (itoa e) " bloc(s) ont été redéfinis." "\nVoici la liste des blocs ayant un attribut nommé \"" tag "\" : " lst ) ) (prompt (strcat "\nUn total de " (itoa n) " / " (itoa e) " bloc(s) ont été redéfinis." "\nVoici la liste des blocs ayant un attribut nommé \"" tag "\" : " lst ) ) ) (prompt (strcat "\nAucun bloc présent dans ce fichier...")) ) (princ) ) Non testé en revanche... Et je ne sais pas si tu possèdes un attribut particulier pour cette information (= nom d'étiquette par défaut ?) donc j'ai pris "COLOR" par défaut. Et j'ai supposé que la valeur présente dans l'attribut correspond aux valeurs comprises entre 0-256 comme précisé. Bisous, Luna

Déjà je ne saisis pas bien, car tu as dis que ton programme doit permettre de modifier un attribut par rapport à un autre, sauf que ces attributs n'ont rien à voir en commun (donc en clair, il s'agit de blocs totalement différents) or dans ton programme, tu filtres tes blocs par rapport à leur effectivename et leur correspondance exacte avec le bloc de référence... Normalement le bloc de référence (ou source) doit correspondre à la liste de valeurs souhaitées et le jeu de sélection se compose de blocs différents dans lesquels tu viens modifier la valeur de leur attribut, sans connaître la correspondance avec l'attribut source, nan ? Bisous, Luna