Matt666

Le pb vient de la références de bloc... Tu peux utiliser l'une de ces deux routines.. Normaliser blocs : Place les entités constituant chaque blocs sur le calque 0 en couleur DuBloc (defun c:nb (/ i n tot) (setq temperror *error* *error* myerror echoold (getvar "cmdecho") ) (setvar "cmdecho" 0) (COMMAND "-layer" "L" "*" "a" "*" "r" "*" "d" "0" "") (if (/= nil (setq i (tblnext "block" t))) (progn (setq tot 1) (while i (setq n (cdr (assoc -2 i))) (while n (setq n (entget n)) (if (/= (cdr (assoc 8 n)) "0")(entmod (subst (cons 8 "0") (assoc 8 n) n))) (if (not (assoc 62 n))(setq n (append n (list (cons 62 0))))) (if (/= (cdr (assoc 62 n)) 0)(entmod (subst (cons 62 0) (assoc 62 n) n))) (setq n (entnext (cdr (assoc -1 n)))) ) (setq i (tblnext "block") tot (1+ tot)) ) (setq sel (ssget "x" (list (cons 0 "INSERT"))) j 0 nat 0) (while (ssname sel j) (setq n (entget (ssname sel j))) (if (assoc 66 n)(progn (setq i (entget (entnext (cdr (assoc -1 n))))) (while (/= (cdr (assoc 0 i)) "SEQEND") (entmod (subst (cons 8 "0") (assoc 8 i) i)) (if (not (assoc 62 i)) (setq i (append i (list (cons 62 0))))) (if (/= (cdr (assoc 62 i)) 0) (entmod (subst (cons 62 0) (assoc 62 i) i))) (entupd (cdr (assoc -1 i))) (setq nat (+ 1 nat) i (entget (entnext (cdr (assoc -1 i))))) ) )) (setq j (1+ j)) ) (princ (strcat "\nTraitement de " (itoa (+ tot nat)) " bloc(s) (" (itoa tot) " dans la table des blocs et " (itoa nat) " étiquette(s) d'attribut(s) de bloc(s) dans le dessin)" )) (redraw) (setvar "cmdecho" echoold) (graphscr) (princ) ) ) ) Normaliser blocs 2 : Place les entités constituant chaque blocs sur le calque 0 en couleur d'ORIGINE (defun c:nb2 () (setq temperror *error* *error* myerror echoold (getvar "cmdecho") ) (setvar "cmdecho" 0) (COMMAND "-layer" "L" "*" "a" "*" "r" "*" "d" "0" "") (if (/= nil (setq i (tblnext "block" t))) (progn (setq tot 1) (while i (setq n (cdr (assoc -2 i))) (while n (setq n (entget n) colorigin (cdr (assoc 62 n))) (if (or (= nil colorigin) (= 256 colorigin) (= "BYLAYER" colorigin)) (setq colorigin (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 n)))))) ) (if (> 0 colorigin) (setq colorigin (- 0 colorigin))) (if (/= (cdr (assoc 8 n)) "0")(entmod (subst (cons 8 "0") (assoc 8 n) n))) (if (not (assoc 62 n))(setq n (append n (list (cons 62 colorigin))))) (entmod (subst (cons 62 colorigin) (assoc 62 n) n)) (setq n (entnext (cdr (assoc -1 n)))) ) (setq i (tblnext "block") tot (1+ tot)) ) ;_ Fin de while ; Normalisation des étiquettes d'attributs de blocs dans le dessin (car une étiquette peut avoir des valeurs de calque, couleur, etc. différentes de ; l'attribut) (setq sel (ssget "x" (list (cons 0 "INSERT")))) (setq j 0) (setq nat 0) (while (ssname sel j) (setq n (entget (ssname sel j))) (if (assoc 66 n)(progn (setq i (entget (entnext (cdr (assoc -1 n))))) (while (/= (cdr (assoc 0 i)) "SEQEND") (entmod (subst (cons 8 "0") (assoc 8 i) i)) (if (not (assoc 62 i))(setq i (append i (list (cons 62 0))))) (if (/= (cdr (assoc 62 i)) 0)(entmod (subst (cons 62 0) (assoc 62 i) i))) (entupd (cdr (assoc -1 i))) (setq nat (+ 1 nat) i (entget (entnext (cdr (assoc -1 i))))) ) )) (setq j (1+ j)) ) (princ (strcat "\nTraitement de " (itoa (+ tot nat)) " bloc(s) (" (itoa tot) " dans la table des blocs et " (itoa nat) " étiquette(s) d'attribut(s) de bloc(s) dans le dessin)" )) (redraw) (setvar "cmdecho" echoold) (graphscr) (princ) ) ) ) A bientot. Matt.

Bah dis quand même, ça peut être intéressant pour les autres !

Et bien tu n'as plus qu'à marquer ce sujet comme résolu ! ;) A bientot. Matt.

