pascal19

Bonjour et avec supcalque, ils ne partent pas les calques? (sans effacer les blocs?)

Bonjour Cela me parait normal... Vérifie que tu n'as plus d'objets avec type de ligne "ducalque" (avec sélection rapide) si tel est le cas, le lisp a fonctionné. a+

J'ai un lisp qui pourrait t'aider si le vba ne te convient pas http:// http://www.cadxp.com/sujetXForum-24051.htm a+

Le sujet étant récurant, ci-dessous le programme de nettoyage que nous utilisons (il y a parfois quelques bugs!) au préalable, je supprime les onglets détache les xref et lance un edit_bloc pour mettre les blocs en calque 0 et couleur dubloc Ce programme est composé de nombreux sous-programmes piqués sur ce forum... merci encore à tous ceux qui partagent leur savoir... (defun c:paut() (SETVAR "INSUNITS" 0) (SETVAR "angdir" 0) (SETVAR "ANGBASE" 0) (command "controle" "o") (COMMAND "-calque" "D" "*" "") (COMMAND "-modiflistechelle" "r" "o" "q") (nico2) (suph2) (supcot2) (poly0-2) (tl2-2) (command "-calque" "n" "0-archi-xx-xx-xx" "co" "252" "0-archi-xx-xx-xx" "") (command "changer" "tout" "" "p" "ca" "0-archi-xx-xx-xx" "") (command "changer" "tout" "" "p" "co" "ducalque" "") (tlsimplex2) (supmt2) (command "-renommer" "st" "standard" "txt-archi") (COMMAND "-calque" "L" "*" "g" "0-archi-xx-xx-xx" "") (command "effacer" "tout" "") (COMMAND "-calque" "L" "0-archi-xx-xx-xx" "e" "0-archi-xx-xx-xx" "") (command "-purger" "to" "*" "n") (command "-purger" "r" "*" "n") (command "-style" "standard" "arial.ttf" "0.0" "1.0" "0.0" "n" "n") (command "DEPLACER" "tout" "" "0,0" "0,0,1e99") (command "DEPLACER" "tout" "" "0,0,1e99" "0,0,0") (SETVAR "PLINEGEN" 0) (vlax-for bloc (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object) ) ) (vlax-for ent bloc (if (= "AcDbZombieEntity" (vla-get-ObjectName ent)) (vla-delete ent) ) ) ) ) ;******************passe les styles de texte en simplex*************** (defun tlsimplex2 (/ doc) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for ts (vla-get-TextStyles doc) (if (zerop (logand 1 (cdr (assoc 70 (entget (tblobjname "STYLE" (vla-get-Name ts)))) ) ) ) (vla-put-FontFile ts "simplex.shx") ) ) (vla-regen doc acAllViewports) (princ) ) ;*************************force les types de ligne********************************* (defun tl2-2 () (setq echoold (getvar "cmdecho")) (setvar "cmdecho" 0) ;(command "-calque" "a" "e" "Normalise" "" "" "") (COMMAND "-calque" "D" "*" "") ;(COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "") (COMMAND "-calque" "E" "0" "") ;Normalisation des blocs dans la table des blocs (if (/= nil (setq i (tblnext "block" t))) (progn (setq tot 1) (while i (setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC (while n (setq n (entget n)) (setq tlorigin (cdr (assoc 6 n))) (if (or (= nil tlorigin) (= 256 tlorigin) (= "BYLAYER" tlorigin) ) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 n)))) ) ) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 n)) (setq n (append n (list (cons 6 tlorigin)))) ) ;CHANGE le type de ligne en type de ligne d'origine (setq n (subst (cons 6 tlorigin) (assoc 62 n) n)) (entmod n) (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE ) ;_ Fin de while (setq i (tblnext "block") tot (1+ tot) );BLOC SUIVANT ) ;_ Fin de while ) ) (setq n2 (entnext)) (while n2 (setq elst (entget n2)) (setq tlorigin (cdr (assoc 6 elst))) (if (or (= nil tlorigin) (= 256 tlorigin) (= "BYLAYER" tlorigin) ) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 elst)))) ) ) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 elst)) (setq elst (append elst (list (cons 6 tlorigin)))) ) ;CHANGE le type de ligne en type de ligne d'origine (setq elst (subst (cons 6 tlorigin) (assoc 62 elst) elst)) (entmod elst) (setq n2 (entnext n2));ENTITE SUIVANTE );fin du while ) ;**************************supprime les polices forcées dans mtext******************************* (defun supmt2 (/ ss n txt e_lst str start end lst) ;;;(while (not (setq ss (ssget '((0 . "MTEXT")))))) (if (setq ss (ssget "_X" '((0 . "MTEXT"))))(progn (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) ) )) ;**********************supprime les hachures même dans les blocs************************** (defun suph2 () (vl-load-com) (setq a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for bl a (vlax-for ent bl (if (= (vla-get-objectname ent) "AcDbHatch") (vla-delete ent) ) ) ) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport) ) ;*********************largeurs polylignes 0************************* ;(defun poly0-2 (/ doc) ;(vl-load-com) ;(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) ;(vlax-for b (vla-get-Blocks doc) ;(if (not (wcmatch (vla-get-name b) "`**_Space*")) ;(vlax-for o b ;(if (vlax-property-available-p o 'ConstantWidth) ;(vla-put-ConstantWidth o 0.0) ;) ;) ;) ;) ;(vla-regen doc acAllViewports) ;(princ) ;) (defun poly0-2 () (vl-load-com) (setq a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for bl a (vlax-for ent bl (if (and (vl-string-search "AcDb" (vla-get-objectname ent))(vl-string-search "Polyline" (vla-get-objectname ent))) (vla-put-ConstantWidth ent 0) ) ) ) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport) ) ;********************suppressions cotes************************* (defun supcot2 () (if (/= nil (setq nom (entnext)))(setq entitytyp (cdr (assoc 0 (entget (setq nom (entnext))))))) (while nom (if (= "DIMENSION" entitytyp) (entdel nom)) (if (/= nil (setq nom (entnext nom)))(setq entitytyp (cdr (assoc 0 (entget nom))))) ) ;_ Fin de while (vl-load-com) (setq a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for bl a (vlax-for ent bl (if (and (vl-string-search "AcDb" (vla-get-objectname ent))(vl-string-search "Dimension" (vla-get-objectname ent))) (vla-delete ent) ) ) ) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport) ) ;********************suppressions textes nuls************************* (defun nico2 (/ ss) (if (setq ss (ssget "_X" '((0 . "*TEXT") (1 . " ,")))) (mapcar '(lambda (x) (entdel (cadr x))) (ssnamex ss)) ) )

A priori on ne peut pas sélectionner un attribut comme objet dans une action de mise en réseau. Je confirme... ...mais pas de solution désolé a+

bonjour et bienvenu sur ce forum Tout ce que je peux te dire c'est que le cadre de ton plan à l'impression fera le quart des dimension du cadre sur autocad! par exemple si ton plan est délimité par un cadre de 1000 par 400 sur le papier, ton cadre fera 250mm par 100 mm ce qui est appelé unité par le gestionnaire de tracé est déterminé par le dessinateur, c'est lui qui choisi , quand il fait une ligne de longueur 1, si cette ligne fait 1m ou 1 cm ou 1 mm ou 1 pouce... a+

Tu peux facilement en utilisant la sélection rapide (menu outil) appliquer à : dessin entier type d'objet : multiple propriété : calque opérateur : égal à valeur : électricité relancer la commande cocher la case "ajouter au jeu de sélection courant" (tout en bas) puis remplir appliquer à : dessin entier type d'objet : multiple propriété : calque opérateur : égal à valeur : plomberie tes objets sont sélectionnés, tu fais ensuite copier avec point de base... tu n'as pas à geler les autres calques Il existe des lisp "spécial sélection" mais je ne les connais pas bien

Bonjour J'ai déja un bouton qui fait ^C^Cscu;g;repere;; alors je pense que ^C^Cscu;z;82;repere;; devrai marcher... ou sinon ^C^Cscu;z;\;repere;; (\ laisse la main à l'utilisateur) a+

Bonjour ça doit quand même être possible, je l'ai déja fais avec un paramètre de visibilité mais sous autocad 2007 ma procédure était: - _bedit choisir bloc concerné - "définir des attributs" (dans barre d'outils bedit) - choisir un nom d'étiquette - cliquer sur le boutton "champ" (à droite de "valeur") - Dans boite de dialogue "champ": - catégorie : objet - nom des champs: espaceréservébloc - propriété référence de bloc : visibilité - positionner l'attribut -fermer bedit - synchroniser avec BATTMAN a+

Bonjour à tous Désolé pour le temps de réponse... J'ai donc essayé les normes et cette solution est trés bien même si une routine aurait pu être plus conviviale... En tout cas cette méthode résoud mes problème de type de lignes quand je veux changer d'échelle mon plan architecte. Merci pour votre aide ... a+

non non t'es pas à côté de la plaque, ça marche bien quand on travaille avec des types de lignes portant le même nom sur la cible et la source... Mon soucis est le suivant, je voudrai remplacer un type de ligne "talus" par "cache" avec "cache pouvant être déja défini dans mon plan...

Bonjour Existe-t-il une routine qui remplace la définition d'un type de ligne par un autre? une sorte de "replace bloc by another bloc" pour les types de ligne...

donné par LUDWIG il y a peu: ; supprime le formatage forcé des mtext (defun c:supmt (/ ss n txt e_lst str start end lst) ;;;(while (not (setq ss (ssget '((0 . "MTEXT")))))) (if (setq ss (ssget "_X" '((0 . "MTEXT"))))(progn (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) ) )) a+

Bonjour en avril sujet similaire (post de toi il me semble) et mes réponses avez été: Le plus souvent quand ça m'arrive c'est à cause de types de lignes: je lance "sélection rapide" "type de ligne" Dans la liste , tous les types de ligne dont l'aperçu est fait de points trés espacés (. . . . .) posent problème donc je les vire et aprés en général ça marche méthode: Dans le menu déroulant "outil" choisis "sélection rapide", ensuite tu arrives dans une boite de dialogue, complète les champs suivant: appliquer à : dessin entier type d'objet : multiple propriété : type de ligne opérateur : égal à valeur : choisi les types de ligne suspects dans le menu déroulant (un par un) mode d'application : inclure... une fois sélectionnés, supprime les objets puis teste un copier coller vers un plan vierge sinon tu dois faire l'opération sur la cible et la source... En faisant cette opération dans l'éditeur de bloc, il se peut que tu puisse copier/coller ton bloc dans son intégralité a+

Bonjour J'ai testé sur V2007 sans problème je testerai un prochain jour avec un script perso super outil a+

Bonjour A la suite de cette discution, j'ai créer un bouton contenant en macro (ci-dessous) créant une variable pour chaque bloc que je voulais comptabiliser, un champ dynamique dans un tableau me donnait donc le nombre de chacun de mes blocs dès que je cliquais sur ce boton: au bout de quelque temps certains blocs ont cessé d'être compter et je ne sais pas pourquoi mais à l'exécution de la macro j'ai noté les erreurs suivantes sur les blocs concernés: pourtant mon bloc existe voici ce que j'obtiens si je le liste: D'avance, merci pour votre aide...

Bonjour En faisant un controle, autocad va renomer ton bloc avec un nom par défaut type "AUDIT..." et celui là tu devrais pouvoir le renomer... A+

Merci pour vos réponses, je vais regarder cette commande grread mais elle a l'air un peu compliqué (pour moi) Je vais aussi tester le programme à zebulon, pour comparer... a+

Bonjour à tous J'utilise le LISP suivant pour faire des gaines flexibles, avec 3 points P1 P2 et P3,il me fait une partie droite et un coude. Mis en boucle je peux faire un réseau complet et d'apparence correcte. Ma question: est-il possible d'avoir un aperçu de ma partie droite et de mon coude au moment ou je dois donner P3, en fonction de la position du curseur? (DEFUN c:FLEX () (SETQ d1 (getreal "\ndiametre en mm")) (setq H 1000.0) ;dessin sur plan en mètre (SETQ D (/ d1 H)) (SETQ P1 (GETPOINT "\nPOINT DE DEPART PASCAL")) (SETQ P2 (GETPOINT "\nPOINT SUIVANT" P1)) (SETQ A1 (ANGLE P1 P2)) (SETQ P3 (GETPOINT "\nPOINT SUIVANT" P2)) (SETQ A1 (ANGLE P1 P2)) (SETQ A2 (ANGLE P2 P3)) (SETQ A3 (+ A1 (/ pi 2))) (SETQ A4 (+ (+ pi A2) (/ pi 2))) (SETQ L1 (DISTANCE P1 P2)) (SETQ L2 (DISTANCE P2 P3)) (SETQ L3 (MIN (/ L1 2) (/ L2 2))) (SETQ P8 (polar P2 (+ pi A1) L3)) (SETQ P9 (polar P2 A2 L3)) (SETQ P4 (polar P1 A3 (/ D 2))) (SETQ P5 (polar P1 (+ pi A3) (/ D 2))) (SETQ P12 (polar P8 A3 (/ D 2))) (SETQ P10 (polar P8 (+ pi A3) (/ D 2))) (SETQ P13 (polar P9 A4 (/ D 2))) (SETQ P11 (polar P9 (+ pi A4) (/ D 2))) (SETQ P6 (polar P3 A4 (/ D 2))) (SETQ P7 (polar P3 (+ pi A4) (/ D 2))) (SETQ P0 (INTERS P12 P10 P13 P11 nil)) (SETQ RA (DISTANCE P0 P8)) (SETQ A5 (ANGLE P0 P8)) (SETQ A6 (ANGLE P0 P2)) (SETQ A7 (ANGLE P0 P9)) (SETQ PA4 (polar P0 A5 RA)) (SETQ PA5 (polar P0 A6 RA)) (SETQ PA6 (polar P0 A7 RA)) (SETQ PA1 (polar P0 A5 (- RA (/ D 2)))) (SETQ PA2 (polar P0 A6 (- RA (/ D 2)))) (SETQ PA3 (polar P0 A7 (- RA (/ D 2)))) (SETQ PA7 (polar P0 A5 (+ (/ D 2) RA))) (SETQ PA8 (polar P0 A6 (+ (/ D 2) RA))) (SETQ PA9 (polar P0 A7 (+ (/ D 2) RA))) (SETQ LD1 (- L1 L3)) ;longueur droite (SETQ RE (REM LD1 (/ 24 H))) (SETQ AFLEX (/ (- LD1 RE) (/ 24 H))) ;nombre de traits sur la partie droite (IF (/= AFLEX 0) (SETQ LONG (+ (/ 24 H) (/ RE AFLEX))) ;espacement des traits (SETQ LONG (/ 24 H)) ) (SETQ AC2 (* 2 (ATAN (/ L3 RA)))) ;angle à décrire (SETQ RANG (REM AC2 (ATAN (/ (/ 24 H) RA)))) (SETQ AANG (/ (- AC2 RANG) (ATAN (/ (/ 24 H) RA)))) ;nombre de traits dans le coude (SETQ ANGF (+ (ATAN (/ (/ 24 H) RA)) (/ RANG AANG))) ;angle entre chaque trait (SETQ TESTEUR1 0) (WHILE (< TESTEUR1 AFLEX) (TRAFLEX1) ) (COMMAND "_LINE" P4 P12 "" "_LINE" P5 P10 "" "_ARC" PA1 PA2 PA3 "_ARC" PA7 PA8 PA9 ) (SETQ CO (GETVAR "CECOLOR")) (SETVAR "CECOLOR" "8") (COMMAND "_LINE" P10 P12 "") (SETVAR "CECOLOR" CO) (SETQ TESTEUR2 0) (SETQ P1 (polar P8 0 0)) (WHILE (< TESTEUR2 (- AANG 1)) (TRAFLEX2) ) ;(SETQ P1(polar P9 0 0)) pour mise en boucle ;(SETQ P2(polar P3 0 0)) pour mise en boucle (SETQ TESTEUR1 0) (SETQ TESTEUR2 0) ;(TEST) pour mise en boucle ) (DEFUN TRAFLEX1 () (SETQ AF1 (+ A1 (/ pi 2))) (SETQ PF1 (polar P1 A1 LONG)) (SETQ PF2 (polar P1 AF1 (/ D 2))) (SETQ PF3 (polar P1 (+ pi AF1) (/ D 2))) (SETQ CO (GETVAR "CECOLOR")) (SETVAR "CECOLOR" "8") (COMMAND "_LINE" PF2 PF3 "") (SETVAR "CECOLOR" CO) (SETQ P1 (polar PF1 0 0)) (SETQ TESTEUR1 (1+ TESTEUR1)) ) (DEFUN TRAFLEX2 () (SETQ A6 (ANGLE P0 P1)) (SETQ PF1 (polar P0 A6 RA)) (SETQ PFA1 (polar P1 A1 (* RA (/ (sin angf) (cos angf))))) (SETQ A6B (ANGLE P0 PFA1)) (SETQ PF2 (polar P0 A6B RA)) (SETQ PF8 (polar PF2 A6B (/ D 2))) (SETQ PF9 (polar PF2 (+ pi A6B) (/ D 2))) (SETQ CO (GETVAR "CECOLOR")) (SETVAR "CECOLOR" "8") (COMMAND "_LINE" PF8 PF9 "") (SETVAR "CECOLOR" CO) (SETQ A1 (ANGLE P1 PF2)) (SETQ P1 (polar PF2 0 0)) (SETQ TESTEUR2 (1+ TESTEUR2)) )

Peut être une commande "nettoyé", fait une recherche d'image raster dans ton xref...

Cette fois ça marche, merci beaucoup à gile voici le code en ayant suivi tes conseils (defun c:tl2 () (setq echoold (getvar "cmdecho")) (setvar "cmdecho" 0) ;(command "-calque" "a" "e" "Normalise" "" "" "") (COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "") (COMMAND "-calque" "E" "0" "") ;Normalisation des blocs dans la table des blocs (if (/= nil (setq i (tblnext "block" t))) (progn (setq tot 1) (while i (setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC (while n (setq n (entget n)) (setq tlorigin (cdr (assoc 6 n))) (if (or (= nil tlorigin) (= 256 tlorigin) (= "BYLAYER" tlorigin) ) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 n)))) ) ) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 n)) (setq n (append n (list (cons 6 tlorigin)))) ) ;CHANGE le type de ligne en type de ligne d'origine (setq n (subst (cons 6 tlorigin) (assoc 62 n) n)) (entmod n) (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE ) ;_ Fin de while (setq i (tblnext "block") tot (1+ tot) );BLOC SUIVANT ) ;_ Fin de while ) ) (setq n2 (entnext)) (while n2 (setq elst (entget n2)) (setq tlorigin (cdr (assoc 6 elst))) (if (or (= nil tlorigin) (= 256 tlorigin) (= "BYLAYER" tlorigin) ) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 elst)))) ) ) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 elst)) (setq elst (append elst (list (cons 6 tlorigin)))) ) ;CHANGE le type de ligne en type de ligne d'origine (setq elst (subst (cons 6 tlorigin) (assoc 62 elst) elst)) (entmod elst) (setq n2 (entnext n2));ENTITE SUIVANTE );fin du while ) a+

voila où j'en suis: (defun c:tl2 () (setq echoold (getvar "cmdecho")) (setvar "cmdecho" 0) ;(command "-calque" "a" "e" "Normalise" "" "" "") (COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "") (COMMAND "-calque" "E" "0" "") ;Normalisation des blocs dans la table des blocs (if (/= nil (setq i (tblnext "block" t)))(progn (setq tot 1) (while i (setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC (while n (setq n (entget n)) (setq tlorigin (cdr (assoc 6 n))) (if (or (= nil tlorigin)(= 256 tlorigin)(= "BYLAYER" tlorigin)) (setq tlorigin (cdr(assoc 6 (tblsearch "layer" (cdr (assoc 8 n)))))) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 n)) (setq n (append n (list (cons 6 tlorigin))))) ;CHANGE le type de ligne en type de ligne d'origine (setq n (subst (cons 6 tlorigin) (assoc 62 n) n)) (entmod n) (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE ) ;_ Fin de while (setq i (tblnext "block") tot (1+ tot) ) ;BLOC SUIVANT ) ;_ Fin de while ) ) (setq n2 (entnext)) (while n2 (setq elst (entget n2)) (setq tlorigin (cdr (assoc 6 elst))) (if (or (= nil tlorigin)(= 256 tlorigin)(= "BYLAYER" tlorigin)) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 elst)))))) ) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 elst)) (setq elst (append elst (list (cons 6 tlorigin))))) ;CHANGE le type de ligne en type de ligne d'origine (setq elst (subst (cons 6 tlorigin) (assoc 62 elst) elst)) (entmod elst) (setq n2 (entnext)) ;ENTITE SUIVANTE );fin du while ) mais ça ne marche toujours pas: ok pour les blocs, mais pour le reste il semble qu'il change une entité et aprés il plante (il se bloque jusqu'à ce que je l'interrompe) J'utilise bien la console VISUAL LISP, j'ai "inspecté" les lignes 1 par une sans erreur mais quand je sélectionne tout mon code et que je lance "console visual lisp" j'ai le message suivant: saisie de la boucle d'arrêt clavier des idées?

