VPLocker Modification

I use the lisp VPLocker to lock and unlock the viewports on my layouts which it works great, except that when I clip an existing viewport using a polyline (for example), and I run the VPLocker routine on the clipped viewport, the viewport (which by this time it disappeared from view) changes the color as it is supposed to, but the polyline (which is the only visible item left) I used to clip the viewport with does not change the color.

Is there something that could be change or added to the routine to make it possible so it doesn't matter what you use to clip a viewport, VPLocker will lock and change the color of the item used to clip the viewport?.

vplocker.lsp

For fun:

(vl-load-com)

;;;--------------------------------------------------------------------;
;;; Viewport lock
(defun c:VPL () (c:ViewportLock))
(defun c:ViewportLock (/ option ss)
 (princ "\rVIEWPORTLOCK ")
 (_PutPViewportLockAndColor :vlax-true 4)
)
;;;--------------------------------------------------------------------;
;;; Viewport unlock
(defun c:VPU () (c:ViewportUnlock))
(defun c:ViewportUnlock (/ option ss)
 (princ "\rVIEWPORTUNLOCK ")
 (_PutPViewportLockAndColor :vlax-false 256)
)
;;;--------------------------------------------------------------------;
;;; Put PViewport Lock and Color
(defun _PutPViewportLockAndColor (lock color / *error* option ss acDoc)

 (defun *error* (msg)
   (if (and ss (= 'VLA-OBJECT (type ss)))
     (vla-delete ss)
   )      
   (if acDoc
     (vla-endundomark acDoc)
   )
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** " msg " ** ")))
   )                                                                   ; Fatal error, display it
   (princ)
 )

 (if (and (not (initget "All Current"))
          (or (setq option
                     (getkword
                       "\nEnter layout(s) to modify [All/Current]<Current>: "
                     )
              )
              (setq option "Current")
          )
          (setq ss
                 (cond ((= "Current" option) (_GetPViewports nil))
                       ((_GetPViewports T))
                 )
          )
     )
   (progn
     (vla-startundomark
       (setq acDoc
              (vla-get-activedocument
                (vlax-get-acad-object)
              )
       )
     )
     (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
       (vla-put-color x color)
       (if (vlax-property-available-p x 'displaylocked)
         (vla-put-displaylocked x lock)
       )
     )
     (if (= (vla-get-mspace acDoc) :vlax-true)
       (vla-regen acDoc acactiveviewport)
     )
     (setq ss (vla-delete ss))
     (*error* nil)
   )
   (if option
     (*error* "Command not allowed in Model Tab")
   )
 )
 (princ)
)
;;;--------------------------------------------------------------------;
;;; Get PViewports
(defun _GetPViewports (allTabs)
 (ssget
   "_x"
   (list
     '(-4 . "<OR")
     '(0 . "VIEWPORT")
     '(-4 . "<AND")
     '(0 . "LWPOLYLINE")
     '(102 . "{ACAD_REACTORS")
     '(-4 . "AND>")
     '(-4 . "OR>")
     (cons
       410
       (cond
         (allTabs
          (vl-string-right-trim
            ","
            (apply 'strcat
                   (mapcar '(lambda (x) (strcat x ",")) (layoutlist))
            )
          )
         )
         ((getvar 'ctab))
       )
     )
   )
 )
)

Code revised here... Summary:

Added an *error* handler, and undo support. Now you can Ctrl+Z without issue (yes, even for multiple layouts).

Code revised here... Summary:

Added a check for activated PViewport... If active, the acActiveViewport is regenerated.

Great! this works perfect. :D:D

Great! this works perfect. :D:D

... Happy to help