Cad ? Chez moi, il fonctionne très bien ! (defun c:COPO (/ cmdecho pol newpol) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (and (setq pol (car (entsel "\nSélectionner la polyligne à continuer :"))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget pol)))) ) (progn (command "_.PLINE" (cdr (assoc 10 (reverse (entget pol))))) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq newpol (entlast)) (command "pedit" pol "j" newpol "" "") )) (setvar "cmdecho" cmdecho) ) Tu as besoin de ça uniquement... Tu as quelle version autoCAD ? Quelle est l'erreur ? [Edité le 25/9/2007 par Matt666]

Sinon essaie ça : ;;; Continuer une polyligne sans obligation de partir par le dernier point (defun c:copo1 (/ lst cmdecho pol newpol) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (and (setq pol (car (entsel "\nSélectionner la polyligne à continuer :"))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget pol)))) ) (progn (princ "\npremier point de la nouvele polyligne : ") (command "_.PLINE") (while (not (zerop (getvar "cmdactive")))(command pause)) (setq newpol (entlast)) (setq lst (append (mapcar 'cdr (remove-if-not '(lambda (x) (= (car x) 10)) (entget pol))) (mapcar 'cdr (remove-if-not '(lambda (x) (= (car x) 10)) (entget pol))) )) (if (doubles lst) (command "pedit" pol "j" newpol "" "") (princ "\nAucun sommet en commun.\nImpossible de continuer la polyligne.") ) )) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) ) ;;; Continuer une polyligne avec obligation de partir par le dernier point (defun c:copo2 (/ cmdecho pol newpol) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (and (setq pol (car (entsel "\nSélectionner la polyligne à continuer :"))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget pol)))) ) (progn (command "_.PLINE" (cdr (assoc 10 (reverse (entget pol))))) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq newpol (entlast)) (command "pedit" pol "j" newpol "" "") )) (setvar "cmdecho" cmdecho) ) ;;; DOUBLES Retourne la liste des doublons d'une liste (defun doubles (lst) (if lst (if (member (car lst) (cdr lst)) (cons (car lst) (doubles (cdr lst))) (doubles (cdr lst)) ) ) ) Tu dois avoi une préférence pour copo2...

Ah bah oui, encore plus simple !!! Je l'avais fait comme ça, aussi, mais ma variable "cmdecho" était à zéro, donc aucun message visible !! C'est pour ça que j'ai du insérer des messages... Petite erreur de derrière les fagots !! Merci Patrick_35 ! A bientôt. Matt.

