Luna

Coucou, Essaye ceci est dit moi si cela convient à ta demande 😉 (defun c:MB2CP (/ b jsel i name lsel n ent bpt lpt d lst) (while (not (and (setq name (entsel "\nSelect a block :")) (setq name (car name)) (= "INSERT" (cdr (assoc 0 (entget name)))) (setq name (vlax-ename->vla-object name)) (setq b (vlax-get name 'EffectiveName)) ) ) (princ "\nInvalid selection...") ) (princ "\nPlease, select blocks...") (if (setq jsel (ssget (list (cons 0 "INSERT") (cons 2 (strcat "`*U*," b))))) (progn (princ "\nPlease, select polylines...") (setq lsel (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength jsel)) (setq name (ssname jsel (setq i (1- i))) bpt (cdr (assoc 10 (entget name))) lst nil ) (if (= b (vlax-get (vlax-ename->vla-object name) 'EffectiveName)) (progn (repeat (setq n (sslength lsel)) (setq ent (ssname lsel (setq n (1- n))) lpt (vlax-curve-getClosestPointTo ent bpt T) d (distance bpt lpt) lst (cons (cons d lpt) lst) ) ) (setq lpt (cdar (vl-sort lst '(lambda (p1 p2) (< (car p1) (car p2)))))) (entmod (subst (cons 10 lpt) (assoc 10 (entget name)) (entget name))) ) ) ) ) ) (command "_ATTSYNC" "_Name" b) (princ) ) Du coup le programme MB2CP (= Move Blocks to Closest Polyline) demandera dans un premier temps de sélectionner une référence de bloc (pour déterminer le nom de la définition de bloc que tu souhaites bouger et ainsi filtrer la sélection pour plus tard), puis il te faudra sélectionner tes blocs (la sélection sera filtrée pour ne sélectionner que des blocs correspondant au nom spécifié plus tôt + les blocs dynamiques et prend en compte la pré-sélection). Tu peux prendre tous tes blocs en même temps cela ne devrait pas poser de soucis. Ensuite il te faudra sélectionner tes polylignes (ici encore c'est une sélection filtrée sur les objets polylignes et tu peux en sélectionner plusieurs). Une fois tes sélections faites, le programme va regarder pour chaque références de bloc si son nom correspond bien au nom spécifié plus tôt (cela permet de fonctionner aussi avec les blocs dynamiques, c'est pour chat), puis va regarder la position du bloc par rapport à chaque polyligne sélectionnées et ne considérer que le nouveau point qui sera le plus proche du bloc. Une fois ce calcul fait, la référence de bloc sera modifiée pour correspondre aux nouvelles coordonnées (le Z est pris en compte également). En revanche il faut faire attention car si un bloc n'est pas proche d'une polyligne, il perdra sa position initiale et aura pour nouvelle coordonnées le sommet d'une polyligne la plus proche, donc il faut s'assurer d'avoir toujours une polyligne qui correspond à chaque bloc. J'ai fait quelques tests sur ton .dwg et si tu suis les instruction (notamment celle de toujours avoir une polyligne en face de ton bloc !), le programme fonctionne parfaitement selon moi.. Bisous, Luna

Coucou, Je ne comprends pas bien où est ton problème exactement...Ci-dessous un ScreenCast pour montrer l'utilisation de la boîte de dialogue. As-tu le même fonctionnement ? https://autode.sk/38rssaW Bisous, Luna

@Jo le projeteur, Si tu vas dans l'aide AutoCAD, tu verras en haut à gauche (juste à droite du bouton "Accueil"), une liste déroulante "Aide-mémoires". En déroulant la liste, tu auras l'option "Documentation à l'attention des développeurs" et à partir de là, tu devrais avoir accès à de nombreuses pages très intéressantes ! Je te conseille de consulter "Reference guide" (correspondant à la liste de l'ensemble des fonctions AutoLISP) et "Developper's Guide" qui correspond à des notions sur comment programmer. Bisous, Luna

Coucou, Le premier code permet de modifier la totalité des définitions de blocs présentes dans le dessin courant tandis que la seconde version permet d'ouvrir une boîte de dialogue avec la liste de l'ensemble des définitions de blocs et tu peux ainsi sélectionner une ou plusieurs définitions de blocs pour en modifier seulement quelques unes (ou toutes évidemment si tu le souhaites). Autrement dit, tout dépend si tu dois modifier l'ensemble des blocs de ton dessin, ou bien si tu dois le faire uniquement sur certains blocs 😉 Bisous, Luna

Oki, Si cela doit affecter toutes les définitions de blocs de ton dessin, alors ceci devrait fonctionner : (defun c:BAUE (/ LM:AnnotativeBlock b) ;; Annotative Block - Lee Mac ;; Sets the annotative property for a block definition ;; blk - [str] Block name ;; flg - [bol] Boolean flag (1=Annotative, 0=Not Annotative) ;; Returns: T if successful, else nil (defun LM:AnnotativeBlock ( blk flg ) (and (setq blk (tblobjname "block" blk)) (progn (regapp "AcadAnnotative") (entmod (append (entget (cdr (assoc 330 (entget blk)))) (list (list -3 (list "AcadAnnotative" '(1000 . "AnnotativeData") '(1002 . "{") '(1070 . 1) (cons 1070 flg) '(1002 . "}") ) ) ) ) ) ) ) ) (vl-load-com) (vlax-for b (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (if (not (wcmatch (vlax-get b 'Name) "`**")) (progn (vlax-put b 'Explodable 1) ;; 1 = Décomposition autorisée, 0 = Decomposition interdite (vlax-put b 'BlockScaling 0) ;; 1 = Echelle uniforme, 0 = Echelle non uniforme autorisée (LM:AnnotativeBlock (vlax-get b 'Name) nil) ;; T = Annotatif Oui, nil = Annotatif Non ) ) ) (princ) ) Sinon, s'il faut l'utiliser sur certaines définitions uniquement, je te propose ceci : (defun c:BAUE (/ LM:AnnotativeBlock ListBox str2lst bl b blist) ;; Annotative Block - Lee Mac ;; Sets the annotative property for a block definition ;; blk - [str] Block name ;; flg - [bol] Boolean flag (1=Annotative, 0=Not Annotative) ;; Returns: T if successful, else nil (defun LM:AnnotativeBlock ( blk flg ) (and (setq blk (tblobjname "block" blk)) (progn (regapp "AcadAnnotative") (entmod (append (entget (cdr (assoc 330 (entget blk)))) (list (list -3 (list "AcadAnnotative" '(1000 . "AnnotativeData") '(1002 . "{") '(1070 . 1) (cons 1070 flg) '(1002 . "}") ) ) ) ) ) ) ) ) (defun ListBox (title msg lst value flag / vl-list-search tmp file DCL_ID choice tlst) (defun vl-list-search (p l) (vl-remove-if-not '(lambda (x) (wcmatch x p)) l) ) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") tlst lst ) (write-line (strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";") file ) (write-line ":edit_box{key=\"filter\";}" file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";}") ((= 1 flag) "spacer;:list_box{height=15;key=\"lst\";}") (t "spacer;:list_box{height=15;key=\"lst\";multiple_select=true;}") ) file ) (write-line ":text{key=\"count\";}" file) (write-line "spacer;ok_cancel;}" file) (close file) (setq DCL_ID (load_dialog tmp)) (if (not (new_dialog "ListBox" DCL_ID)) (exit) ) (set_tile "filter" "*") (set_tile "count" (strcat (itoa (length lst)) " / " (itoa (length lst)))) (start_list "lst") (mapcar 'add_list lst) (end_list) (set_tile "lst" (if (member value lst) (itoa (vl-position value lst)) (itoa 0))) (action_tile "filter" "(start_list \"lst\") (mapcar 'add_list (setq tlst (vl-list-search $value lst))) (end_list) (set_tile \"count\" (strcat (itoa (length tlst)) \" / \" (itoa (length lst))))" ) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) tlst) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) tlst)) ) ) (done_dialog)" ) (start_dialog) (unload_dialog DCL_ID) (vl-file-delete tmp) choice ) (defun 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) ) ) (vl-load-com) (vlax-for b (setq bl (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (not (wcmatch (vlax-get b 'Name) "`**")) (setq blist (cons (cons (vlax-get b 'Name) b) blist)) ) ) (setq bl (ListBox "Select Block(s)" "Please, select one or more block(s) :" (reverse (mapcar 'car blist)) nil 2)) (mapcar '(lambda (b) (setq b (assoc b blist)) (vlax-put (cdr b) 'Explodable 1) ;; 1 = Explodable, 0 = Not Explodable (vlax-put (cdr b) 'BlockScaling 0) ;; 1 = Unifrom Scale, 0 = Not Uniform Scale (LM:AnnotativeBlock (car b) 0) ;; 1 = Annotative, 0 = Not Annotative ) bl ) (princ) ) Pour lancer la commande, copie-colle le code dans ta ligne de commande puis c'est la commande BAUE (= Block Annotative Uniform Explodable). J'ai également ajouté des commentaires sur les 3 lignes concernant la modification de la propriété si jamais tu désires modifier la valeur pour l'une d'elles (les commentaires sont repérable via ";;"). En espérant que ceci réponde à ton besoin 😉 Bisous, Luna

coucou, Quelque chose dans le genre ? (command "_.-BHATCH" "_Properties" "_Gradient" "GR_SPHER" "" "" "_Properties" "_Gradient" "_Two" "_True" "224,247,255" "_True" "255,255,255" (getpoint "\nSpécifiez un point interne : ") "") Bisous, Luna

Coucou, Je ne sais pas si un programme existe déjà (probablement), en revanche on peut toujours l'écrire au besoin. Comment détermines-tu les nouvelles valeurs pour les propriétés de ton blocs ? Serait-il possible d'avoir un exemple de ce que tu cherches réellement à obtenir en définissant les données d'entrée ? Bisous, Luna

@JPhil fut plus rapide que moi 🙂 Bisous, Luna

Coucou, Pour éviter les doublons de réponses, répondre ici : https://forums.autodesk.com/t5/autocad-tous-produits-francais/autocad-plant-3d-appliquer-une-condition-dans-une-propriete-d-un/td-p/11116747 Bisous, Luna

En effet, j'ai lu un peu trop vite et je n'avais pas remarqué que 'ss était affecté à (vla-get-ActiveSelectionSet) et non à (ssget)... My bad ! Je n'étais pas bien réveillée ^^" Merci pour la correction @(gile) 🙂 Cependant, si ce que j'avais lu était bon, cela aurait aussi pu fonctionner il me semble, nan ? (Bon même si du coup, le jeu de sélection VLISP n'est pas supprimé dans cette version ^^") ;; ;; Rotation de N Bloc(s) d'un angle donne (+/- xx.xx) ;; par rapport a leur point d'insertion par GC ;; Commande au clavier : BROT ;; (vl-load-com) (defun c:brot (/ *error* doc rot ss) (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "Erreur: " msg)) ) (vla-EndUndoMark doc) (princ) ) (if (and (setq rot (getorient "\nRotation: ")) (setq ss (ssget '((0 . "INSERT")))) ) (progn (vla-StartUndoMark doc) (vlax-for o (vla-get-ActiveSelectionSet doc) (vl-catch-all-apply '(lambda () (vla-put-Rotation o (+ rot (vla-get-Rotation o))) ) ) ) (sssetfirst nil ss) (vla-EndUndoMark doc) ) ) (princ) ) Bisous, Luna

Coucou, Le plus simple est de remplacer la ligne (vla-delete ss) par (sssetfirst nil ss) Bisous, Luna

Coucou, Regarde ici, tu trouveras très certainement ton bonheur 😜 https://www.theswamp.org/index.php?topic=54244.0 (Post #9, ronjonp) Bisous, Luna

Coucou, Je crois qu'aucune des solutions ne répondent aux problème... Car si je comprends bien le but n'est pas de supprimer la hachure, mais uniquement de définir la couleur d'arrière-plan des hachures sur "Aucun" (correspondant donc en réalité à la couleur d'arrière-plan). Or les programmes ici supprime l'objet de hachure, ce qui est un peu trop radical ^^" Je pense en effet que la propriété VBA BackGroundColor (obtenue via (vlax-dump-object)) correspond à ce que tu recherches mais en effet, il s'agit d'un objet VBA. En regardant ses propriétés via (vlax-dump-object), on a : ; IAcadAcCmColor: Interface AcCmColor AutoCAD ; Valeurs de propriétés: ; Blue (RO) = 0 ; BookName (RO) = "" ; ColorIndex = 257 ; ColorMethod = 200 ; ColorName (RO) = "" ; EntityColor = -939524096 ; Green (RO) = 0 ; Red (RO) = 0 T Et en faisant un simple (vla-put-BackGroundColor) sur un objet hachure à partir d'une hachure sans arrière-plan, cela fonctionne sans soucis. Donc la problématique vient finalement pour récupérer ce VLA-OBJECT correspondant à la couleur de l'arrière-plan... N'ayant pas trop le temps de me pencher sur la question aujourd'hui, le plus simple est de créer une hachure sans arrière-plan, récupérer la valeur de (vla-get-BackGroundColor) et ensuite de parcourir toutes tes définitions de bloc pour redéfinir la valeur de BackGroundColor à partir de la valeur initiale (précédemment récupérée) pour chaque sous-objet de type "HATCH" (code DXF 0). Bisous, Luna

Coucou, Je n'ai pas forcément le temps d'écrire le programme directement en mode tout propre tout beau mais voilà un principe de résolution : 1°) Détermination du nom des calques sources / cibles via (getstring T "\nCalque :") ;; Demande à l'utilisateur d'écrire le nom du calque à la mano (espaces autorisés) ou (cdr (assoc 8 (entget (car (entsel))))) ;; Demande à l'utilisateur de cliquer sur un objet pour récupérer le nom du calque (erreur si sélection vide) ou bien (pour une version plus propre), regarder du côté de (ListBox) développé par (gile) pour faire la sélection du calque depuis une boîte de dialogue 2°) Créer un jeu de sélection des objets de type "LINE,LWPOLYLINE,ARC,CIRCLE" (ou plus si besoin d'en rajouter, mais plus le type d'objet est varié et plus il faudra adapter le programme pour récupérer la liste de points) appartenant au calque servant à réaliser l'intersection (setq ssel (ssget "_X" (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE") (cons 8 "Layer1")))) 3°) Parcourir le jeu de sélection par une boucle (repeat), (while), ... et pour chaque objet contenu dans le jeu de sélection faire 3.a°) Récupérer sa liste de points (selon les types d'objets, la méthode est différente, d'où la complexité, notamment pour les "CIRCLE" !..) 3.b°) Utiliser la méthode "_Fence" de (ssget) pour créer un second jeu de sélection filtré sur le second calque (setq snew (ssget "_F" (mapcar '(lambda (p) (trans p 0 1)) pt-list) (list (cons 8 "Layer2")))) avec 'pt-list' la liste des sommets récupérée auparavant et le but du (mapcar ...) c'est de transposer les coordonnées SCG des objets du premier jeu de sélection en coordonnées SCU (comme chat, dans le cas où tu n'es pas en SCG, ton jeu de sélection ne se fera pas ailleurs dans ton dessin car la méthode "_Fence" utiliser les coordonnées SCU !) 3.c°) Parcourir le second jeu de sélection et pour chaque entité, les ajouter à un troisième jeu de sélection via (ssadd ent sel3) 4°) Mettre fin à toutes les boucles et afficher le résultat contenu dans le troisième jeu de sélection via (sssetfirst nil sel3) Évidemment, c'est très brouillon et optimisable mais cela peut te donner des pistes de dev' (j'ai pas testé hein, c'est juste ce qui me passe par la tête sur le moment) Après bien sûr, si tu ne programmes pas, il faudra que l'on développe un programme pour toi 😉 Bisous, Luna

Coucou, Désolée, mais je n'ai pas vraiment compris la demande...serait-il possible d'avoir une explication un peu plus détaillée ? Notamment qu'entends-tu par ? Si cela peut te/nous faciliter la tâche, un .dwg d'exemple avec état actuel / résultat souhaité et quelques légendes si nécessaire serait le bienvenue également ! Bisous, Luna

Coucou, Merci beaucoup @(gile) pour ces explications ! Je vais regarder tout cela d'un peu plus prêt lorsque j'aurais un peu de temps 😉 Mais je pense que cela va me permettre de m'entraîner avec une bonne base sur les programmes qui nécessitent de la récursivité Bisous, Luna

Coucou, Bisous, Luna

Coucou, Je pense que tu n'as pas compris quel était le soucis en précisant le mode "_P" ("_Previous") directement dans le programme... : Pour qu'il y ait une sélection précédente, il faut bien que la sélection soit définie avant le lancement de la commande n'est-ce pas ? Donc que se passera-t-il à ton avis lors du tout premier lancement de la commande ? Il te faudra sélectionner les objets via la commande SELECT ou bien les avoir utiliser précédemment dans une autre commande pour pouvoir les prendre...Après si tu es prêt à prendre le risque de déplacer des objets non désirés, tu peux tenter cela : (defun setA (*a*) (if *a* *a* (progn (initget 7 "100") (setq *a* (getdist "\nSpécifier la distance de déplacement [100] :")) ) ) ) (defun c:SetA () (initget 7 "100") (setq *a* (getdist "\nSpécifier la distance de déplacement [100] :")) ) (defun c:C+ (/ ss) (if (or (setq ss (ssget "_P")) (setq ss (ssget)) ) (command-s "_.copy" ss "" "_Displacement" (list 0. (setA *a*))) ) (princ) ) (defun c:C- (/ ss) (if (or (setq ss (ssget "_P")) (setq ss (ssget)) ) (command-s "_.copy" ss "" "_Displacement" (list 0. (- (setA *a*)))) ) (princ) ) (defun c:D+ (/ ss) (if (or (setq ss (ssget "_P")) (setq ss (ssget)) ) (command-s "_.move" ss "" "_Displacement" (list 0. (setA *a*))) ) (princ) ) (defun c:D- (/ ss) (if (or (setq ss (ssget "_P")) (setq ss (ssget)) ) (command-s "_.move" ss "" "_Displacement" (list 0. (- (setA *a*)))) ) (princ) ) (defun c:+ () ;; Se déplace à 100 de+ (command "-pan" "0,0,0" (strcat "0," (rtos (- (setA *a*))) ",0")) (princ) ) (defun c:- () ;; Se déplace à 100 de- (command "-pan" "0,0,0" (strcat "0," (rtos (setA *a*)) ",0")) (princ) ) Bisous, Luna

Coucou, Les programmes que je t'ai proposé c'est par rapport aux commandes que tu avais dev' ! Le problème vient du fait que la commande DEPLACER, une fois terminée, les objets déplacés sont dé-sélectionnés ! Or avec ton utilisation du (ssget) sur le mode "_Implied", cela ne fonctionne pas car il faut un jeu de sélection initial obligatoirement.. Je ton conseille simplement de ne mettre aucun mode pour le (ssget), autrement-dit, remplace toutes les occurrences (ssget "_I") par (ssget) Et cela devrait marcher correctement avec le rappel de commande. Cela ne va pas reprendre les anciens objets déplacés initialement mais cela va te demander de sélectionner des objets, donc soit tu sélectionnes de nouveaux objets, soit les mêmes, sinon il te suffit d'utiliser les raccourcis pour les sélections d'objets (cf. ci-dessous pour les deux plus connus) : "P" > pour "Précédent" (ou "_P" en anglais) "D" > pour "Dernier" (ou "_L" en anglais) Bisous, Luna

Coucou, As-tu regardé dans la boîte de dialogue "Personnaliser l'interface utilisateur" (commande "CUIRAPIDE") que la touche de remplacement temporaire pour le mode Ortho est bien présente avec la bonne macro et la bonne touche (et bien sûr il faut TEMPOVERRIDES = 1) : Pour la macro, j'ai : ^P'_.orthomode $M=$(if,$(and,$(getvar,orthomode),1),$(-,$(getvar,orthomode),1),$(+,$(getvar,orthomode),1)) Bisous, Luna

Coucou, Je pense que le problème vient du (cond), car dans la condition ( (= obj "LWPOLYLINE") ... ) tu utilises la variable 'sel_obj' qui n'est utilisée nulle part, donc je suppose qu'au début ton argument de la fonction (ang_obj) se nommait 'sel_obj' puis tu as modifié le nom de la variable vers 'er' mais tu as oublié de le corriger dans la seconde condition 😉 Dans les choses à savoir, les fonctions (vlax-curve-...) fonctionnent aussi bien avec l'ename que le VLA-object, et il me semble qu'elles s'exécutent d'ailleurs plus rapidement en utilisant l'Ename comparé au VLA-object ! Je n'ai pas lu le reste du programme donc si tu as d'autres soucis, n'hésite pas 😉 D'ailleurs je te conseille de déclarer au maximum tes variables en local (en les ajoutant après le "/" du (defun)) pour éviter d'avoir des problèmes. Bisous, Luna

Coucou, J'ai souvenir que les boîtes de dialogues enregistrent leur dernière position à chaque fois...ou du moins cela le fait pour moi... Bisous, Luna

Dans le .lsp que je t'ai transmis, j'ai remplacé les noms. Par contre, on est bien d'accord que ton client n'a pas un AutoCAD LT ?! Cela serait plus simple de dire au client "pas possible" mais bon je comprends... Pour modifier également le nom du bloc, il faut utiliser le fichier ci-joint. Je poste cependant également le code pour t'expliquer à quel endroit il y a eut des modifs histoire que tu puisses le modifier plus facilement si besoin 😉 ;| TOTALAREA version 4.1.0 (gile) Définit les commandes AREABOX, TOTALAREA, AREAEDIT, AREASHOW et les variables AREACONV, AREAPREC Bloc "TotalArea" Une définition bloc nommé "TotalArea" doit être présente dans le dessin ou sous forme de fichier "TotalArea.dwg" dans un répertoire du chemin de recherche. Ce bloc doit contenir au moins trois attributs ayant pour étiquettes "NUMERO", "UNIT" et "SURFACE". Ce dernier sera automatiquement renseigné avec la somme des aires des objets qui lui sont liés. (arc, cercle, ellipse, polyligne, spline, hachure, region, mpolygon) S1 le bloc contient un autre attribut ayant pour étiquette "NOBJ", celui sera aussi automatiquement renseigné avec le nombre d'objets liés au bloc. Le bloc "TotalArea" peut être un bloc dynamique. Format de l'affichage de l'attribut "SURFACE" Le nombre de décimales affichées dépend de la valeur de la variable AREAPREC Facteur de conversion Il est possible d'affecter un facteur de conversion à la valeur de l'attribut. Cette valeur est gérée avec une variable (AREACONV) qui peut être modifiée avec la commande du même nom. |; ;;;===============================================;;; (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (setq *gc:TotalAreaModified* nil *gc:TotalAreaLispReactor* nil *gc:TotalAreaCommandReactor* nil ) ;;; AREABOX (gile) ;;; Boite de dialogue d'appel des commandes (defun c:Areabox (/ tmp file what_next dcl_id result) (or (getenv "AreaConv") (setenv "AreaConv" "1")) (or (getenv "AreaPrec") (setenv "AreaPrec" (itoa (getvar "LUPREC"))) ) (setq tmp (vl-filename-mktemp "Tmp.dcl") file (open tmp "w") ) (write-line "AreaBox:dialog{label=\"Surfaces cumulées\"; :boxed_column{label=\"Commandes\";:row{ :button{label=\"TotalArea\";key=\"(c:totalarea)\";width=16;} spacer;:text{label=\"Insérer et lier\";width= 20;}} :row{ :button{label=\"AreaEdit\";key=\"(c:areaedit)\";width=16;} spacer;:text{label=\"Modifier\";width= 20;}} :row{ :button{label=\"AreaShow\";key=\"(c:areashow)\";width=16;} spacer;:text{label=\"Visualiser\";width= 20;}}} :boxed_column{label=\"Variables\";:row{ :text{key=\"ConvValue\";width= 20;} :button{label=\"AreaConv\";key=\"areaconv\";width=16;}} :row{:text{key=\"PrecValue\";width= 20;} :button{label=\"AreaPrec\";key=\"areaprec\";width=16;}}} spacer;cancel_button;}" file ) (close file) (setq dcl_id (load_dialog tmp)) (setq what_next 2) (while (>= what_next 2) (if (not (new_dialog "AreaBox" dcl_id)) (exit) ) (set_tile "ConvValue" (strcat "AREACONV = " (getenv "AreaConv")) ) (set_tile "PrecValue" (strcat "AREAPREC = " (getenv "AreaPrec")) ) (foreach k '("(c:totalarea)" "(c:areaedit)" "(c:areashow)" ) (action_tile k "(setq result $key) (done_dialog)") ) (action_tile "areaconv" "(done_dialog 3)") (action_tile "areaprec" "(done_dialog 4)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) (cond ((= what_next 3) (c:areaconv)) ((= what_next 4) (c:areaprec)) ) ) (unload_dialog dcl_id) (vl-file-delete tmp) (and result (eval (read result))) (princ) ) ;;;===============================================;;; ;; TotalAreaBox ;; Boite de dialgue de la commande TotalArea (defun TotalAreaBox (/ lbl unt scl lay lst tmp file what_next dcl_id data result ) (or (getenv "AreaConv") (setenv "AreaConv" "1")) (or (getenv "AreaPrec") (setenv "AreaPrec" (itoa (getvar "LUPREC"))) ) (or (setq lbl (vlax-ldata-get "TotalArea" "lbl")) (setq lbl (vlax-ldata-put "TotalArea" "lbl" "Aire totale")) ) (or (setq unt (vlax-ldata-get "TotalArea" "unt")) (setq unt (vlax-ldata-put "TotalArea" "unt" "m²")) ) (or (setq scl (vlax-ldata-get "TotalArea" "scl")) (setq scl (vlax-ldata-put "TotalArea" "scl" 1)) ) (while (setq lay (tblnext "LAYER" (not lay))) (setq lst (cons (cdr (assoc 2 lay)) lst)) ) (setq lst (vl-sort lst '<)) (setq lay (getvar "CLAYER")) (setq tmp (vl-filename-mktemp "Tmp.dcl") file (open tmp "w") ) (write-line "AreaBox:dialog{label=\"TotalArea\"; :boxed_column{label=\"Attributs\"; :row{:text{label=\"Libellé\";} :edit_box{key=\"lbl\";width=24;}} :row{:text{label=\"Unités\";} :edit_box{key=\"unt\";fixed_width=true;}}} :boxed_column{label=\"Propriétés\"; :row{:text{label=\"Echelle\";} :edit_box{key=\"scl\";fixed_width=true;}} :popup_list{label=\"Calque\";key=\"lay\";}} :boxed_column{label=\"Variables\";:row{ :text{key=\"ConvValue\";width= 20;} :button{label=\"AreaConv\";key=\"areaconv\";width=16;}} :row{:text{key=\"PrecValue\";width= 20;} :button{label=\"AreaPrec\";key=\"areaprec\";width=16;}}} spacer;ok_cancel_help;}" file ) (close file) (setq dcl_id (load_dialog tmp)) (setq what_next 2) (while (>= what_next 2) (if (not (new_dialog "AreaBox" dcl_id)) (exit) ) (start_list "lay") (mapcar 'add_list lst) (end_list) (set_tile "lbl" lbl) (set_tile "unt" unt) (set_tile "scl" (rtos scl)) (set_tile "lay" (itoa (vl-position lay lst))) (set_tile "ConvValue" (strcat "AREACONV = " (getenv "AreaConv")) ) (set_tile "PrecValue" (strcat "AREAPREC = " (getenv "AreaPrec")) ) (action_tile "lbl" "(setq lbl $value)") (action_tile "unt" "(setq unt $value)") (action_tile "scl" "(if (< 0 (distof $value)) (setq scl (distof $value)) (progn (alert \"Nécessite une échelle valide.\") (setq scl (vlax-ldata-get \"TotalArea\" \"scl\")) (set_tile \"scl\" (rtos scl)) (mode_tile \"scl\" 2)))" ) (action_tile "lay" "(setq lay (nth (atoi $value) lst))") (action_tile "areaconv" "(done_dialog 3)") (action_tile "areaprec" "(done_dialog 4)") (action_tile "help" "(done_dialog 5)") (action_tile "cancel" "(done_dialog 0)") (action_tile "accept" "(setq result (list lbl unt scl lay)) (vlax-ldata-put \"TotalArea\" \"lbl\" lbl) (vlax-ldata-put \"TotalArea\" \"unt\" unt) (vlax-ldata-put \"TotalArea\" \"scl\" scl) (done_dialog 1)" ) (setq what_next (start_dialog)) (cond ((= what_next 3) (c:areaconv)) ((= what_next 4) (c:areaprec)) ((= what_next 5) (help "TotalArea")) ) ) (unload_dialog dcl_id) (vl-file-delete tmp) result ) ;;;===============================================;;; ;;; TOTALAREA (gile) ;;; Insère le bloc "TotalArea" dont la valeur de l'attribut "SURFACE" est égale à ;;; l'aire totale des objets sélectionnés (defun c:TotalArea (/ *error* space dz bloc name data tot ss lst ins scl blk) (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "\Erreur: " msg)) ) (setvar "DIMZIN" dz) (vla-EndUndoMark *acdoc*) (princ) ) (setq Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace *acdoc*) (vla-get-ModelSpace *acdoc*) ) dz (getvar "DIMZIN") ) (if (or (gc:GetItem (vla-get-Blocks *acdoc*) (setq bloc (setq name "IDLOCAL")) ;; <<<--- Définition du nom du bloc pour le reste du programme !!!!!!! ) (findfile (setq bloc (strcat name ".dwg"))) ) (if (setq data (TotalAreaBox)) (if (ssget '((-4 . "<OR") (0 . "ARC,CIRCLE,ELLIPSE,LWPOLYLINE,HATCH,MPOLYGON,REGION") (-4 . "<AND") (0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "AND>") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 8) (-4 . "AND>") (-4 . "OR>") ) ) (progn (setq tot 0.0) (vla-StartUndoMark *acdoc*) (vlax-for obj (setq ss (vla-get-ActiveSelectionset *acdoc*)) (setq tot (+ tot (vla-get-Area obj)) lst (cons obj lst) ) ) (vla-delete ss) (initget 1) (setq ins (getpoint "\nSpécifiez le point d'insertion: ") scl (caddr data) blk (vla-insertBlock Space (vlax-3d-point (trans ins 1 0)) bloc scl scl scl 0.0 ) ) (vla-put-layer blk (cadddr data)) (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8)) (foreach att (vlax-invoke blk 'GetAttributes) (cond ((= (vla-get-TagString att) "NUMERO") (vla-put-TextString att (car data)) ) ((= (vla-get-TagString att) "UNIT") (vla-put-TextString att (cadr data)) ) ((= (vla-get-TagString att) "SURFACE") (vla-put-Textstring att (rtos (/ tot (distof (getenv "areaConv"))) 2 (atoi (getenv "AreaPrec")) ) ) ) ((= (vla-get-TagString att) "NOBJ") (vla-put-TextString att (itoa (length lst))) ) ) ) (vlax-ldata-put blk "TotalArea" (mapcar 'vla-get-Handle lst) ) (setvar "DIMZIN" dz) ;;------------------------------------------------------------------;; ;; Création des réacteurs (foreach obj lst (vlr-object-reactor (list obj) (vla-get-Handle blk) '((:vlr-erased . GC:AREAOBJECTERASED) (:vlr-unerased . GC:AREAOBJECTUNERASED) (:vlr-modified . GC:AREAOBJECTMODIFIED) ) ) ) ;;------------------------------------------------------------------;; (vla-EndUndoMark *acdoc*) ) ) ) (princ "\nLe bloc \"TotalArea\" est introuvable.") ) (princ) ) ;;;===============================================;;; ;;; AREAEDIT (gile) ;;; Lie ou délie les objets sélectionnés au bloc "TotalArea" (defun c:AreaEdit (/ *error* lst blk obj elst rea) (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "\Erreur: " msg)) ) (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) lst ) (vla-EndUndoMark *acdoc*) (princ) ) (sssetfirst nil nil) (if (setq lst (gc:AreaGet "\nSélectionnez le bloc à modifier: ")) (progn (setq blk (car lst) lst (cadr lst) ) (vla-StartUndoMark *acdoc*) (while (setq obj (car (entsel "\nSélectionnez un objet à ajouter ou supprimer: " ) ) ) (setq elst (entget obj)) (if (or (member (cdr (assoc 0 elst)) '("ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "HATCH" "MPOLYGON" "REGION" ) ) (and (= (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand 120 (cdr (assoc 70 elst)))) ) (and (= (cdr (assoc 0 elst)) "SPLINE") (= 8 (logand 8 (cdr (assoc 70 elst)))) ) ) (if (member (setq obj (vlax-ename->vla-object obj)) lst) (progn (setq lst (vl-remove obj lst)) (vla-highlight obj :vlax-false) (if (setq rea (gc:GetAreaObjectReactor obj blk)) (vlr-remove rea) ) ) (progn (setq lst (cons obj lst)) (vla-highlight obj :vlax-true) (vlr-object-reactor (list obj) (vla-get-Handle blk) '((:vlr-erased . GC:AREAOBJECTERASED) (:vlr-unerased . GC:AREAOBJECTUNERASED) (:vlr-modified . GC:AREAOBJECTMODIFIED) ) ) ) ) ) (gc:TotalAreaUpd blk lst) ) (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) lst ) ) (vla-EndUndoMark *acdoc*) ) (princ) ) ;;;===============================================;;; ;;; AREASHOW (gile) ;;; Met en surbrillance les objets liés au bloc sur lequel passe le curseur (defun c:AreaShow (/ lst) (and (setq lst (gc:AreaGet "")) (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) (cadr lst) ) ) (princ) ) ;;;===============================================;;; ;;; AREACONV (gile) ;;; Modifier la valeur de la variable AREACONV ;;; Cette variable, enregistrée dans la base de registre gère le facteur ;;; de conversion pour les unités de surface. ;;; exemple : 10000 pour cm² -> m², 1000000 (ou 1e6) pour m² -> km² (defun c:AreaConv () (or (getenv "AreaConv") (setenv "AreaConv" "1")) (while (not ((lambda (r) (or (= r "") (< 0 (distof r)) ) ) (setq r (getstring (strcat "\nEntrez une nouvelle valeur pour AREACONV <" (getenv "AreaConv") ">: " ) ) ) ) ) (princ "\nNécessite un nombre strictement positif") ) (or (= r "") (and (setenv "AreaConv" r) (gc:AreaUpdAll)) ) (princ) ) ;;;===============================================;;; ;;; AREAPREC (gile) ;;; Modifier la valeur de la variable AREAPREC ;;; Cette variable, enregistrée dans la base de registre, gère le nombre de ;;; décimales affichées. (defun c:AreaPrec () (or (getenv "AreaPrec") (setenv "AreaPrec" (itoa (getvar "LUPREC"))) ) (while (not ((lambda (r) (or (= r "") (and (= 'INT (type (read r))) (<= 0 (atoi r)) ) ) ) (setq r (getstring (strcat "\nEntrez une nouvelle valeur pour AREAPREC <" (getenv "AreaPrec") ">: " ) ) ) ) ) (princ "\nNécessite un nombre entier positif") ) (or (= r "") (and (setenv "AreaPrec" r) (gc:AreaUpdAll)) ) (princ) ) ;;;===============================================;;; ;;; AreaHelp (gile) ;;; Ouvre l'aide (defun c:areahelp () (help "TotalArea") (princ) ) (foreach cmd '("c:TotalArea" "c:AreaEdit" "c:AreaShow" "c:AreaConv" "c:AreaPrec") (setfunhelp cmd "TotalArea.chm") ) ;;;================== SOUS ROUTINES ==================;;; ;;; gc:TotalAreaUpd (gile) ;;; Mise à jour les attribus d'un bloc "TotalArea" (defun gc:TotalAreaUpd (blk lst / *error* dz tot new) (vl-load-com) (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "\Erreur: " msg)) ) (setvar "DIMZIN" dz) (princ) ) (setq dz (getvar "DIMZIN")) (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8)) (if lst (progn (setq tot 0.0) (foreach obj lst (if obj (setq tot (+ tot (vla-get-Area obj)) new (cons (vla-get-Handle obj) new) ) ) ) (foreach att (vlax-invoke blk 'GetAttributes) (cond ((= (vla-get-TagString att) "SURFACE") (vla-put-Textstring att (rtos (/ tot (distof (getenv "areaConv"))) 2 (atoi (getenv "AreaPrec")) ) ) ) ((= (vla-get-TagString att) "NOBJ") (vla-put-TextString att (itoa (length new))) ) ) ) ) (foreach att (vlax-invoke blk 'GetAttributes) (cond ((= (vla-get-TagString att) "SURFACE") (vla-put-Textstring att (rtos 0.0 2 (atoi (getenv "AreaPrec"))) ) ) ((= (vla-get-TagString att) "NOBJ") (vla-put-TextString att "0") ) ) ) ) (vlax-ldata-put blk "TotalArea" new) (setvar "DIMZIN" dz) ) ;;;===============================================;;; ;;; gc:AreaGet (gile) ;;; Retourne un liste contenant un bloc "TotalArea" et la liste des objets liés ;;; Les objets liés à un bloc sont mises en surbrillance quand le curseur est sur ce bloc (defun gc:AreaGet (msg / *error* gr ent l1 found blk obj l2) (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)) ) (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) l2 ) (princ) ) (princ msg) (while (and (setq gr (grread T 4 2)) (= (car gr) 5)) (if (and (setq ent (nentselp (cadr gr))) (or (and (caddr ent) (setq ent (last (last ent))) ) (setq ent (cdr (assoc 330 (entget (car ent))))) ) ) (if (and (setq blk (vlax-ename->vla-object ent)) (= (vla-get-ObjectName blk) "AcDbBlockReference") (= (vla-get-EffectiveName blk) name) ) (progn (setq found T l1 (vlax-ldata-get ent "TotalArea") ) (foreach h l1 (if (setq obj (gc:HandleToObject h)) (progn (vla-highlight obj :vlax-true) (or (member obj l2) (setq l2 (cons obj l2))) ) ) ) ) ) (progn (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) l2 ) (setq l2 nil found nil ) ) ) ) (if (and (= (car gr) 3) found) (list blk l2) (mapcar (function (lambda (x) (vla-highlight x :vlax-false))) l2 ) ) ) ;;;===============================================;;; ;;; gc:AreaUpdAll ;;; Met à jour tous les blocs "ToTalArea" (defun gc:AreaUpdAll (/ ss) (if (ssget "_X" '((0 . "INSERT") (2 . "TotalArea,`*U*"))) (progn (vlax-for blk (setq ss (vla-get-activeSelectionSet *acdoc*)) (if (= (vla-get-EffectiveName blk) name) (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject (vlax-ldata-get blk "TotalArea") ) ) ) ) (vla-delete ss) ) ) ) ;;;===============================================;;; ;;; gc:GetAreaObjectReactor ;;; Retourne le réacteur de l'objet lié au bloc ;;; Arguments ;;; obj : l'objet propriétaire (vla-object) ;;; blk : le bloc lié à l'objet (vla-object) ;;; ;;; Retour : le reacteur ou nil (defun gc:GetAreaObjectReactor (obj blk / lst rea loop) (setq lst (cdr (assoc :VLR-Object-Reactor (vlr-reactors))) loop T ) (while (and lst loop) (setq rea (car lst) lst (cdr lst) ) (if (and (equal (vlr-owners rea) (list obj)) (= (vlr-data rea) (vla-get-Handle blk)) ) (setq loop nil) (setq rea nil) ) ) rea ) ;;;===============================================;;; ;;; gc:GetItem (gile) ;;; Retourne le vla-object de l'item s'il est présent dans la collection ;;; ;;; Arguments ;;; col : la collection (vla-object) ;;; name : le nom de l'objet (string) ou son indice (entier) ;;; ;;; Retour : le vla-object ou nil (defun gc:GetItem (col name / obj) (vl-catch-all-apply (function (lambda () (setq obj (vla-item col name)))) ) obj ) ;;;===============================================;;; ;;; gc:HandleToObject (gile) ;;; Retourne le VLA-OBJECT d'après son handle ;;; Argument ;;; handle : le handle de l'objet ;;; ;;; Retour : le vla-object ou nil (defun gc:HandleToObject (handle / obj) (vl-catch-all-apply (function (lambda () (setq obj (vla-HandleToObject (vla-get-ActiveDocument (vlax-get-acad-object)) handle ) ) ) ) ) obj ) ;;;================== RETRO APPELS ==================;;; (defun GC:AREAOBJECTERASED (own rea lst) (vlr-remove rea) ) ;;;===============================================;;; (defun GC:AREAOBJECTUNERASED (own rea lst / blk) (if (setq blk (gc:HandleToObject (vlr-data rea))) (vlr-add rea) (vlr-remove rea) ) ) ;;;===============================================;;; ;;;(defun GC:AREAOBJECTMODIFIED (own rea lst / blk data) ;;; (if (setq blk (gc:HandleToObject (vlr-data rea))) ;;; (if (setq data (vlax-ldata-get blk "TotalArea")) ;;; (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject data)) ;;; ) ;;; (vlr-remove rea) ;;; ) ;;;) (defun GC:AREAOBJECTMODIFIED (own rea lst) (setq *gc:TotalAreaModified* (cons rea *gc:TotalAreaModified*)) (if (zerop (getvar 'cmdactive)) (or *gc:TotalAreaLispReactor* (setq *gc:TotalAreaLispReactor* (vlr-lisp-reactor nil '((:VLR-lispEnded . GC:TOTALAREALISPENDED)) ) ) ) (or *gc:TotalAreaCommandReactor* (setq *gc:TotalAreaCommandReactor* (vlr-command-reactor nil '((:VLR-commandEnded . GC:TOTALAREACOMMANDENDED)) ) ) ) ) ) ;;;===============================================;;; (defun GC:TOTALAREACOMMANDENDED (rea cmd / blk data) (foreach r *gc:TotalAreaModified* (if (setq blk (gc:HandleToObject (vlr-data r))) (if (setq data (vlax-ldata-get blk "TotalArea")) (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject data)) ) (vlr-remove r) ) ) (vlr-remove *gc:TotalAreaCommandReactor*) (setq *gc:TotalAreaCommandReactor* nil *gc:TotalAreaModified* nil ) ) ;;;===============================================;;; (defun GC:TOTALAREALISPENDED (rea cmd / blk data) (foreach r *gc:TotalAreaModified* (if (setq blk (gc:HandleToObject (vlr-data r))) (if (setq data (vlax-ldata-get blk "TotalArea")) (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject data)) ) (vlr-remove r) ) ) (vlr-remove *gc:TotalAreaLispReactor*) (setq *gc:TotalAreaLispReactor* nil *gc:TotalAreaModified* nil ) ) ;;;==================== CREATION DES REACTEURS AU CHARGEMENT ====================;;; ((lambda (/ ss obj) (foreach r (cdr (assoc :VLR-Object-Reactor (vlr-reactors))) (if (member '(:VLR-erased . GC:AREAOBJECTERASED) (vlr-reactions r) ) (vlr-remove r) ) ) (if (ssget "_X" '((0 . "INSERT") (2 . "TotalArea,`*U*"))) (progn (vlax-for blk (setq ss (vla-get-ActiveSelectionSet *acdoc*)) (if (and (vlax-property-available-p blk 'EffectiveName) (= (strcase (vla-get-EffectiveName blk)) (strcase name)) ) (progn (foreach hand (vlax-ldata-get blk "TotalArea") (if (setq obj (gc:HandleToObject hand)) (vlr-object-reactor (list obj) (vla-get-Handle blk) '((:vlr-erased . GC:AREAOBJECTERASED) (:vlr-unerased . GC:AREAOBJECTUNERASED) (:vlr-objectClosed . GC:AREAOBJECTMODIFIED) ) ) ) ) (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject (vlax-ldata-get blk "TotalArea") ) ) ) ) ) (vla-delete ss) ) ) ) ) (princ) Donc à la ligne #241 où j'ai ajouté le commentaire ";; <<< --- Définition du nom du bloc pour le reste du programme !!!!!!!", il y a le nom du bloc entre guillemets "". C'est donc ici et seulement ici que tu as normalement besoin de le modifier car j'ai ajouté la variable 'name' pour pouvoir l'utiliser ailleurs dans le programme. Je l'ai déjà modifié au nom que tu m'as donné "IDLOCAL". Je n'ai pas pris le temps de testé le programme donc peut-être ai-je oublié quelque chose ^^" Évidemment il faudra modifier le bloc/fichier en fonction de tes demandes pour pouvoir correspondre avec le programme. Bisous, TotalArea.lsp

Coucou, Je me souviens avoir écrit une fonction dans ce principe il y a longtemps : ; Permet de récupérer les coordonnées et données associées d'un point situé à une distance spécifiée d'un élément linéaire : ;--- La fonction (get-AlignPoint-AtDist) possède 3 arguments ;--- curve-obj correspond au nom d'entité de l'objet servant de référence (peut être le nom d'entité ou le VLA-Object) ;--- dist correspond à l'emplacement du point situé sur la courbe pour une distance donnée depuis le point de départ ;--- e correspond au décalage de la courbe de référence. Une valeur positive placera le point calculé au-dessus de la courbe de référence et une valeur négative ; placera le point calculé au-dessous de la courbe de référence (dans le sens de lecture de la courbe) ;---Renvoie une liste de paire pointée de la forme ; ((-1 . <Nom d'entité>) (10 . PointOnCurve) (11 . PointOutsideCurve) (50 . Angle-Rad_Tangente) (1041 . DistanceOnCurve)) ; si l'objet n'est pas un objet linéaire, retourne nil (defun get-AlignPoint-AtDist (curve-obj dist e / lg u a b pt Ang Align) (cond ((= (type curve-obj) 'VLA-OBJECT) (setq curve-obj (vlax-vla-object->ename curve-obj))) ((= (type curve-obj) 'ENAME) (setq curve-obj curve-obj)) (t ((exit) (princ))) ) (if (wcmatch (cdr (assoc 0 (entget curve-obj))) "ARC,CIRCLE,ELLIPSE,*LINE") (progn (cond ((> dist (setq lg (vlax-curve-getdistatparam curve-obj (vlax-curve-getendparam curve-obj)))) (setq dist lg) ) ((< dist 0) (setq dist 0.0) ) ) (setq u (vlax-curve-getfirstderiv curve-obj (vlax-curve-getparamatdist curve-obj dist)) a (car u) b (cadr u) pt (vlax-curve-getpointatdist curve-obj dist) Align (polar pt (setq Ang (angle '(0.0 0.0 0.0) (list (- b) a 0.0))) e) ) (list (cons -1 curve-obj) (cons 10 pt) (cons 11 Align) (cons 50 (cond ((not (minusp e)) (- Ang (/ pi 2.0))) ((minusp e) (+ Ang (/ pi 2.0))))) (cons 1041 dist)) ) ) ) Donc si on épure la fonction pour pouvoir ensuite l'intégrer dans le programme SEGLEN, on peut avoir ceci : (defun AlignPoint (curve pt d / u a b) (setq u (vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve pt)) a (car u) b (cadr u) pt (polar pt (angle '(0.0 0.0 0.0) (list (- b) a 0.0)) d) ) ) Et du coup il te suffit de remplacer les lignes (vlax-3d-point pt) par (vlax-3d-point (AlignPoint obj pt d)) et d'ajouter la ligne (setq d 0.15) (ou autre valeur, car je ne sais pas dans quelle unité de dessin tu travailles..) au début du programme, voire si besoin si tu veux avoir le choix pour la distance 😉 (setq d (getreal "\nSpécifier la distance entre chaque segment et le texte implanté : ")) Ne pas oublier de rajouter la variable 'd' dans les variables locales et la fonction (AlignPoint) si tu veux que chat marche ! Si c'est trop compliqué à faire ou si tu as peur d'oublier quelque chose, je peux aussi re-poster le programme modifié si besoin 🙂 Autre information importante, si 'd' est positif alors le décalage se fera à gauche du segment (en suivant le sens de lecture de la polyligne), et si 'd' est négatif alors le décalage se fera à droite du segment (en suivant le sens de lecture). Bisous, Luna

Coucou, +1 avec lecrabe ! Si toutefois c'est une erreur et que tu as bien un AutoCAD full, voici les fichiers (non testé) en PJ. A savoir que je me suis contentée de faire une recherche de chaque occurrence de "LABEL" et "AREA" pour les remplacer par "NUMERO" et "SURFACE". Et j'ai simplement modifiée la définition du bloc. Cependant, puis-je tout de même savoir quel est le besoin pour cette modification ? Après tout je doute que cela vous empêche de travailler si les attributs sont nommés à l'anglaise, et s'il y a des modifications importantes de ces programmes sur internet, ils vous faudra à chaque fois penser à remplacer les noms d'attributs pour les avoir en français... Pas la meilleure option surtout si vous n'avez pas ou peu de connaissances de programmation. Bisous, Luna TotalArea.lsp TotalArea.dwg