block color

hi guys,

need your help again. I have a block and I need to change all the entities inside the block by layer and or by specific color. I was thinking of "nentselp" but that will just just give me one entity to be selected. My problem is how can I put all the entities inside of a block to a selection set so I can process them. I don't need a complete code just the selection part is enough help for me. Thank you.

hi guys,

 

I have a block and I need to change all the entities inside the block by layer and or by specific color. I was thinking of "nentselp" but that will just just give me one entity to be selected. My problem is how can I put all the entities inside of a block to a selection set so I can process them. I don't need a complete code just the selection part is enough help for me. Thank you.

What you describing is more like re-defining the block.

You realize when you do that it affetcts all the block of the same name.

Is that what you want to accomplish?

How you intend to make distinction between ByLayer, respectively directly attached color entities?

It is about only one block? Hope you are aware that there are the built-in commands REFEDIT and BEDIT.

setbylayer

Yes, redefining the block, that's my goal.

What you describing is more like re-defining the block.

You realize when you do that it affetcts all the block of the same name.

Is that what you want to accomplish?

That's what I'm doing as of the moment. Using bedit on every block on drawing to change the color of the entites inside of a block. I need to put all the furniture, fixture, casework on our company standards (colors).

How you intend to make distinction between ByLayer, respectively directly attached color entities?

It is about only one block? Hope you are aware that there are the built-in commands REFEDIT and BEDIT.

My version to change to any color Blocks and entities as well ....

