(gile)

Un petit conseil pour la syntaxe, sert toi de l'éditeur VisualLISP, formatage, couleurs différentes pour les fonctions, le chaines, les réels et les entiers, double clic pour l'appariement des paranthèses, double clic pour sélectionner une fonction et accés direct à l'aide (icône au point d'interrogation) ...

Re, Je pense avoir trouvé, il fallait effectivement remettre une variable à nil (lst) entre chaque entité traitée. Merci pour les tests ;) Le LISP est re-modifié. [Edité le 4/9/2006 par (gile)]

Comme il semble qu'en ce moment il y ait plusieurs membres qui cherchent à faire des routines pour insérer un bloc ou un champ dynamique lié à un objet pour indiquer une surface ou un périmètre, je propose, à titre d'exemple un petit LISP qui insère un bloc contenenant trois attributs dont deux champs dynamiques (longueur et aire). Chacun pourra le modifier suivant ses besoins. En l'état le LISP fonctionne avec un bloc qui doit exister dans la collection du dessin courant (ou dans le gabarit ayant servi à sa création) ou être un fichier .dwg créé avec la commande wbloc et enregistré dans un dossier du chemin de recherche d'AutoCAD. Le nom du bloc doit être : "Pline_block" ou "Pline_block.dwg" (wbloc) Le bloc doit contenir 3 attributs : pièce, longueur et aire à sélectionner dans cet ordre lors de la création du bloc. Ces attributs seront renseignés via le LISP (donc inutile de spécifier une invite). Le LISP invite à sélectionner une polyligne (ouverte ou fermée), à entrer le nom de la pièce (premier attribut) et à spécifier le point d'insertion. ;;; Pline_bloc -Gilles Chanteau- 04/09/06 ;;; Insère le bloc "pline_block" après sélection d'une polyligne ;;; Attribut 1 : Nom de la pièce ;;; Attribut 2 : Longueur de la polyligne ;;; Attribut 3 : Aire de la polyligne (defun c:pline_block (/ AcDoc Space bloc nom ent aire long ins) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((tblsearch "BLOCK" (setq bloc "Pline_block"))) ((findfile (setq bloc "Pline_block.dwg"))) (T (setq bloc nil)) ) (if bloc (progn (while (not (setq ent (car (entsel))))) (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (progn (setq obj (vlax-ename->vla-object ent) id (vla-get-ObjectID obj) long (strcat "% (itoa id) ">%).Length>%" ) aire (strcat "% (itoa id) ">%).Area \\f \"%lu6%qf1\">%" ) ) (initget 1) (setq nom (getstring T "\nNom de la pièce: ")) (initget 1) (setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq ref (vla-InsertBlock Space (vlax-3d-point ins) bloc 1.0 1.0 1.0 0.0 ) ) (mapcar '(lambda (x y) (vla-put-TextString x y)) (vlax-invoke ref 'GetAttributes) (list nom long aire) ) (vla-regen AcDoc acActiveViewport) ) (alert "L'objet sélectionné n'est pas une polyligne.") ) ) (alert "Le bloc \"Pline_block\" est introuvable.") ) (princ) )

Salut, Je n'arrive pas à reproduire les erreurs que tu décris, mais j'ai trouvé un autre caractère à supprimer (je modifie le code au dessus) les fonctions vl-string ... sont fort utiles pour la manipultion des chaines, j'en avait fait des équivalence en LISP "d'avant" ici

Salut, Le problème de mise en page n'est pas résolu, tu devrais éditer la réponse N°2 et fermer le code correctement. Sinon, dans le code que tu donnes tu insères 2 fois le bloc, en faisant comme je disais, ça devrait marcher (en tout cas ça marche chez moi) : (defun c:insbloc ( / old_dia) (setq old_dia (getvar "ATTDIA")) (setvar "ATTDIA" 0) (command "_.insert" "testatt" "0,0" (getvar "dimscale") "" "" "Val att 1" "Val att 2" "Val att 3" ) (setvar "ATTDIA" old_dia) ) Vérifie aussi la valeur de ATTREQ qui doit être à 1 [Edité le 4/9/2006 par (gile)]

Salut, Tu peux aussi utiliser la fonction (member ...) qui retorurne la liste deouis la première occurence de l'élément recherché ou nil s'il n'y est pas présent : (member "c" '("a" "b" "c" "d")) retourne ("c" "d") (member "z" '("a" "b" "c" "d")) retourne nil donc (if (member "c" '("a" "b" "c" "d")) ... retournera T Si tu veux comparer des coordonnées, il vaut mieux utiliser (vl-member-if ...) avec la fonction (equal ...) et un fuzz. (if (vl-member-if '(lambda (pt) (equal coordonnées_test pt 1e-9)) toto) (princ "\ncoordonnées_test est dans toto) (princ "\ncoordonnées_test n'est pas dans toto) )

Si tu dessines en mètres (1 unité de dessin = 1 mètre) il y a un rapport de 1 pour 1000 entre l'espace objet et l'espace papier où l'unité est le millimètre. Pour compenser ce rapport dans ta mise en page, si tu conserves une échelle 1/1 (1 unité = 1 millimètre) dans le gestionnaire de mise en page, tu peux multiplier l'échelle à laquelle tu veux imprimer par 1000 pour trouver l'echelle à donner à ta fenêtre de présentation, soit pour le centième 1/100 X 1000 = 10. C'est la méthode donnée par portmaria. Pour spécifier l'échelle, le plus simple est de sélectionner la fenêtre de présentation et de spécifier l'échelle dans la liste déroulante de la barre d'outils "Fenêtres". Tu peux aussi modifier l'échelle du tracé dans le "Gestionnaire des mises en page" en spécifiant : 1000 mm = 1 unité. Dans ce cas, pour imprimer au 1/100, tu donnes l'échelle 1/100 à la fenêtre de présentation, mais la hauteur de texte du style utilisé dans l'espace papier devra être donnée en mètres (0.003 pour un texte de 3 mm de haut) de même pour ton style de cote si tu cotes dans l'espace papier. Ceci dit, comme je travaille en millimètres je ne suis pas confronté à ce type de problème. [Edité le 3/9/2006 par (gile)]

En gros, ce que fait le LISP et comment on devrait pouvoir le traduire en VBA : Sélection de la polyligne (getEntiy Method) S'assurer que c'est une lwpolyline (Objectname Property) Et qu'elle est fermée (Closed Property) Récupérer l'ID (ObjectID Property) Constituer la chaine en concatenant "%%).Area \\f \"%lu6%qf1\">%" plus les préfixe et suffixe que l'on veut (?) Créer une région à partir de la polyligne (addRegion Method) Récupérer le centre de gravité de la région (Centroid Property) Créer un Mtext (addMtext Method) Justifier le texte (AttachmentPoint Property -> acAttachmentPointMiddleCenter et InsertionPoint Property) Supprimer la région (Delete Method)

Re, Un champ c'est un TEXTE ou un MTEXE dont la syntaxe est un code. Pour récupérer ce code, tu peux le trouver dans la fenêtre de la commande "champ" en bas sous "Expression de champ:" ou en utilisant FieldCode Method sur un champ (ou un texte en contenant un). : "%%" pour la date, ou "%%).Area \f "%lu6%qf1">%" pour l'aire d'un objet. Dans le dernier cas "2128135232" est l'ID de l'objet (ObjectID Property). Il faut donc concatener (il doit bien y avoir une fonction VBA pour ce faire) "%%).Area \f "%lu6%qf1">%" pour constituer la chaine de caractère à passer comme argument à addText ou addMtext Method.

Salut, Je n'ai peut-être pas compris la question, mais si tu insères un bloc contenant des attributs à renseigner, tu peux les renseigner lors de l'insertion du bloc, plutôt que les modifier après. Il faut mettre la variable ATTDIA à 0 pour ne pas avoir de boite de dialogue : (setq old_dia (getvar "ATTDIA")) (setvar "ATTDIA" 0) (command "_.insert" "testatt" "0,0" (getvar "dimscale") "" "" "Valeur de l'attribut 1" "Valeur de l'attribut 2" "Valeur de l'attribut 3" ) (setvar "ATTDIA" old_dia) Sinon, pour pour récupérer la dernière entité créée on utilise la fonction (entlast) et on peut ensuite boucler sur les sous entités du bloc (attributs) pour en modifier la valeur. Tu peux voir, par exemple, ce sujet récent où la référence de bloc est sélectionnée. Tu peux donc remplacer : (setq BlocSelec (car (entsel))) par : (setq BlocSelec (entlast)) et ensuite faire la boucle sur les attributs avec les nouvelles valeurs contenues dans des variables incrémentées. Pour la boucle, comme dit plus bas dans le sujet cité, je pense qu'il est préférable d'utiliser (repeat...) [Edité le 3/9/2006 par (gile)]

Re, pareil pour moi, avec VB/VBA Une autre façon, en utilisant les champs plutôt que les réacteurs avec lesquels je ne suis pas familier du tout. Le LISP place le texte sur le centre de gravité de la polyligne. On peut changer le suffixe, " mm²", suivant l'unité courante. ;;; Pline_area Place un texte avec champ "Aire" sur le centre de ;;; gravité de la polyligne fermées sélectionnée. (defun c:pline_area (/ ss obj txt Space reg pt) (while (not (setq ss (ssget "_:S:E" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))) ) ) ) (setq obj (vlax-ename->vla-object (ssname ss 0)) txt (strcat "Aire = " "% (itoa (vla-get-ObjectID obj)) ">%).Area \\f \"%lu6%qf1\">%" " mm²" [color=#3366FF]; Suffixe à changer suivant l'unité utilisée[/color] ) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)) ) ) reg (vlax-invoke Space 'addRegion (list obj)) pt (trans (vlax-get (car reg) 'Centroid) 1 0) mtext (vla-addMtext Space (vlax-3d-point pt) (getvar "TEXTSIZE") txt ) ) (vla-put-width mtext 0.0) (vla-put-AttachmentPoint mtext acAttachmentPointMiddleCenter ) (vla-put-InsertionPoint mtext (vlax-3d-point pt)) (vla-delete (car reg)) (princ) ) [Edité le 3/9/2006 par (gile)]

Salut, Essaye REA dans les LISP de Patrick_35

Salut, Si tu ne veux pas que ce soit AutoCAD qui décide à ta place de la manière dont il va balayer le profil, il faut le positionner sur le chemin (comme si c'était une section du futur solide). http://img172.imageshack.us/img172/2794/ellipse1bb7.png http://img502.imageshack.us/img502/7512/ellipse2jk2.png http://img502.imageshack.us/img502/3205/ellipse3sw3.png http://img348.imageshack.us/img348/4439/ellipse4pm9.png

Salut, Si le problème vient bien d'une différence de provenance des hachures (acad.pat/acadiso.pat), tu peux essayer le LISP suivant, il devrait uniformiser les hachures ayant les même propriétés. Le LISP, "copie les propriétés" de la hachure, la supprime et la recrée à partir du fichier.pat courant (acad.pat si MEASUREMENT est à 0, acadiso.pat si MEASUREMENT est à 1). (defun c:hp_c (/ ss n ent e_lst) (setq ss (ssget '((0 . "HATCH")))) (if ss (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) e_lst (entget ent) ) (entdel ent) (entmake e_lst) ) ) (princ) ) [Edité le 1/9/2006 par (gile)]

Bien sûr qu'elle servent !!! Ce sont elles qui modifient les données du bloc. (setq att (subst (cons 1 NEWVAL2) (assoc 1 att) att)) Modifie la liste des données contenues dans la variable att (changement de la valeur de l'attribut) (entmod att) Met à jour les nouvelles données de l'attribut (entupd (cdr (assoc -1 att))) Met à jour le bloc dans le dessin (cette dernière peut peut-être être supprimée, à essayer) [Edité le 31/8/2006 par (gile)]

Salut et bienvenue, Je ne comprends pas du tout la première question, et je ne suis pas sûr de comprendre la seconde. Repose ta question en essayant d'être plus clair, et tu auras certainement une (ou des) réponse(s) claire(s).

En fait, je fais une boucle avec while par habitude, mais le plus logique serait de faire un : (repeat 4 ...) comme sait qu'il y a 4 attributs à modifier, ce qui devrait être plus rapide (quand on est à la micro seconde près). ;)

Plus logique, peut-être mais ça me semblait plus simple à comprendre avec le commentaire : "boucle tant que att est un attribut". Pour Morgul, donc, on peut aussi boucler en faisant : (while (not (= (cdr (assoc 0 att)) "SEQEND")) ...)

Re, (if (not (tblsearch "block" "Nom_du_bloc")) (progn ; ici ton code pour créer le bloc ) ; fin de progn ) ; fin de if (command "_.insert" ...)