Salut ! Quand j'ai commencé le Lisp, je m'arrachais les cheveux à essayer de comprendre comment fonctionnent les commandes existantes AutoCAD. Mon premier souhait aurait été de pouvoir voir le code d'une de ces commandes. Alors voilà si ça sert à mieux comprendre le fonctionnement du lisp, voici quelques exemples simples (enfin dans son utilisation !!!) de la commande LIGNE... Bon comme d'hab le code est loin d'être concis, désolé.. Bon je commence. On va voir quatre méthodes pour créer une ou plusieurs lignes. La première est la plus simple : Créer une ligne à partir de deux points. Ici on utilise la commende existante par le biais de la fonction "command". ;;; Créé une ligne simple avec la fonction command (defun c:lign_sim_cmd () (command "_line") (princ "\nSpécifiez Premier point : ") (command pause) (princ "\nSpécifiez le point suivant :") (command pause "") (princ) ) La deuxième permet de créer une ligne simple sans utiliser la commande existante. Donc au moyen d'un "entmake". ;;; Créé une ligne simple avec la fonction entmake (defun c:Lign_sim_ent (/ pt1) (entmake (list (cons 0 "LINE") (cons 10 (setq pt1 (getpoint "\nSpécifiez Premier point : "))) (cons 11 (getpoint pt1 "\nSpécifiez le point suivant :")) )) (princ) ) La troisième méthode permet de dessiner plusieurs lignes avec la commande existante. Pour cela il faut utiliser une boucle (while) qui vérifie l' état de la ligne de commande (avec la variable "CMDACTIVE". ;;; Créé une ou plusieurs lignes avec la fonction command (defun c:lign_mul_cmd () (command "_line") (princ "\nSpécifiez Premier point : ") (command pause) (while (not (zerop (getvar "cmdactive"))) (princ "\nSpécifiez le point suivant ou [annUler] : ") (command pause) ) (princ) ) Enfin la quatrième méthode, et de (très) loin la plus compliquée, consiste à créer une ou plusieurs lignes sans la commande existante. On va utiliser des fonctions personnelles... Voici la fonction principale : ;;; Créé une ou plusieurs lignes avec la fonction entmake (defun c:lign_mul_ent (/ LASTENT LST PT1 PT2 PTST) (setq lst nil) (princ "\nSpécifiez le premier point : ") (setq pt1 (getpoint "\nSpécifiez le premier point : ")) (if (not pt1) (if (or (not (entlast)) (not (member (cdr (assoc 0 (entget (entlast)))) '("LINE" "ARC"))) ) (progn (setq pt1 nil) (while (not (setq pt1 (getpoint "\nAucune ligne ou arc à continuer.\nSpécifiez le premier point : ")))) ) (if (and (setq lastent (entget (entlast))) (eq (cdr (assoc 0 lastent)) "LINE") ) (setq pt1 (cdr (assoc 11 lastent))) (if (and lastent (eq (cdr (assoc 0 lastent)) "ARC") ) (setq pt1 (polar (cdr (assoc 10 lastent)) (cdr (assoc 51 lastent)) (cdr (assoc 40 lastent)) )) ) ) ) ) (if pt1 (progn (setq ptst pt1) (initget 128) (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : ")) (while pt2 (cond ((eq (type pt2) 'LIST) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2) )) (setq lst (cons (entlast) lst)) (initget 128) (if (> (length lst) 1) (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : ")) (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : ")) ) ) ((eq (strcase pt2) "U") (if (> (length lst) 1) (progn (entdel (car lst)) (setq lst (vl-remove (car lst) lst)) (setq pt1 (cdr (assoc 11 (entget (car lst))))) ) (if (eq (length lst) 1) (progn (entdel (car lst)) (setq lst nil pt1 ptst) ) ) ) (initget 128) (if (> (length lst) 1) (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : ")) (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : ")) ) ) ((eq (strcase pt2) "C") (entmake (list (cons 0 "LINE") (cons 10 (cdr (assoc 11 (entget (car lst))))) (cons 11 (cdr (assoc 10 (entget (last lst))))) )) (setq pt2 nil) ) ((eq (type pt2) 'STR) (if (not (member (strcase pt2) '("U" "C"))) (progn (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 (setq pt2 (getcrd pt2 pt1))) )) (setq lst (cons (entlast) lst)) (initget 128) (if (> (length lst) 1) (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : ")) (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : ")) ) )) ) ) ) )) (princ) ) Et les fonctions associées : ;;; Retourne les coordonnées en fonction de la casse de la chaîne de caractères (defun getcrd (str first / ) (cond ((eq (substr str 1 1) "@") (+ (str2lst (substr str 2 (strlen str)) ",") first) ) ((vl-string-position (ascii ",") str nil nil) (str2lst (substr str 1 (strlen str)) ",") ) ((vl-string-position (ascii "<") str nil nil) (polar '(0 0 0) (atof (cadr (str2lst str "<"))) (str2lst str "<") (car (str2lst str "<")) ) ) ((and (vl-string-position (ascii "<") str nil nil) (eq (substr str 1 1) "@") ) (polar first (atof (substr (str2lst str "<") 2 (strlen (car (str2lst str "<"))) )) (str2lst str "<") (car (str2lst str "<")) ) ) ((not (vl-string-position (ascii ",") str nil nil)) (polar first (angtof (itoa (proch (atoi (angtos (angle pt1 (cadr (grread 3))))) '(0 45 90 135 180 225 270 315 360) ) )) (chtype str) ) ) ) ) ;;;**************************************************************** ;;; CHTYPE ;;; Retourne la vraie forme de la chaîne de caractère. (defun chtype (CRT / ) (if (eq CRT "0") (atoi CRT) (if (and (/= (atoi CRT) 0) (not (vl-string-search "." crt nil)) ) (atoi CRT) (if (/= (atof CRT) 0.00) (atof CRT) CRT ) ) ) ) ;;;**************************************************************** ;;; Retourne l'élément de la liste le plus proche du nombre demandé. (defun proch (nb lst / ) (setq lst (cons (nth (1- (vl-position nb (vl-sort (cons nb lst) '<))) lst ) (list (nth (vl-position nb (vl-sort (cons nb lst) '<)) lst )) ) ) (if (<= (- nb (car lst)) (- (last lst) nb)) (car lst) (last lst) ) ) ;;;**************************************************************** ;;; STR2LST ;;; Retourne une liste à partir d'une chaîne de caractères concaténée avec un caratère de séparation ;;; str = Chaîne de caractères ;;; sep = caractère de séparation ;;; ;;; (str2lst "0,1,,,,2,3,4,5,6,7,8,9" ",") -> (0 1 "" "" "" 2 3 4 5 6 7 8 9) ;;; (str2lst "0,1,2,3,4,5,6,7,8,9" "" ) -> ("0" "," "1" "," "2" "," "3" "," "4" "," "5" "," "6" "," "7" "," "8" "," "9") (defun str2lst (str sep / pos lst ) (if (/= sep "") (progn (while (setq pos (vl-string-search sep str nil)) (setq lst (cons (chtype (substr str 1 pos)) lst) str (substr str (+ (strlen sep) pos 1) ) ) ) (setq lst (cons (chtype str) lst)) ) (progn (while (/= str "") (setq lst (cons (chtype (substr str 1 1)) lst) str (substr str 2) ) ) ) ) (if lst (reverse lst)) ) Ces commandes fonctionnent sur AutoCAD2000. Pour qu'elles fonctionnent sur un moteur IntelliCAD, il faut supprimer tous les vl- (ex vl-position = position) et choper toutes les fonctions créées par Gile pour palier l'absence de vl dans ces moteurs. Voilà ! Si d'autres sont motivés à créer des fonctions existantes pour comprendre un peu mieux le lisp, qu'ils n'hésitent surtout pas !! Perso je vais m'essayer au rectangle... A bientot. Matt.

Et avec un recover ??? Tu n'arrives pas à récupérer ton plan ?

Houlàlà !!! Mais ça a l'air vachement bien tout ça !! C'est celle là qui m'intéresse le plus ! C'est exactement ça que je veux faire... Par contre Je teste ta nouvelle routine bien bonnarde et je te redis ! Merci ! [Edité le 24/9/2007 par Matt666]

Dément ! Merci Patrick_35, je teste ça dès que je le peux ! Bon Week-end... Matt.

Salut ! Petite commande rigolote pour le week-end :) Permet aussi de voir une utilisation de la fonction inters... Trouvée sur un site, et améliorée, avec qqs explications... ;;; Sélectionne une ligne de base (ou tranchant) puis ajuste toutes les ;;; lignes sélectionnées ensuite. (defun C:DECOUPE () (setq cmdecho (getvar "CMDECHO")) ;;; Etat de la variable cmdecho (setvar "CMDECHO" 0) ;;; Modification de la variable cmdecho (command "_undo" "D") ;;; Début du jeu d'annulation (if (and (setq ent (car (entsel "\nSélectionner la ligne de base : "))) ;;; Ligne de base (eq (cdr (assoc 0 (entget ent))) "LINE") ;;; Si entité ligne de base est une ligne ) (progn (redraw ent 3) ;;; Mettre en surbrillance ligne de base (prompt "\nSélectionner les lignes à découper : ") ;;; Message (if (setq sel (ssget '((0 . "LINE")))) ;;; Lignes à découper (progn (repeat (setq cn (sslength sel)) ;;; Début de la boucle (setq lentl (entget (ssname sel (setq cn (1- cn))))) ;;; Nom de la ligne à découper (if (and (/= (ssname sel cn) ent) (setq lint (inters ;;; Trouve l'intersection des deux lignes (cdr (assoc 10 (entget ent))) ;;; 1er pt ligne de base (cdr (assoc 11 (entget ent))) ;;; 2èm pt ligne de base (cdr (assoc 10 lentl)) ;;; 1er pt ligne à découper (cdr (assoc 11 lentl)) ;;; 2èm pt ligne à découper nil ;;; Lignes considérées comme des droites )) ) (if (< ;;; Sens de la découpe (distance lint (cdr (assoc 10 lentl))) (distance lint (cdr (assoc 11 lentl))) ) (entmod (subst (cons 10 lint) (assoc 10 lentl) lentl)) ;;; Modifie l'entité dans un sens (entmod (subst (cons 11 lint) (assoc 11 lentl) lentl)) ;;; Modifie l'entité dans un autre sens ) (if (and (not (eq (ssname sel cn) ent)) ;;; Si pas d'intersection possible, parallèle. (not lint) ) (princ "\nLignes parallèles.") (if (eq (ssname sel cn) ent) ;;; Si trouve ligne de base dans ligne à découper, (setq tot (1- (sslength sel))) ;;; Enlever du nombre de lignes à découper. (setq tot (sslength sel)) ) ) ) ) (if (< tot 2) (princ (strcat "\n" (itoa tot) " ligne découpée." )) ;;; Si 1 ou 0 ligne découpée, phrase au singulier (princ (strcat "\n" (itoa tot) " lignes découpées." )) ;;; Si plus de deux, phrase au pluriel ) ) ) (redraw ent 4) ;;; Déscativer la surbrillance de la ligne de base ) ) (command "_UNDO" "F") ;;; Fin du jeu d'annulation (setvar "CMDECHO" cmdecho) ;;; RAZ variable cmdecho (princ) ) Voilà !!! Bon Week-end à tous. Matt. [Edité le 22/9/2007 par Matt666]

sinon la commande attsync, des express tools...

Tu utilises quoi pour l'édition des blocs ?

tu as la commande "battman", peut être, qui permet de mettre à jour les blocs et les attributs...

C'est le code DXF 70 de la déf d'attribut qu'il faut changer (voir ici) ... [Edité le 21/9/2007 par Matt666]

Attends... Comment utilises-tu entmod ???? :casstet: ici, pour essayer, il faut dans ta routine que tu intègres un (entmod (subst (cons 0 "MTEXT")(assoc 0 ;;;entget de l'entité) ;;;entget de l'entité)) Tu vois ? J'ai l'impression (je dois me planter) que tu entres entmod dans la ligne de commande... Forcément ça ne fonctionnera pas !! :) A bientot Matt.

C'est (entmod) la vraie orthographe... Cette fonction sert entre autres à substituer une code DXF par un autre... Mais ça ne fonctionne pas sur le code dxf 0... Tiboulen, ce message s'adresse surtout aux utilisateurs des moteurs intellicad... Mais j'ai déjà entendu parler de ltextender, qui permet d'utiliser du lisp sur une version lt de autoCAD... Et ça fonctionne bien ? C'est vrai que c'est une bonne alternative, et assez bon marché... à peu drès 400 € c'est ça ? En plus si on peut insérer les outils express , c'est vraiment dément !! [Edité le 20/9/2007 par Matt666]

