Jump to content

Lisp to send *display* colors to back


jweber

Recommended Posts

First, I would like to credit user "irneb" for the first portion of this code that selects objects based on their display color.

 

With the use of this, I have added the functionality to send those objects to back. In our plot table, we wanted to have all objects with screening less than 100% print "below" all solid black lines and this accomplishes that.

 

This said, is there a better way to code the lower portion of this code? I'm new and struggled to make this work, but I'm sure there's a more efficient way to accomplish said task. AND finally, this method does not include lines within blocks--- is there any way to accomplish sending "color 15" and "color 17" (not BYLAYER, ALL lines in block are on layer 0) to back within all blocks in a drawing? I've tried multiple times to no avail. Thanks for any and all help!!

 

;Shade2Back
(defun c:s2b()
(defun ssfilter-by-color (color / lay layers)
 ;; Get all the layer names which are set to the color
 (setq lay    (tblnext "LAYER" t) ;Get the 1st layer
       layers "" ;Initialize the layer names filter string
 )
 (while lay ;Step through all layers
   ;; Check if current layer is set to color
   (if (= (cdr (assoc 62 lay)) color)
     (setq layers (strcat "," (cdr (assoc 2 lay)) layers)) ;Add to filter string
   )
   (setq lay (tblnext "LAYER")) ;Get the next layer
 )
 (if (= layers "")
   (list (cons 62 color))
   (list '(-4 . "<OR")
         '(-4 . "<AND")
         (cons 8 (substr layers 2))
         '(62 . 256)
         '(-4 . "AND>")
         (cons 62 color)
         '(-4 . "OR>")
   )
 )
)
(setq ss13 (ssget "_x" (ssfilter-by-color 13)))
(setq ss15 (ssget "_x" (ssfilter-by-color 15)))
(setq ss17 (ssget "_x" (ssfilter-by-color 17)))
(setq ss23 (ssget "_x" (ssfilter-by-color 23)))
(setq ss24 (ssget "_x" (ssfilter-by-color 24)))
(setq ss26 (ssget "_x" (ssfilter-by-color 26)))
(command "_draworder" ss17 "" "_back")
(command "_draworder" ss15 "" "_back")
(command "_draworder" ss13 "" "_back")
(command "_draworder" ss23 "" "_back")
(command "_draworder" ss24 "" "_back")
(command "_draworder" ss26 "" "_back")
(princ))

Link to comment
Share on other sites

  • Replies 31
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    10

  • Pukenzz

    8

  • jweber

    7

  • tive29

    3

Do you require objects with the various colours (13, 15, 17 etc.) to be sent to the back in a specific order (as per your current code), or simply that all such objects should display below other objects in the drawing?

Link to comment
Share on other sites

I think I lean would more towards something like this :

 

