Jump to content

Change colors viewport automatically after using lisp


Sandervp

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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...

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...