Couleur -> calque, mais en RVB

[GEGEMATIC]

Salut,

j'ai depuis longtemps une routine color2layer,

mais elle date un peu, car elle ne prends pas en compte les valeurs RGB

il me semble avoir vu passer ça sur le forum

(le but est de trier plus finement un conversion pdf->dwg)

Notre Crabe fatigué à bien ça sur son DD ?

a+

Gégé

[lecrabe]

Hello "Le Bas Savoyard"

 

Je te propose la Super routine E2LBC "de competition" que j'utilise ... MERCI Mr dlanorh !

 

E2LBC traite TOUTES les couleurs: ACI AutoCAD Color Index (0-256) , RGB/RVB (16 millions de couleurs) , Pantome , RAL , etc !

 

Routine tiree de mon stock de 3001 routines ...

 

LA SANTE, Bye, lecrabe "fatigué" de "La Basse Loire"

 

;;
;; Routine: E2LBC__Entities_to_Layer_By_Color__dlanorh by dlanorh for Patrice B.
;; 
;; Move selected Entities on separate layers depending on Color
;;
;; --- Interrogation Entite/Objet en Lisp --- 
;; (entget (car (entsel)) '("*"))
;; 

(vl-load-com) 

(defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)))

(defun rh:lst2str ( lst del / str ) (setq str "")  (mapcar '(lambda (x) (setq str (strcat str x del))) lst) (vl-string-right-trim del str))

(defun rh:layer_props ( lyr lst / v ) (setq v (mapcar '(lambda (x) (vlax-get-property lyr x)) lst)))

(defun rh:strlen3 ( str ) (if (< (strlen str) 3) (while (< (strlen str) 3) (setq str (strcat "0" str))) str) str)

;; Entities to layer by color
(defun c:E2LBC ( / c_doc c_lyrs l_props ss cnt ent elst lyr l_vals cstr clst clr nlyr lobj)

 (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
       c_lyrs (vla-get-layers c_doc)
       l_props (list 'truecolor 'linetype 'lineweight);Layer properties list
 );end_setq

 (prompt "\nSelect Entities : ")
 (setq ss (ssget))

 (cond (ss
         (repeat (setq cnt (sslength ss))
           (setq ent (ssname ss (setq cnt (1- cnt)))
                 elst (entget ent)
                 lyr (cdr (assoc 8 elst));Layer
                 l_vals (rh:layer_props (vla-item c_lyrs lyr) l_props);Layer properties
                 cstr ""
                 clst nil
           );end_setq

           (foreach x '(62 420 430) (setq clst (cons (cdr (assoc x elst)) clst)))
           (setq clr (vl-some '(lambda (x) x) clst))
           (cond ( (not clr) (setq cstr "256"))                ;No Color set (bylayer)
                 ( (and (= (type clr) 'INT) (<= clr 256))      ;ACI (0-256)
                   (setq cstr (rh:strlen3 (itoa clr)))
                 )
                 ( (= (type clr) 'STR) (setq cstr clr))        ;Color Book
                 (t (setq clr (mapcar 'itoa (LM:True->RGB clr));RGB
                          cstr (rh:lst2str (mapcar 'rh:strlen3 clr) "_")
                    );end_setq
                 )
           );end_cond
           (setq nlyr (strcat lyr "__" cstr))

           (cond ( (not (tblsearch "layer" nlyr)) (setq lobj (vla-add c_lyrs nlyr)) (mapcar '(lambda (x y) (vlax-put-property lobj x y)) l_props l_vals)))
           (vlax-put-property (vlax-ename->vla-object ent) 'layer nlyr)
         );end_repeat
       )
       (t (alert "NO Entities Selected ! "))
 );end_cond

 (princ) 
);end_defun 

[GEGEMATIC]

Bon,

c'est pas du Mozart, mais ça le fait !

;;*****************************************************************
;;§/calques/bascule toutes les entités d'une couleur forcée vers un calque correspondant à cette couleur, en tenant compte du RGB/none

(DEFUN c:color2layerRGBAll (/	   acadObj	 doc	1er    suiv
		    otc	   o	  r	 pl_source     pl_arriv
		    color  r	  g	 b	onca suffix
		   )
 (setq acadObj (vlax-get-acad-object))
 (setq doc (vla-get-ActiveDocument acadObj))
 (setq 1er (entnext))

 (while (setq suiv (entnext 1er))

   (setq
     otc (vla-get-truecolor (setq o (vlax-ename->vla-object suiv)))
   )
   (cond ((= (vla-get-ColorMethod otc) 195)
   (setq suffix (itoa (vla-get-ColorIndex otc)))
   (setq r (vla-get-Red otc))
   (setq g (vla-get-Green otc))
   (setq b (vla-get-Blue otc))
  )
  ((= (vla-get-ColorMethod otc) 194)
   (setq suffix
	  (strcat (itoa (setq r (vla-get-Red otc)))
		  "-"
		  (itoa (setq g (vla-get-Green otc)))
		  "-"
		  (itoa (setq b (vla-get-Blue otc)))
	  )
   )
  )
  (t
   (setq suffix nil)
  )
   )
   (if	suffix
     (progn
(setq pl_source (vla-get-layer o))
(setq layers (vla-get-layers doc))

(setq pl_arriv (strcat pl_source suffix))
(if (not (vl-catch-all-error-p
	   (vl-catch-all-apply
	     'vlax-invoke-method
	     (list layers 'item pl_arriv)
	   )
	 )
    )
  nil
  (progn
    (setq oNca (vla-add layers pl_arriv))
    (setq color	(vlax-create-object
		  (strcat "AutoCAD.AcCmColor."
			  (substr (getvar "ACADVER") 1 2)
		  )
		)
    )
    (vla-SetRGB color r g B)
    (vla-put-TrueColor oNca color)
  )
)
(vla-put-layer o pl_arriv)
(vla-put-color o 256)
     )
   )
   (setq 1er suiv)

 )
)

[GEGEMATIC]

Aie !

j'avais pas vu ta réponse, je me suis dit que tu faisais la sieste !

Oui, la tienne, c'est du Mozart !

merci quand même !

Gégé

[lecrabe]

Hello

 

YES je retourne me reposer pour "achever" le COV19 !?

 

LA SANTE, Bye, lecrabe "fatigué"

[GEGEMATIC]

Hello

 

YES je retourne me reposer pour "achever" le COV19 !?

 

LA SANTE, Bye, lecrabe "fatigué"

après avoir bu un petit verre d'alcool à bruler,

vu que t'as plus de gout, faut pas gâcher ....

 

bon a l'usage j'ai amélioré un peu la version, pour que les calques dont les couleurs sont proches soient regroupés par leur index,

 

 

;;****************************************************************************************************************************************************
;;§/calques/bascule toutes les entités d'une couleur forcée vers un calque avec un suffixe correspondant à cette couleur, en tenant compte du RGB/none
;;les entités n'ayant pas une couleur forcée sont ignorées
;; Pour les couleur forcées non RGB:
;; le calque "PDF _Remplissages de solides" -> "PDF _Remplissages de solides_150" pour la couleur 150 authentique
;; le calque "PDF _Remplissages de solides" ->  "PDF _Remplissages de solides_150_RGB40-138-250" pour la couleur 150 légerement eclaircie
;; Attention: ne doit pas encore traiter tous les cas ... car je n'ai pas fait beaucoup de recherches sur les valeurs de  BookName et  ColorMethod ...


(DEFUN c:color2layerRGBAll (/	   acadObj	 doc	1er    suiv
		    otc	   o	  r	 pl_source     pl_arriv
		    color  r	  g	 b	onca suffix
		   )
 (setq acadObj (vlax-get-acad-object))
 (setq doc (vla-get-ActiveDocument acadObj))
 (setq suiv (entnext))

 (while suiv
   (setq
     otc (vla-get-truecolor (setq o (vlax-ename->vla-object suiv)))
   )
   (cond ((= (vla-get-ColorMethod otc) 195)
   (setq suffix (strcat "_" (itoa (vla-get-ColorIndex otc))))
   (setq r (vla-get-Red otc))
   (setq g (vla-get-Green otc))
   (setq b (vla-get-Blue otc))
  )
  ((= (vla-get-ColorMethod otc) 194)
   (setq suffix
	  (strcat "_" (itoa (vla-get-ColorIndex otc))
		  "_RGB"
	          (itoa (setq r (vla-get-Red otc)))
		  "-"
		  (itoa (setq g (vla-get-Green otc)))
		  "-"
		  (itoa (setq b (vla-get-Blue otc)))
	  )
   )
  )
  (t
   (setq suffix nil)
  )
   )
   (if	suffix
     (progn
(setq pl_source (vla-get-layer o))
(setq layers (vla-get-layers doc))

(setq pl_arriv (strcat pl_source suffix))
(if (not (vl-catch-all-error-p
	   (vl-catch-all-apply
	     'vlax-invoke-method
	     (list layers 'item pl_arriv)
	   )
	 )
    )
  nil
  (progn
    (setq oNca (vla-add layers pl_arriv))
    (setq color	(vlax-create-object
		  (strcat "AutoCAD.AcCmColor."
			  (substr (getvar "ACADVER") 1 2)
		  )
		)
    )
    (vla-SetRGB color r g B)
    (vla-put-TrueColor oNca color)
  )
)
(vla-put-layer o pl_arriv)
(vla-put-color o 256)
     )
   )
   (setq 1er suiv)
   (setq suiv (entnext 1er))
 )
)

[lecrabe]

Hello

 

Je renifle regulierement mes Whiskys et cerise, calvados, prune, framboise, poire, chartreuse, genepy, etc, SANS SUCCES !?

 

Mais bon, il y a "plus grave" dans la vie ...

 

LA SANTE, Bye, lecrabe "fatigue"

[DenisHen]

Salut à tous, et surtout aux plus grands...

 

J'avais fais un truc, dans ce sens, je répertoriais les entités, en fonction de leurs couleurs... Mais je ne m'étais jamais penché sur les couleurs RVB...

Bien que j'y ai été souvent confronté...

 

Je suis sur que j'avais un truc de tri dans ce sens... placé des entité dans des calques selon leur couleur...

 

Je vais cherché, je pense avoir déjà fais un truc...

 

Il créé un calque de la couleur de l'objet et il le met dans la couleur "DuCalque" et le place dans un calque de la couleur de l'objet...

 

Denis...