changing properties of objects within a block

[K Baden]

Good morning! 

 

I have this LISP routine that alllmost does what i need it to do. I'm looking to be able to select multiple blocks and update the color property of the hatch inside to ByBlock and all other entities to ByLayer. 

 

This was fine until i ran into some blocks which have the objects inside on a layer other than 0. I would like to be able to add to this and change everything (hatch and objects) to layer 0 and also make the color changes to the objects. 

 

does anyone have any ideas of how to add this in? 

(vl-load-com)

(defun C:Cta ( / *error* c_doc cme c_blks ss b_name b_lst )

  (defun *error* ( msg )
		(if cme (setvar 'cmdecho cme))
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun
	
	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
				c_blks (vla-get-blocks c_doc)
	);_end_setq

  (cond ( (/= (getvar 'cmdecho) 0) (setq cme (getvar 'cmdecho)) (setvar 'cmdecho 0)))
  
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(vla-startundomark c_doc)

  (setq ss (ssget ":L" '((0 . "INSERT"))))
  
	(vlax-for blk (vla-get-activeselectionset c_doc)
		(setq b_name (vlax-get-property blk (if (vlax-property-available-p blk 'effectivename) 'effectivename 'name)))
    (cond ( (not (vl-position b_name b_lst))
            (vlax-for obj (vla-item c_blks b_name)
              (cond ( (= (vlax-get-property obj 'objectname) "AcDbHatch") (vlax-put-property obj 'color acbyblock))
                    (t (vlax-put-property obj 'color acbylayer))
                   (t (vlax-put-layer obj (list obj "0")))
              );end_cond
            );end_for
            (setq b_lst (cons b_name b_lst))
          )
    );end_cond
    (vla-update blk)        
  );end_for
  
	(vla-regen c_doc acAllViewports)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(if cme (setvar 'cmdecho cme))
  (princ)
);_end_defun

[dlanorh]

Looks like some of my older code.

 

Try this

 

(vl-load-com)

(defun C:Cta ( / *error* c_doc cme c_blks ss b_name b_lst )

  (defun *error* ( msg )
    (if cme (setvar 'cmdecho cme))
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun
	
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
		c_blks (vla-get-blocks c_doc)
  );_end_setq

  (cond ( (/= (getvar 'cmdecho) 0) (setq cme (getvar 'cmdecho)) (setvar 'cmdecho 0)))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (setq ss (ssget ":L" '((0 . "INSERT"))))
  
  (vlax-for blk (vla-get-activeselectionset c_doc)
    (setq b_name (vlax-get-property blk (if (vlax-property-available-p blk 'effectivename) 'effectivename 'name)))
    (cond ( (not (vl-position b_name b_lst))
            (vlax-for obj (vla-item c_blks b_name)
              (if (not (= (vlax-get-property obj 'layer) "0")) (vlax-put-property obj 'layer "0"))
              (cond ( (= (vlax-get-property obj 'objectname) "AcDbHatch") (vlax-put-property obj 'color acbyblock))
                    (t (vlax-put-property obj 'color acbylayer))
              );end_cond
            );end_for
            (setq b_lst (cons b_name b_lst))
          )
    );end_cond
    (vla-update blk)        
  );end_for
  
  (vla-regen c_doc acAllViewports)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (if cme (setvar 'cmdecho cme))
  (princ)
);_end_defun

 

[Tharwat]

Hi,

Try this.

(defun c:Test (/ sel int ent get bkn lst blk)
  ;; Tharwat - 21.Jun.2019	;;
  (and (princ "\nSelect blocks [ all objetcs to '0' layer, Hatches to ByBlock else to BYLayer ] :")
       (setq int -1 sel (ssget "_:L" '((0 . "INSERT"))))
       (while (setq int (1+ int)
                    ent (ssname sel int)
                    )
         (or
           (member (setq bkn (cdr (assoc 2 (entget ent)))) lst)
           (and
             (setq lst (cons bkn lst))
             (setq blk (tblobjname "BLOCK" bkn))
             (while (setq blk (entnext blk))
               (entmod
                 (append
                   (entget blk)
                   (list '(8 . "0")
                          (cons 62 (if (= (cdr (assoc 0 (entget blk))) "HATCH") 0 256))
                         )
                   )
                 )
               )
             )
           )
         )
       (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) AcActiveViewport)
       )
  (princ)
  ) (vl-load-com)

 

[K Baden]

11 hours ago, dlanorh said:

Looks like some of my older code.

 

It very well could be! its something my coworker had lying around so im not sure! 

 

This is working great, but doesnt seem to work on dynamic blocks/blocks with any visibility change options. 

 

Is it possible to include these blocks somehow? i know that dynamics don't mesh well with LISP but i figured it was worth asking. 

 

If not, I'll happily just use this on the ones that arent dynamic and itll still help!!

 

Thank you!!

[K Baden]

44 minutes ago, Tharwat said:

Hi,

Try this.

(defun c:Test (/ sel int ent get bkn lst blk)
  ;; Tharwat - 21.Jun.2019	;;
  (and (princ "\nSelect blocks [ all objetcs to '0' layer, Hatches to ByBlock else to BYLayer ] :")
       (setq int -1 sel (ssget "_:L" '((0 . "INSERT"))))
       (while (setq int (1+ int)
                    ent (ssname sel int)
                    )
         (or
           (member (setq bkn (cdr (assoc 2 (entget ent)))) lst)
           (and
             (setq lst (cons bkn lst))
             (setq blk (tblobjname "BLOCK" bkn))
             (while (setq blk (entnext blk))
               (entmod
                 (append
                   (entget blk)
                   (list '(8 . "0")
                          (cons 62 (if (= (cdr (assoc 0 (entget blk))) "HATCH") 0 256))
                         )
                   )
                 )
               )
             )
           )
         )
       (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) AcActiveViewport)
       )
  (princ)
  ) (vl-load-com)

 

 

 

Thank you!! This isn't giving me any error codes but also doesnt seem to be changing the color to ByBlock properly. I tried on both dynamic and not dynamic blocks with no luck. I wish i had an error i could give you!! but it just doesnt seem to be working quite right for me. 

 

Thank you tthough for your reply! i will perhaps do some looking into this myself to maybe see if i can figure out what the issue seems to be. 

[Tharwat]

What sort of blocks you have ?

Can you upload a sample drawing of the same blocks that you did try the codes on?

[K Baden]

28 minutes ago, Tharwat said:

What sort of blocks you have ?

Can you upload a sample drawing of the same blocks that you did try the codes on?

 

I can work on putting together a drawing to provide this weekend. The blocks have multiple visibility and multiple hatches. i have one which your code seems to work on but only on one of the hatches within the block. Perhaps multiple hatches is what might be causing the problem? 

[Tharwat]

5 minutes ago, K Baden said:

 

I can work on putting together a drawing to provide this weekend. The blocks have multiple visibility and multiple hatches. i have one which your code seems to work on but only on one of the hatches within the block. Perhaps multiple hatches is what might be causing the problem? 

It does not matter how many Hatch objects are there in the selected block(s) so all would be considered since the codes cycling through all objects in a block.

[dlanorh]

5 hours ago, K Baden said:

 

It very well could be! its something my coworker had lying around so im not sure! 

 

This is working great, but doesnt seem to work on dynamic blocks/blocks with any visibility change options. 

 

Is it possible to include these blocks somehow? i know that dynamics don't mesh well with LISP but i figured it was worth asking. 

 

If not, I'll happily just use this on the ones that arent dynamic and itll still help!!

 

Thank you!!

 

Having test it, the block definition is changed, but the dynamic block doesn't update unless it is reset, which kind of defeats the object. I shall test if it is possible to collect all the dynamic property values, reset the block then restore the property values

[Tharwat]

@dlanorh

Just replace the vla-get-effectivename function with vla-get-name.

[Lee Mac]

I would suggest the following:

(defun c:blockprops ( / blk def ent enx idx lst sel )
    (if (setq sel (ssget '((0 . "INSERT"))))
        (progn
            (repeat (setq idx (sslength sel))
                (setq idx (1- idx)
                      blk (LM:name->effectivename (cdr (assoc 2 (entget (ssname sel idx)))))
                )
                (or (member blk lst) (setq lst (cons blk lst)))
            )
            (while (setq def (tblnext "block" (not def)))
                (if (member (LM:name->effectivename (setq blk (cdr (assoc 2 def)))) lst)
                    (progn
                        (setq ent (tblobjname "block" blk))
                        (while (setq ent (entnext ent))
                            (entmod
                                (append (entget ent)
                                    (if (= "HATCH" (cdr (assoc 0 enx)))
                                       '((8 . "0") (62 . 000))
                                       '((8 . "0") (62 . 256))
                                    )
                                )
                            )
                        )
                    )
                )
            )
            (command "_.regen")
        )
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("AcDbBlockRepBTag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

(princ)

 

[dlanorh]

17 hours ago, Tharwat said:

@dlanorh

Just replace the vla-get-effectivename function with vla-get-name.

 

[dlanorh]

23 hours ago, K Baden said:

 

It very well could be! its something my coworker had lying around so im not sure! 

 

This is working great, but doesnt seem to work on dynamic blocks/blocks with any visibility change options. 

 

Is it possible to include these blocks somehow? i know that dynamics don't mesh well with LISP but i figured it was worth asking. 

 

If not, I'll happily just use this on the ones that arent dynamic and itll still help!!

 

Thank you!!

 

It's not a problem, it's publically posted code.

 

Thanks to @Tharwat for an easier solution. Try the attached.

cta.lsp

[Lee Mac]

17 hours ago, Tharwat said:

@dlanorh

Just replace the vla-get-effectivename function with vla-get-name.

 

For a dynamic block, note that this will not change the properties for all references of the dynamic block, only those that are selected by the user.

 

Edited June 22, 2019 by Lee Mac

[Tharwat]

11 minutes ago, Lee Mac said:

 

For a dynamic block, note that this will not change the properties for all references of the dynamic block, only those that are selected by the user.

 

Correct.

[Lee Mac]

21 minutes ago, Tharwat said:

Correct.

 

But that is not desirable behaviour: when modifying the content of a block definition, the changes should be reflected in all references of the block definition, else the drawing will be inconsistent.

[Tharwat]

Yes I do agree with you unless the user selects one of the dynamic blocks that inserted without any changes in any of its contents' parameters and that's why you did jump to block table contents and this makes sense now.

[dlanorh]

@K BadenTaking in everything above, the attached will give you the option of changing all the dynamic blocks based on a selected definition or just sticking with those you selected.

cta2.lsp

[K Baden]

Wow guys. this is awesome and works perfectly. Thank you all so much for your help and insights!!!! i really appreciate this site/forum above any others. ya'll are great. thanks again!!!

[vuxvix]

Hi! @ Lee Mac @ dlanorh

i am looking for a solution for changing the color of the objects in the block. I have tried both lisp (CTA, Blockprops). Both lisp do not change color : By layer to by block. I put up an example of the blocks I'm working on. Looking forward to help, Thanks

Blocknotworking.dwg

Edited December 24, 2021 by vuxvix