Bon c'est le dernier post que je mets ici !!!! :P Voilà j'ai fait une fonction qui utilise le lst2str... Différemment mais en gros c'est la même. Le problème c'est que seule la fonction avec récursivité fonctionne :mad: !!! Y en a marre !!! Bref je te montre : ;; Calcul du nombre d'entités sous forme de liste ;; Ex : (("LINE" . 3)("CIRCLE" . 5)) (defun compteur (lst / n js tbl) (while lst (setq n (length lst) js (car lst) lst (remove js lst) tbl (cons (cons js (- n (length lst))) tbl) ) ) (sort tbl '(lambda (a b) (< (car a) (car b)))) ) ;; Créé la chaîne de caractères à partir de la liste compteur ;; Ex : (("LINE" . 3)) -> "3 entités LINE." (defun concat (lst) (if (cdr lst) (strcat (princ-to-string (cdar lst)) " entités " (princ-to-string (caar lst)) "." "\n" (concat (cdr lst)) ) (strcat (princ-to-string (cdar lst)) " entités " (princ-to-string (caar lst)) ".") ) ) ;; Retourne le nombre d'entités sélectionnées par type et dans une fenêtre (defun c:somme (/ cn sel) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sel (ssget)) (progn (repeat (setq cn (sslength sel)) (setq lst (cons (cdr (assoc 0 (entget (ssname sel (setq cn (1- cn)))))) lst)) ) (setq infos (concat (compteur lst))) (alert (strcat (itoa (sslength sel)) " entités sélectionnées." "\n\n" infos )) )) (princ) ) Voilà ! Simplement tu sélectionnes les entités, et la routine retourne un tableau avec les entités rangées par type... Comme tu peux voir c'est ta fonction avec récursivité qui est utilisée... J'ai essayé de créer une fonction équivalente sans récursivité, mais je ne comprends pas pourquoi elle ne fonctionne pas ! Peux-tu m'aider Gile stp ? Fonction qui merde : (defun CONCAT2 (lst) (strcat (princ-to-string (cdar lst)) " entités " (princ-to-string (caar lst)) "." (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (princ-to-string (cdar lst)) " entités " (princ-to-string (caar lst)) "." ) ) (cdr lst) ) ) ) ) Merci ! A bientot. Matt.