bonjour Alors j'ai rajouté ça ... (setq n2 (entnext)) (while n2 (setq tlorigin (cdr (assoc 6 n2))) (if (or (= nil tlorigin) (= 256 tlorigin) (= "BYLAYER" tlorigin) ) (setq tlorigin (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 n2))))) ) ) (if (not (assoc 6 n2)) (setq n2 (append n2 (list (cons 6 tlorigin)))) ) (setq n2 (subst (cons 6 tlorigin) (assoc 62 n2) n2)) (entmod n2) (setq n2 (entnext)) ;ENTITE SUIVANTE ) ...mais ça ne marche toujours pas, suis-je loin du but?

Pour que ça marche sur tous les objets j'ai tenté: (setq Props (GetLayerProperties)) (vlax-for ModelSpaceObject (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (setq prop (assoc (vla-get-layer ModelSpaceObject) Props)) (if (= "BYLAYER" (vla-get-Linetype ModelSpaceObject)) (vla-put-Linetype ModelSpaceObject (nth 0 prop))) ) avec (defun GetLayerProperties ( / linetype ;prop; ) (vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (setq linetype (vla-get-Linetype layer)) (setq prop (list (list linetype))) ) ) Mais je sais pas pourquoi ça ne marche pas je vais me couché... PS Le code complet dont je me suis inspiré est celui-ci layerToByEntityProps ;;; Par Serge Camiré, 2008-12-18 (defun c:BLTBEP ( / forceTypeLigne forceCouleur pref prop Props ) ;; Force les propriétés (couleur et type de ligne) à être par objet plutôt que par calque. (initget "TypeLigne Couleur 2") (setq pref (getkword "\nForcer les propriétés suivante [TypeLigne/Couleur/les 2] : ")) (setq forceTypeLigne (/= pref "Couleur")) (setq forceCouleur (wcmatch pref "Couleur,2")) (setq Props (GetLayerProperties)) (vlax-for ModelSpaceObject (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (setq Props (GetLayerProperties)) (setq prop (assoc (vla-get-layer ModelSpaceObject) Props)) (if (and forceCouleur (= 256 (vla-get-Color ModelSpaceObject))) (vla-put-Color ModelSpaceObject (nth 1 prop))) (if (and forceTypeLigne (= "BYLAYER" (vla-get-Linetype ModelSpaceObject))) (vla-put-Linetype ModelSpaceObject (nth 2 prop))) ) (princ) ) (defun GetLayerProperties ( / name color linetype prop return ) ;; Retourne (list (list nomclaque1 couleur1 typeligne1) (list nomclaque2 couleur2 typeligne2)) ...) ;; de tout le dessin. (setq return nil) (vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (setq name (vla-get-name layer)) (setq color (vla-get-Color layer)) (setq linetype (vla-get-Linetype layer)) (setq prop (list (list name color linetype))) (setq return (append return prop)) ) return ) (princ "\nTapez BLTBEP pour forcer les propriétés.") (princ) mais je n'arrive pas à le faire marcher pour les types de ligne...