(defun c:Test (/ color ss i sn obj lst name)
 (vl-load-com)
 ;;; Tharwat 01. July. 2012  ;;;
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (if (eq (cdr (assoc 0 (entget sn))) "INSERT")
         (vlax-for block (setq
                           blk (vla-item
                                 (vla-get-blocks acdoc)
                                 (setq name (vla-get-EffectiveName obj))
                               )
                         )
           (if (and (eq :vlax-false (vla-get-isXref blk))
                    (if (not (member name lst))
                      (setq lst (cons name lst))
                    )
               )
             (vlax-for x blk
               (if
                 (not (eq "AcDbBlockReference" (vla-get-objectname x)))
                  (vla-put-color x color)
               )
             )
           )
         )
         (vla-put-color obj color)
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

@tharwat

Throw-in attsync in there for blocks with attributes.

@ LISP2LEARN

Is that what you're wanting to do? [tharwats code]

Yes.

@ LISP2LEARN

Is that what you're wanting to do? [tharwats code]

Tharwat and pBe, thank you very much. Exactly what I'm looking for. Tharwat, you just save me hours of work. Thank you again, don't know how to express my gratitude for your help guys here in cadtutor.

@tharwat

Throw-in attsync in there for blocks with attributes.

Good point pBe .

 

Tharwat and pBe, thank you very much. Exactly what I'm looking for. Tharwat, you just save me hours of work. Thank you again, don't know how to express my gratitude for your help guys here in cadtutor.

You're welcome .

Here is another one to include the attributed blocks as pBe pointed that out .

(defun c:test (/ attribute b blk color i lst name obj sn ss)
;;;;;            Tharwat 01. June. 2012                 ;;;;;
;;;;;              This peice of code to change all           ;;;;;
;;;;;  selected objects (Blocks / Attribted Block / Objects)   ;;;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (cond
         ((eq (cdr (assoc 66 (entget sn))) 1)
          (progn
            (vlax-for block (setq b (vla-item (vla-get-blocks acdoc)
                                              (cdr (assoc 2 (entget sn)))
                                    )
                            )
              (vlax-for x b (vla-put-color x color))
            )
            (foreach attribute (vlax-invoke obj 'Getattributes)
              (vla-put-color attribute color)
            )
          )
         )
         ((and (eq (cdr (assoc 0 (entget sn))) "INSERT")
               (not (member (cdr (assoc 2 (entget sn))) lst))
          )
          (progn
            (setq lst (cons (cdr (assoc 2 (entget sn))) lst))
            (vlax-for block
                      (setq blk (vla-item (vla-get-blocks acdoc)
                                          (cdr (assoc 2 (entget sn)))
                                )
                      )
              (if (eq :vlax-false (vla-get-isXref blk))
                (vlax-for x blk
                  (if
                    (not
                      (eq "AcDbBlockReference" (vla-get-objectname x))
                    )
                     (vla-put-color x color)
                  )
                )
              )
            )
          )
         )
         (t (vla-put-color obj color))
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

Good point pBe .

 

 

 

You're welcome .

 

Here is another one to include the attributed blocks as pBe pointed that out .

 

(defun c:test (/ attribute b blk color i lst name obj sn ss)
;;;;;            Tharwat 01. June. 2012                 ;;;;;
;;;;;              This peice of code to change all           ;;;;;
;;;;;  selected objects (Blocks / Attribted Block / Objects)   ;;;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (cond
         ((eq (cdr (assoc 66 (entget sn))) 1)
          (progn
            (vlax-for block (setq b (vla-item (vla-get-blocks acdoc)
                                              (cdr (assoc 2 (entget sn)))
                                    )
                            )
              (vlax-for x b (vla-put-color x color))
            )
            (foreach attribute (vlax-invoke obj 'Getattributes)
              (vla-put-color attribute color)
            )
          )
         )
         ((and (eq (cdr (assoc 0 (entget sn))) "INSERT")
               (not (member (cdr (assoc 2 (entget sn))) lst))
          )
          (progn
            (setq lst (cons (cdr (assoc 2 (entget sn))) lst))
            (vlax-for block
                      (setq blk (vla-item (vla-get-blocks acdoc)
                                          (cdr (assoc 2 (entget sn)))
                                )
                      )
              (if (eq :vlax-false (vla-get-isXref blk))
                (vlax-for x blk
                  (if
                    (not
                      (eq "AcDbBlockReference" (vla-get-objectname x))
                    )
                     (vla-put-color x color)
                  )
                )
              )
            )
          )
         )
         (t (vla-put-color obj color))
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

If there are more than one block having the same tags, this program will only change the color of the attributes in the picked block. Where using "attsync" will change the attribute colors of all similar blocks.

If there are more than one block having the same tags, this program will only change the color of the attributes in the picked block. Where using "attsync" will change the attribute colors of all similar blocks.

My mistake , I did not test the code firstly .

Check this out .......

(defun c:test (/ attribute b blk color i lst name obj sn ss do)
;;;;;            Tharwat 01. June. 2012                 ;;;;;
;;;;;              This peice of code to change all           ;;;;;
;;;;;  selected objects (Blocks / Attribted Block / Objects)   ;;;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (cond
         ((eq (cdr (assoc 66 (entget sn))) 1)
          (progn
            (setq do t)
            (vlax-for block (setq b (vla-item (vla-get-blocks acdoc)
                                              (cdr (assoc 2 (entget sn)))
                                    )
                            )
              (vlax-for x b (vla-put-color x color))
            )
            (foreach attribute (vlax-invoke obj 'Getattributes)
              (vla-put-color attribute color)
            )
          )
         )
         ((and (eq (cdr (assoc 0 (entget sn))) "INSERT")
               (not (member (cdr (assoc 2 (entget sn))) lst))
          )
          (progn
            (setq lst (cons (cdr (assoc 2 (entget sn))) lst))
            (vlax-for block
                      (setq blk (vla-item (vla-get-blocks acdoc)
                                          (cdr (assoc 2 (entget sn)))
                                )
                      )
              (if (eq :vlax-false (vla-get-isXref blk))
                (vlax-for x blk
                  (if
                    (not
                      (eq "AcDbBlockReference" (vla-get-objectname x))
                    )
                     (vla-put-color x color)
                  )
                )
              )
            )
          )
         )
         (t (vla-put-color obj color))
       )
     )
     (if do
       (vl-cmdf "_.attsync"
                "_name"
                (cdr (assoc 2 (entget sn)))
                ""
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

@Tharwat... it is fine now... thank you

S

@Tharwat... it is fine now... thank you

S

Thank you Steve

I have a few comments & warnings about your code Tharwat, take from them what you will:

1)

        (cond
         ((eq (cdr (assoc 66 (entget sn))) 1)

What if the user selects a 3D Polyline?

2)

            (vlax-for block (setq b (vla-item (vla-get-blocks acdoc)
                                              (cdr (assoc 2 (entget sn)))
                                    )
                            )
              (vlax-for x b (vla-put-color x color))
            )

            ...

            (vlax-for block
                      (setq blk (vla-item (vla-get-blocks acdoc)
                                          (cdr (assoc 2 (entget sn)))
                                )
                      )
              (if (eq :vlax-false (vla-get-isXref blk))
                (vlax-for x blk
                  (if
                    (not
                      (eq "AcDbBlockReference" (vla-get-objectname x))
                    )
                     (vla-put-color x color)
                  )
                )
              )
            )

I am particularly concerned by these two sections of your program.

Since, for every distinct non-attributed block or attributed block selected, you are first retrieving the Document Blocks Collection, but far more worringly, you are iterating over every object contained in the block definition repeatedly, a number of times equal to the number of objects in the block.

This is what your code is currently doing:

For each block selected
   For each object within the block definition
       For each object within the block definition
           Change the object colour

Hence, if a block contains 100 objects (not uncommon, if anything this may be a low estimate), the code will iterate over 10,000 objects as every object is processed 100 times...!!!

3)

            (vl-cmdf "_.attsync"
                     "_name"
                     (cdr (assoc 2 (entget sn)))
                     ""
            )

Since the AttSync operation updates the Block References to reflect any changes made to the Attributes within the Block Definition, this procedure only need be performed once, not for every block reference.

Edit: I see that you have updated your code to resolve this issue since writing this post.

For what it's worth, attached is my take on this task.

The attached program will allow the user to modify the colour property of all objects (residing on unlocked layers) within multiple blocks defined in a drawing.

The program will work with standard, attributed and dynamic blocks.

Lee

BlockColorV1-0.lsp

Thanks Lee, this works great. Tharwat's code and your's yielded the same result but will be use on different scenario's. Both of your code will make my life easier. Now I just need to rename it to "BCT" and "BCL" and I'm a happy cadder.

Just notice you named it bcolor_"version 1.0". Does that mean that you will later improve this code and add this to your programs (web site)? If it so, is it possible to add a preview of the last block selected. I don't need it but it would probably be cool. Thanks again guys!

For what it's worth, attached is my take on this task.

 

The attached program will allow the user to modify the colour property of all objects (residing on unlocked layers) within multiple blocks defined in a drawing.

 

The program will work with standard, attributed and dynamic blocks.

 

Lee

 

1) What if the user selects a 3D Polyline?

Opps I forgot about the 3dpoly .

I have a few comments & warnings about your code Tharwat, take from them what you will:

 

2) I am particularly concerned by these two sections of your program.

 

Since, for every distinct non-attributed block or attributed block selected, you are first retrieving the Document Blocks Collection, but far more worringly, you are iterating over every object contained in the block definition repeatedly, a number of times equal to the number of objects in the block.

That's correct , it is looping more than it is needed . so I would work on it later on today and would be back to it .

Thanks

I think now it much more efficient ....

(defun c:Test (/ att block blocks color i name s sn)
 (vl-load-com)
;;;;;                   Tharwat 02. June. 2012                        ;;;;;
;;;;;                This peice of code to change all                 ;;;;;
;;;;;  selected objects (Blocks / Attribted Block / Normal Objects)   ;;;;;
 (defun ExploreBlocks (sn / block)
   (if (setq block (tblobjname
                     "BLOCK"
                     (cdr (assoc 2 (entget sn)))
                   )
       )
     (while (setq block (entnext block))
       (if
         (not (eq (cdr (assoc 0 (entget block))) "INSERT"))
          (PaintTheWorld block color)
       )
     )
   )
 )
 (defun PaintTheWorld (ent color)
   (if (cdr (assoc 62 (entget ent)))
     (entmod (subst (cons 62 color)
                    (assoc 62 (entget ent))
                    (entget ent)
             )
     )
     (entmod (append (entget ent) (list (cons 62 color))))
   )
 )
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq s (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength s))
       (setq sn (ssname s (setq i (1- i))))
       (cond
         ((not (eq (cdr (assoc 0 (entget sn))) "INSERT"))
          (PaintTheWorld sn color)
         )
         ((and
            (eq (cdr (assoc 0 (entget sn))) "INSERT")
            (not (member (setq name (cdr (assoc 2 (entget sn)))) blocks)
            )
          )
          (progn
            (setq blocks (cons name blocks))
            (if (eq (cdr (assoc 66 (entget sn))) 1)
              (progn (foreach x (vlax-invoke
                                  (vlax-ename->vla-object sn)
                                  'Getattributes
                                )
                       (vla-put-color x color)
                     )
                     (ExploreBlocks sn)
                     (setq att (cdr (assoc 2 (entget sn))))
              )
              (ExploreBlocks sn)
            )
          )
         )
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (if att
   (vl-cmdf "_.attsync" "_name" att "")
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

A quick look at your code:

Suggest you swap the order. Select object first then prompt for color:

Current code lost the ability to recognize Effective name against anonymous name on selection: