Forcer les calques d\'un bloc

[excalibur]

Bonjour,

 

Sur un de mes plans reçu de mon client, il y a une quantité importante de bloc.

Ces blocs utilisent chacun plusieurs calques.

 

Peut-on, en une manip, forcer tous les objets de chaque blocs, sur le calque 0 ?

 

Cela me permettra d'avoir beaucoup moins de calques sur le plan "client" et également de jouer sur les couleurs en fonction des différents blocs.

 

Merci d'avance.

 

[LUDWIG]

C'est une question récurrente et (gile), entre autre, à fait ce très bon lisp

http://pagesperso-orange.fr/gile/LISP/Edit_bloc_3.5.zip

[LUDWIG]

Sinon, jJ'avais fait ce lisp , qui met les entités composants les blocs sur le calque 0mais conserve la couleur d'origine.

 

(defun c:nb2 ()


 (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 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)))
;Récupère la couleur de l'entité d'origine (ou de son calque si la couleur est "bylayer")

     
; RECUPERE LES VALEURS DES ENTITES QUI COMPOSE LE BLOC
     (if (/= (cdr (assoc 8 n)) "0")
(progn
  (setq n (subst (cons 8 "0") (assoc 8 n) n))
;SI L'ENTITE N'EST PAS SUR 0, LA DEPLACE SUR 0
  (entmod n)
  ) ;_ Fin de progn
) ;_ Fin de if

     (if (not (assoc 62 n))
;SI L'ENTITE N'A PAS LE CODE DXF 62 (=DuCalque), LE CREE ET LUI AFFECTE LA VALEUR de son calque d'origine
(setq n (append n (list (cons 62 colorigin)))))

;CHANGE LA COULEUR EN COULEUR D4ORIGINE
  (setq n (subst (cons 62 colorigin) (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

;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")
  (setq i (subst (cons 8 "0") (assoc 8 i) i))
; mettre l'attribut sur le calque 0



(if (not (assoc 62 i))(setq i (append i (list (cons 62 0)))))
(if (/= (cdr (assoc 62 i)) 0)(setq i (subst (cons 62 0) (assoc 62 i) i)))
  

  
; mettre l'attribut en couleur dubloc





  
  (entmod i) ; modifier l'entité
  (entupd (cdr (assoc -1 i)))
; mettre à jour sur l'écran l'entité
  (setq nat (+ 1 nat))
  (setq i (entget (entnext (cdr (assoc -1 i)))))
  ) ;_ Fin de while
) ;_ Fin de progn
     ) ;_ Fin de if
   (setq j (1+ j))
   ) ;_ Fin de while

;Résultat
;-----------------------------------------------
 (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)"
    ) ;_ Fin de strcat
   ) ;_ Fin de princ
 ;(command "-calque" "a" "s" "Normalise" "" "")
 (command "regen")
 (setvar "cmdecho" echoold)
 (graphscr)
 (princ)
   )
 ) 
)
(prompt
 "\nnb2 : Normaliser les blocs du dessin (calque 0 - Couleur d'ORIGINE)"
 ) ;_ Fin de prompt

[lesourd2]

Salut

 

Ou encore ceci de Patrick

 

 ;;;=================================================================
;;;
;;; RB.LSP V1.10
;;;
;;; Refait tous les blocs de la couleur dubloc et sur le calque 0
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================


(defun c:rb(/ a b)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq a (tblnext "block" t))
 (while a
   (setq b (cdr (assoc -2 a)))
   (while b
     (setq b (entget b))
     (if (cdr (assoc 6 b))
(setq b (subst (cons 6 "ByBlock") (assoc 6 b) b))
(setq b (append b (list (cons 6 "ByBlock"))))
     )
     (setq b (subst (cons 8 "0") (assoc 8 b) b))
     (if (cdr (assoc 62 b))
(setq b (subst (cons 62 0) (assoc 62 b) b))
(setq b (append b (list (cons 62 0))))
     )
     (if (cdr (assoc 370 b))
(setq b (subst (cons 370 -2) (assoc 370 b) b))
(setq b (append b (list (cons 370 -2))))
     )
     (entmod b)
     (setq b (entnext (cdr (assoc -1 b))))
   )
   (setq a (tblnext "block"))
 )
 (if (setq a (vl-remove-if-not '(lambda (x) (eq (car x) 350)) (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))
   (foreach b a
     (entmod (append (vl-remove-if '(lambda (x) (eq (car x) 62)) (entget (cdr b))) (list (cons 62 0) (cons 62 0) (cons 62 0))))
   )
 )
 (if (setq a (ssget "x" (list (cons 0 "INSERT"))))
   (foreach b (mapcar 'cadr (ssnamex a))
     (if (cdr (assoc 66 (entget b)))
(progn
  (setq a (entget (entnext b)))
  (while (not (eq (cdr (assoc 0 a)) "SEQEND"))
    (entmod (subst (cons 62 0) (assoc 62 a) a))
    (setq a (entget (entnext (cdr (assoc -1 a)))))
  )
)
     )
     (entupd b)
   )
 )
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

(setq nom_lisp "RB")
(if (/= app nil)
 (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
   (princ (strcat "..." nom_lisp " chargé."))
   (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

T'as le choix....

[excalibur]

Merci à vous deux.

 

Je pense que je vais trouver mon bonheur dans tout ça.

[excalibur]

Super, exactement ce qu'il me fallait.

 

Merci encore