Bonjour Dans le cadre de mon long et difficile apprentissage (de la peche...) et en signe de bonne volonté, j'ai modifié la routine que m'a fait passé LUDWIG: (defun c:tl2 () (setq echoold (getvar "cmdecho")) (setvar "cmdecho" 0) ;(command "-calque" "a" "e" "Normalise" "" "" "") (COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "") (COMMAND "-calque" "E" "0" "") ;Normalisation des blocs dans la table des blocs (if (/= nil (setq i (tblnext "block" t)))(progn ; RECHERCHE LA PREMIERE ENTREE DANS LA TABLE DES BLOCS (setq tot 1) (while i (setq n (cdr (assoc -2 i))) ; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC (while n (setq n (entget n)) (setq tlorigin (cdr (assoc 6 n))) (if (or (= nil tlorigin)(= 256 tlorigin)(= "BYLAYER" tlorigin))(setq tlorigin (cdr(assoc 6 (tblsearch "layer" (cdr (assoc 8 n))))))) ;Récupère le type de ligne de l'entité d'origine (ou de son calque si le type de ligne est "bylayer") (if (not (assoc 6 n)) (setq n (append n (list (cons 6 tlorigin))))) ;CHANGE le type de ligne en type de ligne d'origine (setq n (subst (cons 6 tlorigin) (assoc 62 n) n)) (entmod n) (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE ) ;_ Fin de while (setq i (tblnext "block") tot (1+ tot) ) ;BLOC SUIVANT ) ;_ Fin de while ) ) ) C'est surement pas parfait car j'ai même pas tout compris alors n'hésitez pas à me signaler les erreurs Cette routine marche à l'interieur des blocs, je voudrais l'étendre à tous les objets du plan mais je ne sais pas lancer la boucle sur tous les objets... a+