CHANGER LA COULEUR DES LIGNES D'UN BLOC EN DUBLOC

[zara]

Bonjour,

 

Voilà je souhaiterai changer la couleur de tout les éléments d'un bloc sauf les hachures.(impossible avec edit_bloc)

Auriez vous une idée?

 

Merci par avance

[Aleck_Ultimate]

Message supprimé.

 

J'ais posté sans réfléchir, et ma solution ne marcherait pas sur un bloc sans le dissocier.

[zara]

Merci quand même.

[didier]

Coucou

 

éditer le bloc dans l'éditeur de bloc et changer les entités sélectionnées (sans les hachures) en couleur DUBLOC

enregistrer les modifications et sortir de l'éditeur.

 

ça me semble si simple que je ne suis pas certain d'avoir bien appréhendé ton problème...

 

amicalement

[zara]

Merci.

Mais je souhaite faire la transformation sans rentrer dans l'éditeur de bloc de la façon lisp EDIT_BLOC 3.5

 

Car mon problème récurrent c'est de retrouver mes blocs avec de jolies couleurs tout noir :blink:

 

Peut être la possibilité de modifier ce lisp...

 

;FixBlock.lsp [June 30, 1998]

;

; Copyright 1996 - 1998 ManuSoft

;

; gratuiciel from:

; ManuSoft

; http://www.manusoft.com

; modified - added LTSCALE by CAD Studio

;

; Load function, then enter FIXBLOCK to redefine selected blocks

; so that all entities are on layer '0', color 'BYBLOCK', linetype scale 1.0

;

 

 

(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)

(defun Grp (gc el) (cdr (assoc gc el)))

(defun Update (bname / ename elist)

(setq ename (tblobjname "BLOCK" bname))

(if

(and ename (zerop (logand 52 (Grp 70 (entget ename '("*"))))))

(progn

(while ename

(setq elist (entget ename '("*"))

elist (subst '(8 . "0") (assoc 8 elist) elist)

elist (if (assoc 62 elist)

(subst '(62 . 0) (assoc 62 elist) elist)

(append elist '((62 . 0))))

elist (if (assoc 48 elist) ; LTscale

(subst '(48 . 1.0) (assoc 48 elist) elist)

(append elist '((48 . 1.0)))))

(entmake elist)

(setq ename (entnext ename)))

(if (/= "ENDBLK" (Grp 0 elist))

(entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))

'T))

)

(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)

(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")

(progn

(if

(progn

(princ "\nPress <Enter> to fix all defined blocks\n")

(setq cnt 0

ss (ssget '((0 . "INSERT")))))

(progn

(setq idx (sslength ss))

(while (>= (setq idx (1- idx)) 0)

(if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))

(progn

(if (Update blkname) (setq cnt (1+ cnt)))

(setq donelist (cons blkname donelist))))))

(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))

(if (Update blkname) (setq cnt (1+ cnt)))))

(command "_REGENALL") ; added for LTscale

(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))

(princ)

)

;End-of-file

 

 

 

Amicalement