Eclaircir/Assombrir des couleurs vraies

[bonuscad]

Bonjours la communauté.

 

Pour migrer mes fichiers de 2002 vers 2008 j'ai eu besoin de retravailler mes fichiers d'aplats. (hachure solide en couleur attribuée)

Voici ce que j'ai réussi à pondre.

Le 1er est carrément une copie d'un code trouvé sur un site allemand:

Convertir des couleurs ACI en RGB.

 

Le second, j'ai retranscris un algorithme:

Eclaircir/Assombrir (valeur négative) toutes les couleurs en jouant sur le facteur lumière (mode TSL)

(Voir les liens des sources employées dans les codes respectif)

 

En aurez-vous besoin...

 

;;http://www.autolisp.mapcar.net/acifarben.html
(defun ACI2RGB (n / l1 l3)
 (cond
   ( (or(> n 255)(< n 1))nil)
   ( (> 7 n 0)(aci2rgb(+ 10(* 40(1- n)))))
   ( (> 250 n 9)
     (setq l1
      '(0 1 2 3 4 4 4 4 4 4 4 4 4 3 2 1 0 0 0 0 0 0 0 0)
     )
     (setq l3 '(1 0.8 0.6 0.5 0.3))
     (mapcar
      '(lambda(v w / )
         (fix
           (* 255
             (+
               (*
                 0.25
                 (nth(rem(+(1-(/ n 10))v)24)l1)
                 (nth(/(rem n 10)2)l3)
               )
               (*
                 (rem n 2)
                 0.125
                 (nth(rem(+(1-(/ n 10))w)24)l1)
                 (nth(/(rem n 10)2)l3)
               )
             )
           )
         )
       )
      '(8 0 16)
      '(20 12 4)
     )
   )
   (1
     (apply
      '(lambda(v w / )(list w w w))
       (assoc n
         '((7 255)(8 128)(9 192)(250 51)(251 91)(252 132)
                            (253 173)(254 214)(255 255)))
     )
   )
 )
)
(defun RGB2TrueColor (l_RGB / )
(+ (lsh (car l_RGB) 16) (lsh (cadr l_RGB) 8) (caddr l_RGB))
)
(defun c:256toRGB ( / );js n dxf_ent T_C)
(while (null (setq js (ssget "_X" '((-4 . "<") (62 . 256))))))
(setq n -1)
(repeat (sslength js)
	(setq T_C (RGB2TrueColor (ACI2RGB (cdr (assoc 62 (setq dxf_ent (entget (ssname js (setq n (1+ n))))))))))
	(entmod
		(append
			dxf_ent
			(list (cons 420 T_C))
		)
	)
)
(prin1)
)

 

(defun RGB2TrueColor (l_RGB / )
(+ (lsh (car l_RGB) 16) (lsh (cadr l_RGB) 8) (caddr l_RGB))
)
(defun TrueColor2RGB (tc / )
(list (/ tc 65536) (/ (rem tc 65536) 256) (rem tc 65536 256))
)
;;http://www.easyrgb.com/math.php?MATH=M18#text18
(defun RGB2HSL (l_RGB / l_var min_RGB max_RGB int_RGB ooL Hoo oSo v_RGB)
(setq
	l_var (mapcar '/ l_RGB '(256.0 256.0 256.0))
	min_RGB (eval (cons 'min l_var))
	max_RGB (eval (cons 'max l_var))
	int_RGB (- max_RGB min_RGB)
	ooL (* (+ max_RGB min_RGB) 0.5)
)
(if (equal min_RGB max_RGB)
	(setq Hoo 0.0 oSo 0.0)
	(progn
		(if (< ooL 0.5)
			(setq oSo (/ int_RGB (+ max_RGB min_RGB)))
			(setq oSo (/ int_RGB (- max_RGB min_RGB)))
		)
		(setq v_RGB (mapcar '(lambda (x) (/ (+ (/ (- max_RGB x) 6) (* int_RGB 0.5)) int_RGB)) l_var))
		(if (= (car l_var) max_RGB)
			(setq Hoo (- (caddr v_RGB) (cadr v_RGB)))
		)
		(if (= (cadr l_var) max_RGB)
			(setq Hoo (+ (- (car v_RGB) (caddr v_RGB)) (/ 1.0 3)))
		)
		(if (= (caddr l_var) max_RGB)
			(setq Hoo (+ (- (cadr v_RGB) (car v_RGB)) (/ 2.0 3)))
		)
		(if (< Hoo 0.0) (setq Hoo (1+ Hoo)))
		(if (> Hoo 1.0) (setq Hoo (1- Hoo)))
	)
)
(list (* 3.6 Hoo) oSo ooL)
)
(defun Hue2RGB (l / vH)
(setq vH (caddr l))
(if (< (caddr l) 0) (setq vH (1+ (caddr l))))
(if (> (caddr l) 1) (setq vH (1- (caddr l))))
(if (< (* 6 vH) 1)
	(+ (car l) (* 6 vH (- (cadr l) (car l))))
	(if (< (* 2 vH) 1)
		(cadr l)
		(if (< (* 3 vH) 2)
			(+ (car l) (* 6 (- (cadr l) (car l)) (- (/ 2.0 3) vH)))
			(car l)
		)
	)
)
)
(defun HSL2RGB (l_HSL / l_RGB tmp_2 tmp_1 val_R val_G val_B)
(if (zerop (cadr l_HSL))
	(repeat 3 (setq l_RGB (cons (* (caddr l_HSL) 255) l_RGB)))
	(progn
		(if (< (caddr l_HSL) 0.5)
			(setq tmp_2 (* (caddr l_HSL) (1+ (cadr l_HSL))))
			(setq tmp_2 (- (+ (caddr l_HSL) (cadr l_HSL)) (* (caddr l_HSL) (cadr l_HSL))))
		)
		(setq
			tmp_1 (- (* (caddr l_HSL) 2.0) tmp_2)
			val_R (* 255 (Hue2RGB (list tmp_1 tmp_2 (+ (/ (car l_HSL) 3.6) (/ 1.0 3)))))
			val_G (* 255 (Hue2RGB (list tmp_1 tmp_2 (/ (car l_HSL) 3.6))))
			val_B (* 255 (Hue2RGB (list tmp_1 tmp_2 (- (/ (car l_HSL) 3.6) (/ 1.0 3)))))
		)
		(setq l_RGB (mapcar 'atoi (list (rtos val_R 2 0) (rtos val_G 2 0) (rtos val_B 2 0))))
	)
)
)
(defun c:Adjust_Light_Color ( / js n dxf_ent l_HSL nw_light)
(while (null (setq js (ssget '((-4 . ">") (420 . 0))))))
(setq n -1)
(while
	(> 
		(abs (if (not (setq nw_light (getreal "\nAugmenter+/-Diminuer la luminosité des couleurs aux objets de % <2.5> : ")))
			(setq nw_light 0.025)
			(setq nw_light (/ nw_light 100.0))
		))
		1
	)
	(princ "La valeur doit être comprise entre 0% et 100% !")
)
(repeat (sslength js)
	(setq l_HSL (RGB2HSL (TrueColor2RGB (cdr (assoc 420 (setq dxf_ent (entget (ssname js (setq n (1+ n))))))))))
	(entmod
		(subst
			(cons 420 (RGB2TrueColor (HSL2RGB (list (car l_HSL) (cadr l_HSL) (if (> (+ (caddr l_HSL) nw_light) 1) 1.0 (+ (caddr l_HSL) nw_light))))))
			(assoc 420 dxf_ent)
			dxf_ent
		)
	)
)
(prin1)
)

[(gile)]

Encore une fois, très intéressant, Bonuscad :D

 

On trouve aussi des routines pour jouer avec les "couleurs vraies" dans :

 

C:\Program Files\AutoCAD 2007\Sample\VisualLISP\color_util.lsp

 

Le dossier VisualLISP n'est peut-être pas installé automatiquement au démarrage (comme les Express)

[bonuscad]

color_util.lsp

 

Dans la 2008, j'ai pas trouvé, pourtant j'ai installé les options d'exemples.

 

Mais j'ai peut être besoin de lunettes, le pire c'est que c'est vrai... :P

[(gile)]

Dans 2007, c'est dans Exemples Visual LISP

 

http://img153.imageshack.us/img153/346/samplecd5.png

 

Si tu ne l'as pas je peux te l'envoyer ou le poster ici (avec le copyright).