Salut ! La fonction (sort) diffère de (vl-sort)... Ta fonction intègre en plus une suppression des doublons ! Voilà, juste pour dire ! Adtal ! Matt.

Merci !! je n'ai pas réussi à passer de text à mtext en entmod Non diponible avec le logiciel que j'utilise... :mad: (moteur intellicad) Merci pour tes remarques ! A bientot.. Matt

Effectivement d'après ce que je vois dans les forums, c'est le cas... Dommage. Merci quand même d'avoir proposé ces exercices intéressants ! A bientot. matt

Salut ! Voici, pour ceux qui n'ont pas AutoCAD et les outils express, deux routines de conversion de textes... ;;Transforme des textes simples en textes mutliples (defun c:T2MT (/ CMDECHO ENT41 ENTNUN MYERROR NEWTXT NOUVENT TEMPERROR TOU) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (command "_undo" "d") (princ "\nSélectionner les textes à transformer en un texte multiple unique...\n") (if (setq tou (ssget '((0 . "text")))) (progn (setq entnun (entget (ssname tou (setq cntr 0))) newtxt (cdr (assoc 1 entnun)) ) (entdel (ssname tou 0)) (while (setq nouvent (ssname tou (setq cntr (1+ cntr)))) (setq newtxt (strcat newtxt " " (cdr (assoc 1 (entget nouvent))))) (entdel nouvent) ) (if (> (strlen newtxt) 40) (setq ent41 (* (cdr (assoc 40 entnun)) 40)) (setq ent41 (* (cdr (assoc 40 entnun)) (strlen newtxt))) ) (entmake (list (cons 0 "MTEXT") (cons 1 newtxt) (cons 6 (cdr (assoc 6 entnun))) (cons 7 (cdr (assoc 7 entnun))) (cons 8 (cdr (assoc 8 entnun))) (cons 10 (cdr (assoc 10 entnun))) (cons 40 (cdr (assoc 40 entnun))) (cons 41 ent41) (cons 50 (cdr (assoc 50 entnun))) (cons 62 (cdr (assoc 62 entnun))) (cons 71 (aligne (cdr (assoc 72 entnun)) (cdr (assoc 73 entnun)))) )) (princ "\nConversion réussie.") )) (command "_undo" "f") (setvar "cmdecho" cmdecho) (princ) ) Bon le principal pb dans cette routine est de donner une largeur au mtexte... Donc ya une bidouille un peu pourrie, qui va surement faire rire les pros du lisp ;) ;;Transforme des textes multiples en textes simples (defun c:MT2T (/ CMDECHO CN CNT3 CNTR ENT10 ENT72 ENT73 JUSTIF TOU) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (command "_undo" "d") (princ "\nSélectionner les textes multiples à transformer en textes simples...\n") (if (setq tou (ssget '((0 . "MTEXT")))) (repeat (setq cn (sslength tou)) (setq entnun (entget (ssname tou (setq cn (1- cn)))) justif (aligne (cdr (assoc 71 entnun)) nil) ent72 (atoi (substr justif 1 1)) ent73 (atoi (substr justif 2 1)) ent10 (cdr (assoc 10 entnun)) ) (foreach pt (str2lst (cdr (assoc 1 entnun)) "\\P") (if (/= pt "") (entmake (list (cons 0 "TEXT") (cons 1 pt) (cons 6 (cdr (assoc 6 entnun))) (cons 7 (cdr (assoc 7 entnun))) (cons 8 (cdr (assoc 8 entnun))) (cons 11 ent10) (cons 40 (cdr (assoc 40 entnun))) (cons 50 (cdr (assoc 50 entnun))) (cons 62 (cdr (assoc 62 entnun))) (cons 72 ent72) (cons 73 ent73) )) ) (setq ent10 (list (car ent10) (- (cadr ent10) (* (cdr (assoc 44 entnun)) (/ 5.00 3.00) (cdr (assoc 40 entnun)))) (caddr ent10) )) ) (entdel (ssname tou cn)) (princ "\nConversion réussie.") ) ) (command "_undo" "f") (setvar "cmdecho" cmdecho) (princ) ) Le pb pour celui a été de trouver le décalage entre les lignes d'un mtexte... Merci Gile, qui a répondu ici... Et pour finir, une routine qui permet de recopier l'alignement des textes... C'est pareil, un peu bidouille, mais ça a le mérite de fonctionner ! ;;Pour gérer les variables de justification de texte (defun aligne (arg1 arg2 / lst) (cond ((and arg1 arg2) (setq lst ' ((1 . "03")(1 . "04")(1 . "05")(1 . "30")(2 . "01")(2 . "31")(3 . "02")(3 . "32") (4 . "20")(5 . "21")(6 . "22")(7 . "10")(8 . "11")(9 . "12")(1 . "00")) ) (car (nth (position (strcat (itoa arg1)(itoa arg2))(mapcar 'cdr lst)) lst)) ) ((and arg1 (not arg2)) (setq lst '((1 . "03")(2 . "13")(3 . "32")(4 . "02")(5 . "12")(6 . "22")(7 . "01")(8 . "11")(9 . "21"))) (cdr (nth (position arg1 (mapcar 'car lst)) lst)) ) ) ) La fonction hors autolisp pur ("position") est disponible là ! Au passage copiez toutes ces fonctions et lancez-les au démarrage, elles sont très pratiques ! Quand je te disais, Gile, que je les utilise tous les jours tes équivalences :P Voilà, évidemment ces routines sont largement améliorables, donc si quelqu'un est tenté, n'hésite pas ! A bientot. Matt.