[b][color=BLACK]([/color][/b]defun c:db-s2b [b][color=FUCHSIA]([/color][/b]/ cl td c l str ss[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq td [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"LAYER"[/color] [b][color=GREEN]([/color][/b]not td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq c [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 62 td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              l [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 2 td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]assoc c cl[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq cl [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons c [b][color=RED]([/color][/b]strcat [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc c cl[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [color=#2f4f4f]","[/color] l[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                            [b][color=BLUE]([/color][/b]assoc c cl[b][color=BLUE])[/color][/b] cl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq cl [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]cons c l[b][color=BLUE])[/color][/b] cl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]foreach v '[b][color=NAVY]([/color][/b]13 15 17 23 24 26[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq str [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc v cl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 8 str[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.DRAWORDER"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_Back"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

You only have to step thru the layer table once.

 

-David

Link to comment
Share on other sites

Alternatively, if the order of the layers sent to the back is irrelevant:

(defun c:s2b-lm ( / sel )
   (if (setq sel (ssget "_X" (getfilter '(13 15 17 23 24 26))))
       (command "_.draworder" sel "" "_b")
   )
   (princ)
)
(defun getfilter ( lst / def rtn )
   (while (setq def (tblnext "layer" (not def)))
       (if (member (abs (cdr (assoc 62 def))) lst)
           (setq rtn (vl-list* "," (cdr (assoc 2 def)) rtn))
       )
   )
   (append
      '((-4 . "<OR"))
       (mapcar '(lambda ( x ) (cons 62 x)) lst)
       (if rtn
           (append
              '((-4 . "<AND"))
               (list (cons 8 (apply 'strcat (cdr rtn))) '(62 . 256))
              '((-4 . "AND>"))
           )
       )
      '((-4 . "OR>"))
   )
)

The above is untested.

Link to comment
Share on other sites

Thanks so much for the help, both of the above codes work and are SOOO much cleaner and faster!! I do like that David's code sends the colors to back in a specific order, as it can put dark shaded lines on top of light shaded lines for example.

 

I'm still not sure how you would get this to work within all blocks a drawing, the closest example of something similar was in a post that was sending "wipeout" to back within blocks. Could this code from Lee Mac be modified to send specific colors to back as well? I've tried but cant seem to get it to work. If it makes any difference, the only color I need to send to back is 15 within blocks, and its not BYLAYER, its (cons 62. 15) (?? I think). Thanks again, I've been fumbling through this for over a week now with not much success.

 

>>>>>code that sends WIPEOUT to back within ALL blocks in a drawing-

(defun c:test ( / acdoc )
;; Lee Mac 20.06.11
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))

(vlax-for block (vla-get-blocks acdoc)
(if
(and
(eq :vlax-false (vla-get-islayout block))
(eq :vlax-false (vla-get-isxref block))
)
(
(lambda ( / lst )
(vlax-for obj block
(if (eq "AcDbWipeout" (vla-get-objectname obj))
(setq lst (cons obj lst))
)
)
(if lst
(vla-movetobottom (LM:SortentsTable block)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst
)
)
)
)
)
)
)
)
(vla-regen acdoc acallviewports)
(princ)
)

(defun LM:SortentsTable ( space / dict result ) 
(cond
(
(not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply 'vla-item
(list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS")
)
)
)
)
result
)
( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") )
)
)
(vl-load-com) (princ)

Link to comment
Share on other sites

Any takers? I'd really like to be able to send all entities with color 15 to back. I've attached two images expressing why this is an issue. Multiply this over 20 or 30 separate block names and up to 20 drawings.... Any help would be really appreciated!

 

shadeover.jpg

shade_under.jpg

Link to comment
Share on other sites

I don't know enough about dictionaries to fill a thimble.

 

I would guess could collect all of the enames and add/modify/manipulate the dictionary definition. -David

Link to comment
Share on other sites

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* col doc lac lck )

   (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 (= :vlax-false (vla-get-isxref 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
                       (vlax-invoke
                           (vla-addobject
                               (vla-getextensiondictionary blk)
                               "acad_sortents"
                               "acdbsortentstable"
                           )
                           'movetobottom lst
                       )
                   )
               )
           )
       )
   )
   (foreach lay lck (vla-put-lock lay :vlax-true))
   (vla-regen doc acallviewports)
   (princ)
)
(vl-load-com) (princ)
 
Edited by Lee Mac
Link to comment
Share on other sites

:notworthy: Lee Mac my mind is blown! I've got everyone in our office drooling over this- its been a pet-peeve for years and no ones dared to tackle it. Much appreciation for CADtutor and the brilliant people here willing to help others! Thanks again to Lee Mac and David for your help with this!
Link to comment
Share on other sites

@ Lee:

I have two questions regarding this portion of your code:

(cond
 ((LM:catchapply 'vla-getobject (list exd "acad_sortents")))
 ((LM:catchapply 'vla-addobject (list exd "acad_sortents" "acdbsortentstable")))
)

 

1.

Why do you use this cond statement when vla-addobject can be used even if the acdbsortentstable already exists.

2.

Why do you use LM:catchapply with vla-addobject? IMO it is not necessary.

Link to comment
Share on other sites

  • 6 months later...

I'm not sure if I'm missing something but when I test this it does not send color 15 to the back on items within blocks. jweber, do you have it working withing blocks?

Link to comment
Share on other sites

1. Why do you use this cond statement when vla-addobject can be used even if the acdbsortentstable already exists.

2. Why do you use LM:catchapply with vla-addobject? IMO it is not necessary.

 

Some good points Roy - I have now updated my earlier code, thank you.

 

When originally designing the program, it was more logical to attempt to retrieve the dictionary object prior to attempting adding it, of course without being aware that the ActiveX addobject method behaves in a similar way to the add method when encountered existing objects - however, although more concise, this may introduce an inefficiency in that, per the documentation:

 

If the entry already exists, it is replaced by the new object.
Link to comment
Share on other sites

Yes, Lee Mac's code works perfectly, I just tested his updated version as well. It is my understanding that this is specific to objects that are set to a specific color, say 15, NOT color- By Layer, etc. Following this, I'm not sure where or why the Lisp isn't working for you, but again, it does work as requested.

Link to comment
Share on other sites

Well crap. Nope mine isn't working. Standard linework, text, etc all does it correctly. But if it is a block, the draw order doesn't change. Continuing to test....

Link to comment
Share on other sites

Here is the sample drawing I'm testing with.

 

I think you are misunderstanding this lisp's function. A block is a single entity, everything within said block is either above or below other objects. You can't have some lines within a block below another entity, with some lines within the same block above that same entity. That said, the way this lisp functions is to send all objects with color 15 to back.

 

In your example, open your "block" and send the text to back, so it is not seen. Save the block, close the block, and then run the lisp. It effectively brings the text to the front by sending the hatch (color 15) to back.

 

I think you need to look back at the beginning of this thread to do what you need...

Link to comment
Share on other sites

Yes, Lee Mac's code works perfectly, I just tested his updated version as well.

 

Thank you for your time testing the program, it is appreciated.

 

It is my understanding that this is specific to objects that are set to a specific color, say 15, NOT color- By Layer, etc.

 

For completeness, the program should operate on all objects exhibiting a 'display' colour equal to that specified; by 'display colour', I am referring to objects for which either the colour property is set to the given colour, or whose colour property is set to ByLayer and the corresponding layer colour is set to the given colour.

 

Lee

Link to comment
Share on other sites

OK so I'm not trying to keep asking the question different ways till I get the answer I want. I am honestly testing and trying to understand and trouble shoot. I am fine with a block being all or none in the display order.

 

See attached pdf. 1st page represents what i could potentially run into in a drawing, meaning no idea of the status or state of any draw order is when I get into an existing drawing. I did intentionally make sure that the 14 vertical lines were in the back just so I could be sure that color 15 was behaving as intended. 2nd page represents sending all horizontal lines to back manually. As you can see they plot behind the vertical lines. 3rd page represents "resetting" by putting the 14 vertical lines to back and running the lisp. That lisp seems to put the grouping of lines that is not a block to the back but leaving the grouping that is a block where it was. Lee Mac & Jweber I read what you guys are saying and I'm just not getting it. Do you have a sample you can upload that I can test to see if I'm getting same results as you?

Test Results.pdf

Link to comment
Share on other sites

For completeness, the program should operate on all objects exhibiting a 'display' colour equal to that specified; by 'display colour', I am referring to objects for which either the colour property is set to the given colour, or whose colour property is set to ByLayer and the corresponding layer colour is set to the given colour.

 

Thanks Lee for the correction- that's how the lisp should work, and actually how I use it, but in trying to troubleshoot Pukenzz's issue I made a mistake. Thanks again for the code :D

 

@ Pukenzz

I think I finally understand your issue. Lee's code ONLY affects the entities WITHIN each and every block within a drawing. You are trying to send SPECIFIC BLOCKS TO BACK using his code, which is not what it is meant to do.

 

I opened your previous file, copied your "block" so I had 3 copies, left the original block alone, set the second block to a new layer that had its layer color set to 15 and I set the 3rd block to color 15, regardless of layer. THAT DONE- both Lee's code for blocks, and David's code sent BOTH color 15 blocks to back, as you need. Again, Lee's code works for entities WITHIN blocks, you are looking to affect ALL entities within a drawing, as they relate to color 15- so your BLOCK needs to be represented as color 15.

 

Hopefully this makes sense, I'm glad to help, the knowledge and help I've gained from this site will never be fully repaid- so I'm glad I get the chance to help others.

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