Salut, Le problème vient, je pense de : (setq att (entnext (cdr (assoc -1 att)))) qui retourne un nom d'entité et pas la liste des données DXF de l'entité. Si tu fais (setq att (entget (entnext (cdr (assoc -1 att))))) tu pourras modifier la liste de données du second attribut comme tu l'a fait pour le premier et ainsi de suite... Pour éviter d'avoir à répéter 4 fois le même code (à la valeur de NEWVALn près) on peut faire une boucle. Comme la valeur des attributs est déjà définie (sinon tu utiliserais ATTEDIT) de façon incrémentée NEWVAL1, NEWVAL2, NEWVAL3... on peut récupérer ces valeurs dans la boucle à l'aide d'un compteur. Exemple de ce que l'on pourrait faire (j'ai volontairement décomposé le codes pour une meilleure compréhension, il pourrait être plus concis) (defun c:TEST (/ NEWVAL1 NEWVAL2 NEWVAL3 NEWVAL4 BlocSelec att n newval) (setq NEWVAL1 (getstring t "\nEntrez la valeur de l'attribut 1 : ")) (setq NEWVAL2 (getstring t "\nEntrez la valeur de l'attribut 2 : ")) (setq NEWVAL3 (getstring t "\nEntrez la valeur de l'attribut 3 : ")) (setq NEWVAL4 (getstring t "\nEntrez la valeur de l'attribut 4 : ")) (setq BlocSelec (car (entsel))) ; pour sélectionner un bloc contenant des attributs (setq att (entget (entnext BlocSelec))) ; pour trouver le premier attribut (setq n 0) ; mise du compteur à 0 (while (= (cdr (assoc 0 att)) "ATTRIB") ; boucle tant que att est un attribut (setq n (1+ n)) ; incrémentation du compteur (setq newval (eval (read (strcat "NEWVAL" (itoa n))))) ; valeur de NEWVALn (setq att (subst (cons 1 newval) (assoc 1 att) att)) ; pour changer la valeur de l'attribut (entmod att) (entupd (cdr (assoc -1 att))) (setq att (entget (entnext (cdr (assoc -1 att))))) ; données de l'attribut suivant (setq att (subst (cons 1 NEWVAL2) (assoc 1 att) att)) ; pour changer la valeur de l'attribut (entmod att) (entupd (cdr (assoc -1 att))) ) ; fin de while (princ) )

Salut, Pour savoir si un bloc est déjà présent dans la collection du dessin, tu peux utiliser la fonction tblsearch (ou tblobjname) : (if (tblsearch "block" "Nom_du_bloc") (princ "\nLe bloc existe déjà.") (princ "\nLe bloc n'existe pas encore.") )

Salut, Voilà une version un peu plus aboutie, mais pas testée en profondeur. Elle devrait fonctionner aussi pour les textes de plus de 250 caractères et pour les hauteurs de texte forcées. (defun c:c_txt (/ ss n txt e_lst str start end lst) (while (not (setq ss (ssget '((0 . "MTEXT")))))) (repeat (setq n (sslength ss)) (setq txt (ssname ss (setq n (1- n))) e_lst (entget txt) str (apply 'strcat (mapcar 'cdr (append (vl-remove-if-not '(lambda (x) (= (car x) 3)) e_lst) (list (assoc 1 e_lst)) ) ) ) ) (while (setq start (vl-string-search "{\\" str)) (setq str (vl-string-subst "" "{" (vl-string-subst "" "}" str start) start ) ) ) (setq start 0) (while (setq start (vl-string-search "\\" str start)) (cond ((= "\\P" (substr str (1+ start) 2)) (setq start (1+ start) end (1+ start) ) ) ((= "\\L" (substr str (1+ start) 2)) (setq end (+ (vl-string-search "L" str start) 2)) ) ((= "\\l" (substr str (1+ start) 2)) (setq end (+ (vl-string-search "l" str start) 2)) ) (T (setq end (+ (vl-string-search ";" str start) 2))) ) (setq str (vl-string-subst "" (substr str (1+ start) (- end start 1)) str ) ) ) (setq lst nil) (if (< 250 (strlen str)) (progn (while (< 249 (strlen str)) (setq lst (cons (cons 3 (substr str 1 250)) lst) str (substr str 251) ) ) (setq lst (reverse (cons (cons 1 str) lst))) ) (setq lst (cons (cons 1 str) lst)) ) (setq e_lst (append (vl-remove-if '(lambda (x) (or (= (car x) 3) (= (car x) 1))) e_lst ) lst ) ) (entmod e_lst) ) (princ) ) [Edité le 4/9/2006 par (gile)] [Edité le 4/9/2006 par (gile)]

Salut, Pour la virgule, le plus simple me semble être de paramétrer Excel pour que ce soit le point le séparateur décimal. Je ne me souviens plus si on fait ça depuis Excel ou directement depuis Windows, mais cette méthode a l'avantage de pouvoir utiliser dans Excel le pavé numérique. Sinon, regarde du côté de la fonction LISP vl-string-subst.

Ne t'excuse pas, tu as appris beaucoup en peu de temps, j'en suis impressionné. Je pense qu'il nous arrive à tous d'oublier un truc de temps en temps (en tout cas, moi ça m'arrive).

Salut Bred, Si j'ai bien compris ce que tu voulais faire, ton code fonctionne, tant que le SCU est parallèle au SCG. Quand on pivote le SCU, de 90° sur l'axe des X par exemple, l'expression : (trans '(0 1 0) 1 0) retourne (0.0 2.22045e-016 1.0) au lieu du théorique (0 0 1), donc pour comparer des points quand on travaille en 3D avec des SCU "biscornus" il vaut mieux laisser une approximation dans la comparaison. Je laisses en général 1e-9 soit le milliardième, ce qui me semble fonctionner tout en restant tolérable. (setq pta nil ptd nil) (while (or (and (equal (car pta) (car ptd) 1e-9) (equal (cadr pta) (cadr ptd) 1e-9) ) (equal (caddr pta) (caddr ptd) 1e-9) ) (setq ptd (getpoint "\n Point de départ :") pta (getpoint ptd "\n Point d'arrivé :") ) )