Parfait c'est exactement ce que je voulais !! Merci à vous ! Je post deux routines dans le sujet routines lisp... A bientot ! Matt.

Dément ! Les (getent) (setenv) fonctionnent !!! Je sais pas trop où ça va dans le registre mais ça fonctionne ! Patrick_35, c'est quoi les dictionnaires ? Le but, aussi, est de retrouver les variables après fermeture/ouverture du logiciel... Cool merci à vous tous !! A bientot. Matt.

Vache.... Mais il est tout petit ton code !!!!! Merde :o Bah euh merci de ne pas t'être foutu de moi !! Par contre juste un truc dans ta routine itérative, il manquerait pas un nil à la fonction vl-string-search ??? Et puis elle ne gère pas la nature des chaînes entre séparateur ! genre (str2lst "un,deux,,quatre cent,1,2,3,400,,121459.21" ",") Retourne ("un" "deux" "" "quatre cent" "1" "2" "3" "400" "" "121459.21") Ou alors, pour reprendre l'exemple de lst2str (lst2str '(0 1 2 3 4 5 6 7 8 9) ",") -> "0,1,2,3,4,5,6,7,8,9" Si on prend la fonction inverse (str2lst "0,1,2,3,4,5,6,7,8,9" ",") Retourne ("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") Ce n'est donc pas vraiment l'inverse ! Je te propose la routine ci-dessous, qui intègre chtype... Je suis sur que tu as beaucoup mieux, mais je fais ce que je peux ;) (defun str2lst (str sep / pos lst) (while (setq pos (string-search sep str nil)) (setq lst (cons (chtype (substr str 1 pos)) lst) str (substr str (+ (strlen sep) pos 1)) ) ) (reverse (cons (chtype str) lst)) ) Avec chtype (defun chtype (CRT / ) (if (eq CRT "0") (atoi CRT) (if (/= (atoi CRT) 0) (atoi CRT) (if (or (/= (atof CRT) 0.00) (and (eq (atof CRT) 0.00) (eq (substr CRT 1 4) "0.00") ) ) (atof CRT) CRT ) ) ) ) Voilà ! Dis moi ce que tu en penses... Adtal ! Matt. PS : Limite faudrait presque la mettre en argument, cette extraction en fonction de la nature de la chaîne... Edition : Si "" est le séparateur, ta fonction plante.... (defun str2lst (str sep / pos lst ) (if (/= sep "") (progn (while (setq pos (string-search sep str nil)) (setq lst (cons (chtype (substr str 1 pos)) lst) str (substr str (+ (strlen sep) pos 1) ) ) ) (setq lst (cons (chtype str) lst)) ) (progn (while (/= str "") (setq lst (cons (chtype (substr str 1 1)) lst) str (substr str 2) ) ) ) ) (if lst (reverse lst)) ) [Edité le 20/9/2007 par Matt666]