Jump to content

Lisp to send *display* colors to back

jweber

By jweber
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Pukenzz Explorer

Pukenzz

Posted
Posted

It does make sense. Still trying to wrap my head around if or how it will or will not work for my application. Thanks a ton. I appreciate all the help and feedback from everybody here.

  • Replies 31
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    10

  • Pukenzz

    8

  • jweber

    7

  • tive29

    3

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)
Pukenzz said:
It does make sense. Still trying to wrap my head around if or how it will or will not work for my application. Thanks a ton. I appreciate all the help and feedback from everybody here.

 

If I've correctly understood what you are looking to achieve, try the following: 

;; Colour to Back  -  Lee Mac
;; Sends all objects of a specific colour (object colour/layer colour) to the back of the draw order.

(defun c:col2back ( / *error* blk bll col doc exd lac lck ls1 ls2 sor )

   (setq col 15) ;; Colour to send to back
   
   (vlax-for lay (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object))))
       (if (= :vlax-true (vla-get-lock lay))
           (vla-put-lock (car (setq lck (cons lay lck))) :vlax-false)
       )
       (if (= col (vla-get-color lay))
           (setq lac (cons (vla-get-name lay) lac))
       )
   )
   (vlax-for blk (vla-get-blocks doc)
       (if (and (= :vlax-false (vla-get-isxref blk)) (= :vlax-false (vla-get-islayout blk)))
           (   (lambda ( / lst )
                   (vlax-for obj blk
                       (if (or (and (= acbylayer (vla-get-color obj)) (member (vla-get-layer obj) lac))
                               (= col (vla-get-color obj))
                           )
                           (setq lst (cons obj lst))
                       )
                   )
                   (if lst
                       (progn
                           (setq exd (vla-getextensiondictionary blk)
                                 bll (cons (vla-get-name blk) bll)
                           )
                           (vlax-invoke
                               (cond
                                   (   (LM:catchapply 'vla-getobject (list exd "acad_sortents")))
                                   (   (vla-addobject exd "acad_sortents" "acdbsortentstable"))
                               )
                               'movetobottom lst
                           )
                       )
                   )
               )
           )
       )
   )
   (vlax-for lay (vla-get-layouts doc)
       (vlax-for obj (setq blk (vla-get-block lay))
           (cond
               (   (or (and (= acbylayer (vla-get-color obj)) (member (vla-get-layer obj) lac))
                       (= col (vla-get-color obj))
                   )
                   (setq ls1 (cons obj ls1))
               )
               (   (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-name obj) bll))
                   (setq ls2 (cons obj ls2))
               )
           )
       )
       (if (or ls1 ls2)
           (progn
               (setq exd (vla-getextensiondictionary blk)
                     sor
                   (cond
                       (   (LM:catchapply 'vla-getobject (list exd "acad_sortents")))
                       (   (vla-addobject exd "acad_sortents" "acdbsortentstable"))
                   )
               )
               (if ls2 (vlax-invoke sor 'movetobottom ls2))
               (if ls1 (vlax-invoke sor 'movetobottom ls1))
           )
       )
   )
   (foreach lay lck (vla-put-lock lay :vlax-true))
   (vla-regen doc acallviewports)
   (princ)
)

;; Catch Apply  -  Lee Mac
;; Applies a function to a list of parameters and catches any exceptions.

(defun LM:catchapply ( fun arg / rtn )
   (if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)
           
(vl-load-com) (princ)
 
Edited by Lee Mac
Pukenzz Explorer

Pukenzz

Posted
Posted

Awesome, yes that seems to do it. So now the question is this (and I'm trying it myself but not very versed in lisp writing)... I actually need it to work for multiple colors 61, 106, 152, 202 and not 15 at all.

Pukenzz Explorer

Pukenzz

Posted
Posted

Sorry, to clarify... I do not need 15 to be specifically excluded, it just is not one of the colors I will need to send to back. I'll nee 61, 106, 152, 202.

 

I have tried

 

(setq col '(61 106 152 202))

 

I have also tried

 

(set 'col '(61 106 152 202))

 

Am I on the right track with either of these? Neither seems to work like it did when 15 was by itself. Perhaps there are deeper lines that need modified also?

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)
Pukenzz said:
Perhaps there are deeper lines that need modified also?

 

Indeed there are - you can't simply replace an integer with a list ;)

 

Try the following: 

;; Colour(s) to Back  -  Lee Mac
;; Sends all objects of specific colour(s) (object colour/layer colour) to the back of the draw order.

(defun c:col2back ( / *error* blk bll col doc exd lac lck ls1 ls2 sor )

   (setq col '(61 106 152 202)) ;; List of colour(s) to send to back
   
   (vlax-for lay (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object))))
       (if (= :vlax-true (vla-get-lock lay))
           (vla-put-lock (car (setq lck (cons lay lck))) :vlax-false)
       )
       (if (member (vla-get-color lay) col)
           (setq lac (cons (vla-get-name lay) lac))
       )
   )
   (vlax-for blk (vla-get-blocks doc)
       (if (and (= :vlax-false (vla-get-isxref blk)) (= :vlax-false (vla-get-islayout blk)))
           (   (lambda ( / lst )
                   (vlax-for obj blk
                       (if (or (and (= acbylayer (vla-get-color obj)) (member (vla-get-layer obj) lac))
                               (member (vla-get-color obj) col)
                           )
                           (setq lst (cons obj lst))
                       )
                   )
                   (if lst
                       (progn
                           (setq exd (vla-getextensiondictionary blk)
                                 bll (cons (vla-get-name blk) bll)
                           )
                           (vlax-invoke
                               (cond
                                   (   (LM:catchapply 'vla-getobject (list exd "acad_sortents")))
                                   (   (vla-addobject exd "acad_sortents" "acdbsortentstable"))
                               )
                               'movetobottom lst
                           )
                       )
                   )
               )
           )
       )
   )
   (vlax-for lay (vla-get-layouts doc)
       (vlax-for obj (setq blk (vla-get-block lay))
           (cond
               (   (or (and (= acbylayer (vla-get-color obj)) (member (vla-get-layer obj) lac))
                       (member (vla-get-color obj) col)
                   )
                   (setq ls1 (cons obj ls1))
               )
               (   (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-name obj) bll))
                   (setq ls2 (cons obj ls2))
               )
           )
       )
       (if (or ls1 ls2)
           (progn
               (setq exd (vla-getextensiondictionary blk)
                     sor
                   (cond
                       (   (LM:catchapply 'vla-getobject (list exd "acad_sortents")))
                       (   (vla-addobject exd "acad_sortents" "acdbsortentstable"))
                   )
               )
               (if ls2 (vlax-invoke sor 'movetobottom ls2))
               (if ls1 (vlax-invoke sor 'movetobottom ls1))
           )
       )
   )
   (foreach lay lck (vla-put-lock lay :vlax-true))
   (vla-regen doc acallviewports)
   (princ)
)

;; Catch Apply  -  Lee Mac
;; Applies a function to a list of parameters and catches any exceptions.

(defun LM:catchapply ( fun arg / rtn )
   (if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)

(vl-load-com) (princ)
 
Edited by Lee Mac
Pukenzz Explorer

Pukenzz

Posted
Posted

Lee Mac that did it. Everybody thank you. I am trying to learn and dissect how the code works rather than just ask you all to write it for me. Thanks much for the ongoing help.

tive29 Enthusiast

tive29

Posted
Posted

Tried this lisp below but the colours does no reorder base on the list.

Can advise?

 

This is dwg I use

 

COLOURORDER.dwg

 

 

Indeed there are - you can't simply replace an integer with a list ;)

 

Try the following:

[color=GREEN];; Colour(s) to Back  -  Lee Mac[/color]
[color=GREEN];; Sends all objects of specific colour(s) (object colour/layer colour) to the back of the draw order.[/color]

([color=BLUE]defun[/color] c:col2back ( [color=BLUE]/[/color] *error* blk bll col doc exd lac lck ls1 ls2 sor )

   ([color=BLUE]setq[/color] col '(61 106 152 202)) [color=GREEN];; List of colour(s) to send to back[/color]
   
   ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layers[/color] ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=BLUE]:vlax-true[/color] ([color=BLUE]vla-get-lock[/color] lay))
           ([color=BLUE]vla-put-lock[/color] ([color=BLUE]car[/color] ([color=BLUE]setq[/color] lck ([color=BLUE]cons[/color] lay lck))) [color=BLUE]:vlax-false[/color])
       )
       ([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]vla-get-color[/color] lay) col)
           ([color=BLUE]setq[/color] lac ([color=BLUE]cons[/color] ([color=BLUE]vla-get-name[/color] lay) lac))
       )
   )
   ([color=BLUE]vlax-for[/color] blk ([color=BLUE]vla-get-blocks[/color] doc)
       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] blk)) ([color=BLUE]=[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-islayout[/color] blk)))
           (   ([color=BLUE]lambda[/color] ( [color=BLUE]/[/color] lst )
                   ([color=BLUE]vlax-for[/color] obj blk
                       ([color=BLUE]if[/color] ([color=BLUE]or[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] [color=BLUE]acbylayer[/color] ([color=BLUE]vla-get-color[/color] obj)) ([color=BLUE]member[/color] ([color=BLUE]vla-get-layer[/color] obj) lac))
                               ([color=BLUE]member[/color] ([color=BLUE]vla-get-color[/color] obj) col)
                           )
                           ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] obj lst))
                       )
                   )
                   ([color=BLUE]if[/color] lst
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]setq[/color] exd ([color=BLUE]vla-getextensiondictionary[/color] blk)
                                 bll ([color=BLUE]cons[/color] ([color=BLUE]vla-get-name[/color] blk) bll)
                           )
                           ([color=BLUE]vlax-invoke[/color]
                               ([color=BLUE]cond[/color]
                                   (   (LM:catchapply '[color=BLUE]vla-getobject[/color] ([color=BLUE]list[/color] exd [color=MAROON]"acad_sortents"[/color])))
                                   (   ([color=BLUE]vla-addobject[/color] exd [color=MAROON]"acad_sortents"[/color] [color=MAROON]"acdbsortentstable"[/color]))
                               )
                               'movetobottom lst
                           )
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layouts[/color] doc)
       ([color=BLUE]vlax-for[/color] obj ([color=BLUE]setq[/color] blk ([color=BLUE]vla-get-block[/color] lay))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]or[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] [color=BLUE]acbylayer[/color] ([color=BLUE]vla-get-color[/color] obj)) ([color=BLUE]member[/color] ([color=BLUE]vla-get-layer[/color] obj) lac))
                       ([color=BLUE]member[/color] ([color=BLUE]vla-get-color[/color] obj) col)
                   )
                   ([color=BLUE]setq[/color] ls1 ([color=BLUE]cons[/color] obj ls1))
               )
               (   ([color=BLUE]and[/color] ([color=BLUE]=[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] obj)) ([color=BLUE]member[/color] ([color=BLUE]vla-get-name[/color] obj) bll))
                   ([color=BLUE]setq[/color] ls2 ([color=BLUE]cons[/color] obj ls2))
               )
           )
       )
       ([color=BLUE]if[/color] ([color=BLUE]or[/color] ls1 ls2)
           ([color=BLUE]progn[/color]
               ([color=BLUE]setq[/color] exd ([color=BLUE]vla-getextensiondictionary[/color] blk)
                     sor
                   ([color=BLUE]cond[/color]
                       (   (LM:catchapply '[color=BLUE]vla-getobject[/color] ([color=BLUE]list[/color] exd [color=MAROON]"acad_sortents"[/color])))
                       (   ([color=BLUE]vla-addobject[/color] exd [color=MAROON]"acad_sortents"[/color] [color=MAROON]"acdbsortentstable"[/color]))
                   )
               )
               ([color=BLUE]if[/color] ls2 ([color=BLUE]vlax-invoke[/color] sor 'movetobottom ls2))
               ([color=BLUE]if[/color] ls1 ([color=BLUE]vlax-invoke[/color] sor 'movetobottom ls1))
           )
       )
   )
   ([color=BLUE]foreach[/color] lay lck ([color=BLUE]vla-put-lock[/color] lay [color=BLUE]:vlax-true[/color]))
   ([color=BLUE]vla-regen[/color] doc [color=BLUE]acallviewports[/color])
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Catch Apply  -  Lee Mac[/color]
[color=GREEN];; Applies a function to a list of parameters and catches any exceptions.[/color]

([color=BLUE]defun[/color] LM:catchapply ( fun arg [color=BLUE]/[/color] rtn )
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]setq[/color] rtn ([color=BLUE]vl-catch-all-apply[/color] fun arg)))) rtn)
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

marko_ribar Veteran

marko_ribar

Posted
Posted
Tried this lisp below but the colours does no reorder base on the list.

Can advise?

 

Replace "cdorder.lsp" from Express Tools with this correct one and run CDORDER command - just set colors in dialog (they are already set) and click OK...

Modification of lisp refers on commandline version of this lisp (-CDORDER) command, but as I revised it and I suggest CDORDER command for your requested question, I'll post modified lisp... It's not violation of copyrighted material, but my revision which is correct... See it for yourself...

 

HTH., M.R.

cdorder.lsp

Lee Mac Grand Master

Lee Mac

Posted
Posted
Tried this lisp below but the colours does no reorder base on the list.

Can advise?

 

The program is not designed to reorder the object draw-order based on the order of the colour numbers in the list, but rather to send all objects which exhibit a colour found in the list to the back of the draw order.

tive29 Enthusiast

tive29

Posted
Posted
The program is not designed to reorder the object draw-order based on the order of the colour numbers in the list, but rather to send all objects which exhibit a colour found in the list to the back of the draw order.

 

Ahhhh..... WOuld be nice if it could :P

tive29 Enthusiast

tive29

Posted
Posted
Replace "cdorder.lsp" from Express Tools with this correct one and run CDORDER command - just set colors in dialog (they are already set) and click OK...

Modification of lisp refers on commandline version of this lisp (-CDORDER) command, but as I revised it and I suggest CDORDER command for your requested question, I'll post modified lisp... It's not violation of copyrighted material, but my revision which is correct... See it for yourself...

 

HTH., M.R.

 

How is this different from 2014 Architecture version? I ran both CDORDER & -CDORDER & it the same as the autocad version.

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.

×
 Share
Go to topic listing
×
×
  • Create New...