Change colors viewport automatically after using lisp

[Sandervp]

Hello everybody!

 

I have a lisp file which creates 2 new commands. If I use tne first command, all the viewports in my drawing are locked. If I use the other command, they are all unlocked again.

 

If I use these commands, also the colors of these viewports are changing. If I lock them, they become green. If I unlock the viewports, they become red. The colors are only changing after I use these created commands.

 

If I want to change something and I need to unlock a (locked=green colored) viewport manually at the properties. The color of this viewport doesn't change into red.

 

Is there a way to change this lisp, so the color of a viewport is also changing after I lock or unlock him manually?

 

This is the lisp:

 

(vl-load-com)

(defun dxf (n ed) (cdr (assoc n ed)))

(defun c:vpl (/ AD COUNT ENT I PL SS TABNAME VP VPNO)
   (setq ad (vla-get-activedocument (vlax-get-acad-object)))



   (vlax-for lay (vla-get-layouts ad)
       (if (/= (setq TabName (strcase (vla-get-name lay))) "MODEL") ;_ end of /=
           (progn
               (if (setq ss (ssget
                                "X"
                                (list (cons 0 "viewport")
                                ) ;_ end of list
                            ) ;_ end of ssget
                   ) ;_ end of setq
                   (progn
                       (setq count (sslength ss))
                       (setq i 0)
                       (if (> count 0)
                           (progn
                               (while (< i count)
                                   (setq
                                       ent (ssname ss
                                                   i
                                           ) ;_ end of ssname
                                   ) ;_ end of setq
                                   (setq vpNo
                                            (dxf
                                                69
                                                (entget
                                                    ent
                                                ) ;_ end of entget
                                            ) ;_ end of dxf
                                   ) ;_ end of setq
                                   (if (> vpNo 1)
                                       (progn
                                           (setq vp (vlax-ename->vla-object
                                                        ent
                                                    ) ;_ end of vlax-ename->vla-object
                                           ) ;_ end of setq
                                           (if (= (vla-get-clipped
                                                      vp
                                                  ) ;_ end of vla-get-clipped
                                                  :vlax-false
                                               ) ;_ end of =
                                               (progn
                                                   (vla-put-color
                                                       vp
                                                       3
                                                   ) ;_ end of vla-put-color
                                      
                                                   (vla-put-layer
                                                       vp
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                               ) ;_ end of progn
                                               (progn
                                                   (setq
                                                       pl (entget
                                                              (dxf
                                                                  340
                                                                  (entget
                                                                      ent
                                                                  ) ;_ end of entget
                                                              ) ;_ end of dxf
                                                          ) ;_ end of entget
                                                   ) ;_ end of setq
                                                   ;get clip entity
                                                   (setq pl (vlax-ename->vla-object
                                                                (dxf -1
                                                                     pl
                                                                ) ;_ end of dxf
                                                            ) ;_ end of vlax-ename->vla-object
                                                   ) ;_ end of setq
                                                   (vla-put-color
                                                       pl
                                                       3
                                                   ) ;_ end of vla-put-color
                                                   (vla-put-layer
                                                       pl
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                                   (vla-put-color
                                                       vp
                                                       3
                                                   ) ;_ end of vla-put-color
                                       
                                                   (vla-put-layer
                                                       vp
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                               ) ;_ end of progn
                                           ) ;_ end of if
                                           (vla-put-displaylocked
                                               vp
                                               :vlax-true
                                           ) ;_ end of vla-put-displaylocked
                                           (vla-update vp)
                                       ) ;_ end of progn
                                   ) ;_ end of if
                                   (setq i (1+ i))
                               ) ;_ end of while
                           ) ;_ end of progn
                       ) ;_ end of if
                   ) ;_ end of progn
               ) ;_ end of if
           ) ;_ end of progn
       ) ;_ end of if
   ) ;_ end of vlax-for

) ;_ end of defun

(defun c:vpu (/ AD COUNT ENT I PL SS TABNAME VP VPNO)
   (setq ad (vla-get-activedocument (vlax-get-acad-object)))



   (vlax-for lay (vla-get-layouts ad)
       (if (/= (setq TabName (strcase (vla-get-name lay))) "MODEL") ;_ end of /=
           (progn
               (if (setq ss (ssget
                                "X"
                                (list (cons 0 "viewport")
                                ) ;_ end of list
                            ) ;_ end of ssget
                   ) ;_ end of setq
                   (progn
                       (setq count (sslength ss))
                       (setq i 0)
                       (if (> count 0)
                           (progn
                               (while (< i count)
                                   (setq
                                       ent (ssname ss
                                                   i
                                           ) ;_ end of ssname
                                   ) ;_ end of setq
                                   (setq vpNo
                                            (dxf
                                                69
                                                (entget
                                                    ent
                                                ) ;_ end of entget
                                            ) ;_ end of dxf
                                   ) ;_ end of setq
                                   (if (> vpNo 1)
                                       (progn
                                           (setq vp (vlax-ename->vla-object
                                                        ent
                                                    ) ;_ end of vlax-ename->vla-object
                                           ) ;_ end of setq
                                           (if (= (vla-get-clipped
                                                      vp
                                                  ) ;_ end of vla-get-clipped
                                                  :vlax-false
                                               ) ;_ end of =
                                               (progn
                                                   (vla-put-color
                                                       vp
                                                       1
                                                   ) ;_ end of vla-put-color
                                       ; 3 green
                                                   (vla-put-layer
                                                       vp
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                               ) ;_ end of progn
                                               (progn
                                                   (setq
                                                       pl (entget
                                                              (dxf
                                                                  340
                                                                  (entget
                                                                      ent
                                                                  ) ;_ end of entget
                                                              ) ;_ end of dxf
                                                          ) ;_ end of entget
                                                   ) ;_ end of setq
                                                   ;get clip entity
                                                   (setq pl (vlax-ename->vla-object
                                                                (dxf -1
                                                                     pl
                                                                ) ;_ end of dxf
                                                            ) ;_ end of vlax-ename->vla-object
                                                   ) ;_ end of setq
                                                   (vla-put-color
                                                       pl
                                                       1
                                                   ) ;_ end of vla-put-color
                                                   (vla-put-layer
                                                       pl
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                                   (vla-put-color
                                                       vp
                                                       1
                                                   ) ;_ end of vla-put-color
                                       ; 3 green
                                                   (vla-put-layer
                                                       vp
                                                       "defpoints"
                                                   ) ;_ end of vla-put-layer
                                               ) ;_ end of progn
                                           ) ;_ end of if
                                           (vla-put-displaylocked
                                               vp
                                               :vlax-false
                                           ) ;_ end of vla-put-displaylocked
                                           (vla-update vp)
                                       ) ;_ end of progn
                                   ) ;_ end of if
                                   (setq i (1+ i))
                               ) ;_ end of while
                           ) ;_ end of progn
                       ) ;_ end of if
                   ) ;_ end of progn
               ) ;_ end of if
           ) ;_ end of progn
       ) ;_ end of if
   ) ;_ end of vlax-for

)

 

Is it also possible, after I opened a drawing, every viewport is locked (and green) already?

In other words, the command "VPL" is already used before I can change the drawing?

 

Thank you all for your replies!

 

Greetings Sander

[Hsanon]

the concept is interesting .....

Is it possible to colour code just the selected viewports ????

 

i.e. there could be some red and some green viewports (unlocked and locked)

you may wish to unlock just one viewport and let the rest be locked ???

 

 

thanks

[Sandervp]

Hello Hsanon,

 

 

That's exactly what I want.

 

 

If I use my command "VPL", every viewport becomes green and are locked.

If I unlock one viewport instead of all the viewports, the color of this viewport is still green.

 

 

I want every unlocked viewport visible in a red color. So I can see in the blink of an eye which are locked or unlocked.

[Commandobill]

You could probably do it using a reactor. I'm not well versed in them, but I'm pretty sure it's possible.

[Sandervp]

You could probably do it using a reactor. I'm not well versed in them, but I'm pretty sure it's possible.

 

I didn't work with a reactor since I am using AutoCad. I do not know what it is or how they work...