Fenêtres de présentation colorées

[(gile)]

C'est Bonuscad qui m'en a donné l'idée ici.

C'est Patrick_35 qui m'a motivé et largement inspiré.

C'est mon premier LISP avec réacteur.

 

Il s'agit d'un LISP qui place toutes les fenêtres de présentation sur un calque non tracé (Fenêtres présentation).

Les fenêtres dont la vue n'est pas verrouillée sont rouges, celles qui sont verrouillées vertes.

 

Pour activer le réacteur, taper VPC_ON, pour le désactiver, VPC_OFF

 

(defun GileVpColor (Rea Cde / vp)
 (if (and (zerop (getvar "TILEMODE"))
   (= (car Cde) "-VPORTS")
     )
   (vlax-for obj (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
     (cond
((= (vla-get-ObjectName obj) "AcDbViewport")
 (setq vp obj)
)
((=
   "VIEWPORT"
   (cdr
     (assoc
       0
       (entget (cdr (assoc 330 (entget (vlax-vla-object->ename obj))))
       )
     )
   )
 )
 (setq vp (vlax-ename->vla-object
	    (cdr (assoc 330 (entget (vlax-vla-object->ename obj))))
	  )
 )
)
(T (setq vp nil))
     )
     (if vp
(progn
  (vla-put-Layer obj "Fenêtres Présentation")
  (if (= (vla-get-DisplayLocked vp) :vlax-true)
    (vla-put-color obj 1)
    (vla-put-color obj 3)
  )
)
     )
   )
 )
)


(defun c:vpc_On	(/ acDoc lay)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
lay   (vl-catch-all-apply
	'vla-item
	(list (vla-get-Layers AcDoc) "Fenêtres Présentation")
      )
 )
 (if (vl-catch-all-error-p lay)
   (setq lay (vla-add (vla-get-Layers AcDoc) "Fenêtres Présentation"))
 )
 (vla-put-Plottable lay :vlax-false)
 (if (setq ss (ssget "_X" '((410 . "~Model"))))
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (cond
((= "VIEWPORT" (cdr (assoc 0 (entget obj))))
 (setq vp (vlax-ename->vla-object obj))
)
((= "VIEWPORT" (cdr (assoc 0 (entget (cdr (assoc 330 (entget obj)))))))
  (setq	vp (vlax-ename->vla-object
	     (cdr (assoc 330 (entget obj)))
	   )
  )
)
(T (setq vp nil))
     )
     (if vp
(progn
  (setq obj (vlax-ename->vla-object obj))
  (vla-put-Layer obj "Fenêtres Présentation")
  (if (= (vla-get-DisplayLocked vp) :vlax-true)
    (vla-put-color obj 1)
    (vla-put-color obj 3)
  )
)
     )
     )
   )
 (if (not GileColorVpReactor)
   (setq GileColorVpReactor
   (vlr-command-reactor
     nil
     '((:vlr-commandEnded . GileVpColor))
   )
   )
 )
 (princ "\nColoration des fenêtres activée.")
 (princ)
)


(defun c:vpc_Off ()
 (if GileColorVpReactor
   (progn
     (vlr-remove GileColorVpReactor)
     (setq GileColorVpReactor nil)
   )
 )
 (if (setq ss (ssget "_X" '((410 . "~Model"))))
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (if (or
(= "VIEWPORT" (cdr (assoc 0 (entget obj))))
 (= "VIEWPORT" (cdr (assoc 0 (entget (cdr (assoc 330 (entget obj)))))))
 )
(progn
  (setq obj (vlax-ename->vla-object obj))
    (vla-put-color obj 256)
  )
)
     )
   )
 (princ "\nColoration des fenêtres désactivée.")
 (princ)
)

 

[Edité le 3/12/2006 par (gile)]

[Patrick_35]

C'est génial :)

Ca fait plaisir de te voir enfin sur les réacteurs (gile) :cool:

Juste une remarque. Si ta variable SDI > 0 et que tu lances ton reacteurs, lors de l'ouverture d'un nouveau, tu auras un message d'erreur

 

@+

[Bred]

... et moi je ferais une remarque bien futile par rapport au sujet :

j'ai fais un lisp qui colore les fenêtre selon si elle sont vérouillé ou non (sans réacteur bien sûr :( )... et j'avoue avoir choisis le Rouge pour Vérrouillé, et le Vert pour Dévérouillé...

(pas trés constructif comme remarque, mais cela me semble plus logique...)

[Patrick_35]

j'avoue avoir choisis le Rouge pour Vérrouillé, et le Vert pour Dévérouillé...

Ca me rappelle l'histoire de la couleur des voyants d'un arrêt d'urgence d'une armoire électrique

Certain organisme de contrôle préfere le vert pour dire que c'est en fonctionnenemt et que tout est ok, et qu'en cas de déclenchement, c'est le voyant rouge qui s'allume

D'autre pour dire que le voyant rouge signale que l'armoire est sous tension et le voyant vert pour signaler que l'armoire est hors tension

Camarade, choisis ton camp et ta boule de cristal :(

 

@+

 

[bonuscad]

C'est Bonuscad qui m'en a donné l'idée

 

Disons plutôt que j'ai donné un lien, qui t'as donné l'idée ;)

 

J'ai essayé ton lisp sous une 2002, mais que rien ne se passe (pas de message d'erreurs pourtant)

Pas de dé/verrouillages de fenêtres, pas de mise en couleur, pas de création de calque..... :(

 

Je ne comprends pas le but de faire un réacteur; pour placer les fenêtres sur le calque spécifique?

 

J'essayerais sous une 2005 pour voir, peut être que je comprendrais alors l'utilité.

 

Mais je comprends aussi que c'est un coup d'essai, Patrick_35 te sera de bon conseil :exclam:

 

Voici la routine que j'avais trouvé, je retrouve pas de liens (ça m"embête un peu pour l'auteur) mais je farfouille tellement partout que je n'ai plus aucune idée sur quel site j'ai pu trouvé celui-ci.

 

(prompt "\nEnter VPL to Lock all Viewports ")
(prompt "\nEnter VPU to UnLock all Viewports ")
(vl-load-com)
(defun c:VPU () ;
(vlax-for lay
	(vla-get-layouts
		(vla-get-activedocument
			(vlax-get-acad-object)
		)
	)
	(if (eq :vlax-false (vla-get-modeltype lay))
		(vlax-for ent (vla-get-block lay) ; for each ent in layout
			(if (= (vla-get-objectname ent) "AcDbViewport")
				(progn
					(vla-put-displaylocked ent :vlax-false)
					(vla-put-color ent 3); 3 green
				)
			)
		)
	)
)
(princ)
)
(defun c:VPL () ; 07/07/04
(vlax-for lay
	(vla-get-layouts
		(vla-get-activedocument
			(vlax-get-acad-object)
		)
	)
	(if (eq :vlax-false (vla-get-modeltype lay))
		(vlax-for ent (vla-get-block lay) ; for each ent in layout
			(if (= (vla-get-objectname ent) "AcDbViewport")
				(progn
					(vla-put-displaylocked ent :vlax-true)
					(vla-put-color ent 256);256 bylayer
				)
			)
		)
	)
)
(princ)
)

 

NB: lui avait choisi le vert pour déverrouillé et la couleur du calque pour verrouillé :P

 

 

A ça y est, j'ai retrouvé le lien

Post de Jason Rhymes dans ce fil de discussion

 

[Edité le 3/12/2006 par bonuscad]

[(gile)]

J'ai aussi hésité, au début, j'avais mis les couleurs comme Bred le suggère, puis je me suis dis : "La vue verrouillée, c'est le feu vert pour le zoom en espace objet."

 

Il suffit d'intervertir (vla-put-color obj 3) et (vla-put-color obj 1).

[(gile)]

J'ai essayé ton lisp sous une 2002, mais que rien ne se passe (pas de message d'erreurs pourtant)

Pas de dé/verrouillages de fenêtres, pas de mise en couleur, pas de création de calque.....

 

En fait, j'ai mal expliqué comment ça fonctionne.

 

Il ne s'agit pas de (dé)verrouiller des fenêtres, une fois le réacteur activé (et je pensais à une activation à l'ouverture du dessin) chaque fenêtre de l'espace papier créée est placée sur le calque "Fenêtre présentation" et s'affiche en rouge, quand on (dé)verrouille une ou plusieurs fenêtres elle changent de couleur.

[Patrick_35]

Ah :o

Je pensais que quand on était dans une présentation et que l'on activait une fenêtre en objet, celle-ci changeait de couleur

Et après essai, je suis comme Bonus. Je ne comprend pas ? :exclam:

 

@+

[(gile)]

Je modifie le LISP, au lancement de VPC_ON, s'il déjà existe des fenêtres de présentation, elles sont placées sur le calque "Fenêtres présentations" et mises en couleur selon qu'elles sont verrouillées (rouge) ou déverrouillées (vert).

Il en va de même pour les fenêtres créées ensuite, et les modifications de verrouillages.

 

VPC_OFF remet toutes le fenêtres en couleur DUCALQUE.

[bonuscad]

Ah OK cette version fonctionne mieux

 

Mais on est obligé pour les nouvelles fenêtres de passer par le verrouillage pour que le reacteur entre en action, cela serait mieux qu'il soit effectif lors de l'utilisation de FMULT.

 

Mais déjà le résultat est interressant pour une première fois.

 

Je n'est pas encore fait de tests approfondis, et je suis pas sur que d'imposer un calque soit une bonne idée (on peut vouloir par exemple un tracage de contour pour certaines fenêtre et pour d'autres non)

[Patrick_35]

Je suis d'accord avec bonus en ce qui concerne la création d'un calque. D'autant qu'il est possible de donner une couleur à une fenêtre

 

@+

[(gile)]

Voilà une nouvelle version,

 

- les fenêtres ne sont plus placées sur un calque spécifique

- les fenêtres non verrouillées sont en orange (pour mettre tout le monde d'accord), les verrouillées en DUCALQUE.

- le réacteur agit désormais sur les commandes FENETRES, -FENETRES, FDELIM et FMULT

 

Reste que si le (dé)verrouillage se fait par la fenêtre des propriétés, il n'est pas pris en compte, je vais regarder du côté de vlr-object-reactor.

 

Nouvelle version (18/12/06)

Cette version utilise les couleurs de l'index (ACI), pour les versions AutoCAD 2004 et ultérieures, j'ai mis ici une version en couleurs vraies (True Color)

 

(defun UpdVpColorList (obj)
 (if (member (assoc (vla-get-Handle obj) *GileVpColorList*)
      *GileVpColorList*
     )
   (if	(and (/= (vla-get-Color obj) 20)
     (not
       (eq (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
	   (vla-get-Color obj)
       )
     )
)
     (setq *GileVpColorList*
     (subst (cons (vla-get-Handle obj)
		  (vla-get-Color obj)
	    )
	    (assoc (vla-get-Handle obj)
		   *GileVpColorList*
	    )
	    *GileVpColorList*
     )
     )
   )
   (setq *GileVpColorList*
   (cons (cons (vla-get-Handle obj)
	       (vla-get-Color obj)
	 )
	 *GileVpColorList*
   )
   )
 )
)

(defun UpdVpColor (obj / vp col)
 (cond
   ((= "VIEWPORT" (cdr (assoc 0 (entget obj))))
    (setq vp (vlax-ename->vla-object obj))
   )
   ((=	"VIEWPORT"
(cdr (assoc 0 (entget (cdr (assoc 330 (entget obj))))))
    )
    (setq vp (vlax-ename->vla-object
	(cdr (assoc 330 (entget obj)))
      )
    )
   )
   (T (setq vp nil))
 )
 (if vp
   (progn
     (setq obj	(vlax-ename->vla-object obj))
     (UpdVpColorList obj)
     (if (= (vla-get-DisplayLocked vp) :vlax-true)
(vla-put-Color
  obj
  (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
)
(vla-put-Color obj 20)
     )
   )
 )
)

(defun GileVpColor (Rea Cde)
 (if (and (zerop (getvar "TILEMODE"))
   (member (car Cde) '("MVIEW" "VPCLIP" "VPORTS" "-VPORTS"))
     )
   (vlax-for obj (vla-get-PaperSpace
	    (vla-get-ActiveDocument (vlax-get-acad-object))
	  )
     (setq obj (vlax-vla-object->ename obj))
     (UpdVpColor obj)
   )
 )
)

(defun c:vpc_On	(/ ss)
 (vl-load-com)
 (if (setq ss (ssget "_X" '((410 . "~Model"))))
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (UpdVpColor obj)
   )
 )
 (if (not *GileVpColorReactor*)
   (setq *GileVpColorReactor*
   (vlr-command-reactor
     nil
     '((:vlr-commandEnded . GileVpColor))
   )
   )
 )
 (princ "\nColoration des fenêtres activée.")
 (princ)
)

(defun c:vpc_Off (/ ss)
 (if *GileVpColorReactor*
   (vlr-remove *GileVpColorReactor*)
 )
 (if (and *GileVpColorList*
   (setq ss (ssget "_X" '((410 . "~Model"))))
     )
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (if
(or
  (= "VIEWPORT" (cdr (assoc 0 (entget obj))))
  (= "VIEWPORT"
     (cdr (assoc 0 (entget (cdr (assoc 330 (entget obj))))))
  )
)
 (progn
   (setq obj (vlax-ename->vla-object obj))
   (vla-put-TrueColor
     obj
     (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
   )
 )
     )
   )
 )
 (setq	*GileVpColorList*    nil
*GileVpColorReactor* nil
 )
 (princ "\nColoration des fenêtres désactivée.")
 (princ)
)

[Edité le 18/12/2006 par (gile)][Edité le 18/12/2006 par (gile)]

 

[Edité le 19/12/2006 par (gile)]

[(gile)]

Une version un peu différente, avec un réacteur sur la variable système CVPORT.

Les fenêtres de l'espace papier ne se colorent que quand on les active (en rouge si vérrouillée, en vert si déverrouillée).

 

Taper avp_on pour activer le réacteur, avp_off pour le désactiver.

 

Edit : correction d'un bug "visuel" ; quand on passait d'une fenêtre à une autre le contour ne s'affichait plus entrait fort. C'est réparé.

 

Version pour AutoCAD 2002 et antérieures, pour les versions 2004 et plus voir plus bas.

 

(defun GileActivePvp (Rea Lst / vp)
 (if (and
(zerop (getvar "TILEMODE"))
(= "CVPORT" (car Lst))
     )
   (progn
     (if *ActivePvpObject*
(vla-put-Color *ActivePvpObject* *PvpInitColor*)
     )
     (setq vp (vla-get-ActivePViewport
	 (vla-get-ActiveDocument (vlax-get-acad-object))
       )
     )
     (if (= (vla-get-Clipped vp) :vlax-true)
(setq *ActivePvpObject*
       (vlax-ename->vla-object
	 (cdr (assoc 340 (entget (vlax-vla-object->ename vp)))
	 )
       )
)
(setq *ActivePvpObject* vp)
     )
     (setq *PvpInitColor* (vla-get-Color *ActivePvpObject*))
     (if (	(progn
  (if (= :vlax-true (vla-get-DisplayLocked vp))
    (vla-put-color *ActivePvpObject* 1)
    (vla-put-color *ActivePvpObject* 3)
  )
  (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object))
	     acActiveViewport
  )
)
(progn
  (vla-put-Color *ActivePvpObject* *PvpInitColor*)
  (setq *ActivePvpObject* nil)
)
     )
   )
 )
)

(defun c:avp_on	()
 (vl-load-com)
 (if (not GileActivePvpReactor)
   (setq GileActivePvpReactor
   (vlr-Sysvar-reactor
     nil
     '((:vlr-sysVarChanged . GileActivePvp))
   )
   )
 )
 (princ "\nColoration de la fenêtre active : activée")
 (princ)
)

(defun c:avp_off ()
 (if GileActivePvpReactor
   (progn
     (if (	(vla-put-MSpace
  (vla-get-ActiveDocument (vlax-get-acad-object))
  :vlax-false
)
     )
     (vlr-remove GileActivePvpReactor)
     (setq GileActivePvpReactor nil)
   )
 )
 (princ "\nColoration de la fenêtre active : désactivée")
 (princ)
)

[Edité le 4/12/2006 par (gile)][Edité le 4/12/2006 par (gile)][Edité le 5/12/2006 par (gile)]

 

[Edité le 6/12/2006 par (gile)]

[Patrick_35]

AH, (gile) tu as été plus rapide que moi ;)

Tu as trouvé la même solution en utilisant sysvarchanged

Juste une remarque. Si tu lances plusieurs fois avp_on, fais ensuite un (vlr-remove-all) et tu constateras que tes réacteurs se sont additionné, ce qui veux dire que tu appeles ta routine de réacteurs plusieurs fois

Sinon, je n'ai pas fait exactement comme toi et je la met ici juste pour le fun

 

@+

 

(defun GileVpColor (Rea Cde / doc vpt)
 (if (and (zerop (getvar "TILEMODE")) (eq (car Cde) "CVPORT"))
   (progn
     (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
           vpt (vla-get-activepviewport doc))
     (if View_port_d_origine
       (vla-put-color View_port_d_origine (if couleur_d_origine couleur_d_origine 256))
     )
     (setq couleur_d_origine (vla-get-color vpt))
     (if (eq (vla-get-displaylocked vpt) :vlax-true)
       (vla-put-color vpt 1)
       (vla-put-color vpt 3)
     )
     (setq View_port_d_origine vpt)
   )
 )
)

(defun c:vpc_On ()
 (vl-load-com)
 (c:vpc_off)
 (setq GileColorVpReactor (vlr-sysvar-reactor nil (list (cons :vlr-sysvarchanged (function GileVpColor)))))
 (princ "\nColoration des fenêtres activée.")
 (princ)
)

(defun c:vpc_Off (/ i j n)
 (if (setq i (vlr-reactors :vlr-sysvar-reactor))
   (progn
     (setq n 1 i (nth n (car i)))
     (while i
       (setq j nil)
       (if (eq (cdr (car (vlr-reactions i))) 'GILEVPCOLOR)
         (setq j i)
       )
       (if j
         (vlr-remove j)
         (setq n (1+ n))
       )
       (if (setq i (vlr-reactors :vlr-sysvar-reactor))
         (setq i (nth n (car i)))
       )
     )
   )
 )
 (if GileColorVpReactor
   (princ "\nColoration des fenêtres désactivée.")
 )
 (setq GileColorVpReactor nil)
 (princ)
)

[(gile)]

Je modifie ma routine en m'inspirant de la tienne (couleur d'origine différente de DUCALQUE) et de tes recommendations sur l'addition des réacteurs. À ce sujet, il me semble qu'on peut faire plus simple, je verrais ça plus tard.

[Patrick_35]

Oui, on peut faire plus simple avec un (if (not ma_variable) faire_réacteur), mais c'est pour montrer comment effacer un reacteur sans passer par cette variable. C'est surtout utile quand le SDI > 0 et que l'on veux eviter un message d'erreur lors de l'ouverture/création d'un dessin

 

@+

 

ps : Dans ta routine, pourquoi tu te sers de code 340 ?

[(gile)]

Dans ta routine, pourquoi tu te sers de code 340 ?

 

C'est pour les fenêtres polygonales ou les fenêtres faites à partir d'objets, je récupère le polyligne ou l'objet ayant servi à faire la fenêtre, c'est lui que je colore.

 

Bon, je vais me coucher, demain je dois me lever à l'aube ...

[(gile)]

Une version qui utilise les couleurs vraies (TrueColor) pour AutoCAD 2004 et postérieures.

 

;;; Versions 2004 et postérieures

(defun GileActivePvp (Rea Lst / vp red green)
 (if (and
(zerop (getvar "TILEMODE"))
(= "CVPORT" (car Lst))
     )
   (progn
     (if *ActivePvpObject*
(vla-put-TrueColor *ActivePvpObject* *PvpInitColor*)
     )
     (setq vp (vla-get-ActivePViewport
	 (vla-get-ActiveDocument (vlax-get-acad-object))
       )
     )
     (if (= (vla-get-Clipped vp) :vlax-true)
(setq *ActivePvpObject*
       (vlax-ename->vla-object
	 (cdr (assoc 340 (entget (vlax-vla-object->ename vp)))
	 )
       )
)
(setq *ActivePvpObject* vp)
     )
     (setq *PvpInitColor* (vla-get-TrueColor *ActivePvpObject*))
     (if (	(progn
  (setq	release	(substr (getvar "acadver") 1 2))
  (foreach col '(red green)
    (set col
	 (vla-getInterfaceObject
	   (vlax-get-acad-object)
	   (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
	 )
    )
  )
  (vla-put-ColorIndex red acRed)
  (vla-put-ColorIndex green acGreen)
  (if (= :vlax-true (vla-get-DisplayLocked vp))
    (vla-put-TrueColor *ActivePvpObject* red)
    (vla-put-TrueColor *ActivePvpObject* green)
  )
  (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object))
	     acActiveViewport
  )
)
(progn
  (vla-put-TrueColor *ActivePvpObject* *PvpInitColor*)
  (setq *ActivePvpObject* nil)
)
     )
   )
 )
)

(defun c:avp_on	()
 (vl-load-com)
 (if (not GileActivePvpReactor)
   (setq GileActivePvpReactor
   (vlr-Sysvar-reactor
     nil
     '((:vlr-sysVarChanged . GileActivePvp))
   )
   )
 )
 (princ "\nColoration de la fenêtre active : activée")
 (princ)
)

(defun c:avp_off ()
 (if GileActivePvpReactor
   (progn
     (if (	(vla-put-MSpace
  (vla-get-ActiveDocument (vlax-get-acad-object))
  :vlax-false
)
     )
     (vlr-remove GileActivePvpReactor)
     (setq GileActivePvpReactor nil)
   )
 )
 (princ "\nColoration de la fenêtre active : désactivée")
 (princ)
)

 

[Edité le 6/12/2006 par (gile)]

[(gile)]

J'ai un petit peu modifié/amélioré les routines vpc_on et vpc_off (message 11).

 

Ces routine ne verouillent ni ne déverrouillent les fenêtres de présentation, elles ne font qu'activer/desactiver un réacteur qui colore les fenêtres déverrouillées en orange. Quand les fenêtres sont verrouillées elles retrouvent leur couleur (DUCALQUE ou couleur forcée) de même quand on désactive le réacteur (vpc_off).

 

Quand le réacteur est actif (vpc_on) chaque nouvelle fenêtre créée est en orange jusqu'à ce qu'elle soit verrouillée.

 

Pour que le réacteur soit actif à l'ouverture de chaque nouveau dessin, il est possible de rajouter à la fin du fichier MNL courant (acad.mnl par défaut) l'expression suivante :

 

(c:vpc_on)

 

Nota, les modifications faites à partir de la fenêtre de propriété ne seront prises en compte qu'après une autre modification ou création de fenêtre (préférer le menu contextuel)

[(gile)]

Une version de VPC_ON/VPC_OFF pour les version 2004 et ultérieures (True color)

 

(defun UpdVpColorList (obj)
 (if (member (assoc (vla-get-Handle obj) *GileVpColorList*)
      *GileVpColorList*
     )
   (if	(and (/= (vla-get-ColorIndex (vla-get-TrueColor obj)) 20)
     (not
       (eq (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
	   (vla-get-TrueColor obj)
       )
     )
)
     (setq *GileVpColorList*
     (subst (cons (vla-get-Handle obj)
		  (vla-get-TrueColor obj)
	    )
	    (assoc (vla-get-Handle obj)
		   *GileVpColorList*
	    )
	    *GileVpColorList*
     )
     )
   )
   (setq *GileVpColorList*
   (cons (cons (vla-get-Handle obj)
	       (vla-get-TrueColor obj)
	 )
	 *GileVpColorList*
   )
   )
 )
)

(defun UpdVpColor (obj / vp col)
 (cond
   ((= "VIEWPORT" (cdr (assoc 0 (entget obj))))
    (setq vp (vlax-ename->vla-object obj))
   )
   ((=	"VIEWPORT"
(cdr (assoc 0 (entget (cdr (assoc 330 (entget obj))))))
    )
    (setq vp (vlax-ename->vla-object
	(cdr (assoc 330 (entget obj)))
      )
    )
   )
   (T (setq vp nil))
 )
 (if vp
   (progn
     (setq obj	(vlax-ename->vla-object obj)
    col	(vla-getInterfaceObject
	  (vlax-get-acad-object)
	  (strcat "AutoCAD.AcCmColor."
		  (substr (getvar "acadver") 1 2)
	  )
	)
     )
     (vla-put-ColorIndex col 20)
     (UpdVpColorList obj)
     (if (= (vla-get-DisplayLocked vp) :vlax-true)
(vla-put-TrueColor
  obj
  (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
)
(vla-put-TrueColor obj col)
     )
   )
 )
)

(defun GileVpColor (Rea Cde)
 (if (and (zerop (getvar "TILEMODE"))
   (member (car Cde) '("MVIEW" "VPCLIP" "VPORTS" "-VPORTS"))
     )
   (vlax-for obj (vla-get-PaperSpace
	    (vla-get-ActiveDocument (vlax-get-acad-object))
	  )
     (setq obj (vlax-vla-object->ename obj))
     (UpdVpColor obj)
   )
 )
)

(defun c:vpc_On	(/ ss)
 (vl-load-com)
 (if (setq ss (ssget "_X" '((410 . "~Model"))))
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (UpdVpColor obj)
   )
 )
 (if (not *GileVpColorReactor*)
   (setq *GileVpColorReactor*
   (vlr-command-reactor
     nil
     '((:vlr-commandEnded . GileVpColor))
   )
   )
 )
 (princ "\nColoration des fenêtres activée.")
 (princ)
)

(defun c:vpc_Off (/ ss)
 (if *GileVpColorReactor*
   (vlr-remove *GileVpColorReactor*)
 )
 (if (and *GileVpColorList*
   (setq ss (ssget "_X" '((410 . "~Model"))))
     )
   (foreach obj (mapcar 'cadr (ssnamex ss))
     (if
(or
  (= "VIEWPORT" (cdr (assoc 0 (entget obj))))
  (= "VIEWPORT"
     (cdr (assoc 0 (entget (cdr (assoc 330 (entget obj))))))
  )
)
 (progn
   (setq obj (vlax-ename->vla-object obj))
   (vla-put-TrueColor
     obj
     (cdr (assoc (vla-get-Handle obj) *GileVpColorList*))
   )
 )
     )
   )
 )
 (setq	*GileVpColorList*    nil
*GileVpColorReactor* nil
 )
 (princ "\nColoration des fenêtres désactivée.")
 (princ)
) 

 

[Edité le 19/12/2006 par (gile)]

[(gile)]

Encore une petite amélioration pour VpColor : les changements de couleurs des fenêtres faits "après coup" sont enregistrés et le dernier changement est restauré quand la fenêtre est verrouillée ou le récteur désactivé.

 

Les versions 2002 (couleurs de l'index) et 2004 et plus (couleurs vraies) ont été modifiées.