Change Color of Dynamic Block Sub Entities

[handasa]

Hello Everyone

i use to this lisp to change color of block's subentities .

(defun colorb (x0 / doc blk)
(setq col (cdr (assoc 62 (acad_truecolordlg 2))))
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (setq blk (vla-item (vla-get-blocks doc) (vla-get-Effectivename x0)))
 (vlax-for x blk
  (if (eq (vla-get-objectname x) "AcDbBlockReference")
   (progn (colorb x)) ; recursion
   (vla-put-color x col)
  )
 )
)

it works well for regular blocks but in case of dynamic blocks the new color won't take effect until i use "bedit" command  like this

(defun update (block)
(setq blockname (LM:al-effectivename block))
(COMMAND "-BEDIT" "" blockname)
(command "zoom" "e")
(COMMAND "_BCLOSE" "SAVE")
)

any ideas to change dynamic block subentities without using the bedit command 

thanks in advance

[Tharwat]

Hi,

Replace the function vla-get-effectivename with vla-get-name and try again.

[handasa]

12 minutes ago, Tharwat said:

Hi,

Replace the function vla-get-effectivename with vla-get-name and try again.

this didn't change the color of the block subentities 

Edited April 22, 2019 by handasa

[Tharwat]

You may need to regen the active space / drawing to see the changes.

[handasa]

Just now, Tharwat said:

You may need to regen the active space / drawing to see the changes.

 

regen didn't work also.the only way to have the changes take effect is to bedit the block and zoom inot it and exit the bedit

[dlanorh]

2 hours ago, handasa said:

(defun update (block / blockname)
(setq blockname (LM:al-effectivename block))
(vl-cmdf "_.attsync" "_N" blockname)
)

 

 

Try the above

Edited April 22, 2019 by dlanorh

[handasa]

7 minutes ago, dlanorh said:

 

Try the above

block doesn't have attribute definitions.so this command gives error _N Unknown command "N" 

[dlanorh]

The only other way i can think of without opening the block editor is to ssget "_X"  the blocks in the drawing, and iterate the pickset filtering blocks with the same effective name into a list.

Then for each block in the list  get ALL the dynamic block properties and values, use the resetblock command and then reinstate the saved dynamic block property values.

 

Example functions to do this can be found HERE

 

This is also worth a  READ

 

[Roy_043]

Strange that a block definition does not have an EffectiveName property.

But with some 'classic' Lisp you can create a workaround.

I also tried to fix some issues with the recursion.

; Blk can be a block name or the ename of a "BLOCK" entity.
(defun KGA_BlockClassic_EffectiveName (blk / elst blkRecHnd)
  (setq elst
    (entget (if (= 'ename (type blk)) blk (tblobjname "block" blk)))
  )
  (if
    (and
      (= "*" (substr (cdr (assoc 2 elst)) 1 1))
      (setq blkRecHnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (cdr (assoc 330 elst)) '("AcDbBlockRepBTag")))))))
    )
    (cdr (assoc 2 (entget (handent blkRecHnd))))
    (cdr (assoc 2 elst))
  )
)

; (colorb (vla-get-name (vlax-ename->vla-object (car (entsel)))) (acad_colordlg 2))
(defun colorb (nme col / N_Mod blks i nmeLst)

  (defun N_Mod (blk)
    (vlax-for obj blk
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (not (vl-position (strcase (vla-get-effectivename obj)) nmeLst))
        )
        (setq nmeLst (append nmeLst (list (strcase (vla-get-effectivename obj))))) ; Append required.
        (vla-put-color obj col)
      )
    )
  )

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq nmeLst (list (strcase (KGA_BlockClassic_EffectiveName nme))))
  (setq i 0)
  (while (< i (length nmeLst))
    (setq nme (nth i nmeLst))
    (vlax-for blk blks
      (if (= nme (strcase (KGA_BlockClassic_EffectiveName (vla-get-name blk))))
        (N_Mod blk)
      )
    )
    (setq i (1+ i))
  )
)

 

Edited April 23, 2019 by Roy_043

[handasa]

54 minutes ago, Roy_043 said:

Strange that a block definition does not have an EffectiveName property.

But with some 'classic' Lisp you can create a workaround.

I also tried to fix some issues with the recursion.

; Blk can be a block name or the ename of a "BLOCK" entity.
(defun KGA_BlockClassic_EffectiveName (blk / elst blkRecHnd)
  (setq elst
    (entget (if (= 'ename (type blk)) blk (tblobjname "block" blk)))
  )
  (if
    (and
      (= "*" (substr (cdr (assoc 2 elst)) 1 1))
      (setq blkRecHnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (cdr (assoc 330 elst)) '("AcDbBlockRepBTag")))))))
    )
    (cdr (assoc 2 (entget (handent blkRecHnd))))
    (cdr (assoc 2 elst))
  )
)

; (colorb (vla-get-name (vlax-ename->vla-object (car (entsel)))))
(defun colorb (nme / N_Mod blks col i nmeLst)

  (defun N_Mod (blk)
    (vlax-for obj blk
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (not (vl-position (strcase (vla-get-effectivename obj)) nmeLst))
        )
        (setq nmeLst (append nmeLst (list (strcase (vla-get-effectivename obj))))) ; Append required.
        (vla-put-color obj col)
      )
    )
  )

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq col (acad_colordlg 2))
  (setq nmeLst (list (strcase (KGA_BlockClassic_EffectiveName nme))))
  (setq i 0)
  (while (< i (length nmeLst))
    (setq nme (nth i nmeLst))
    (vlax-for blk blks
      (if (= nme (strcase (KGA_BlockClassic_EffectiveName (vla-get-name blk))))
        (N_Mod blk)
      )
    )
    (setq i (1+ i))
  )
)

 

 

this is what happen when using the code above

 

[Roy_043]

Seems like a simple regen issue. Notice that the main function is not a command ('C:') function.

I have renamed the main function and added an example of a command function:

; Blk can be a block name or the ename of a "BLOCK" entity.
(defun KGA_BlockClassic_EffectiveName (blk / elst blkRecHnd)
  (setq elst
    (entget (if (= 'ename (type blk)) blk (tblobjname "block" blk)))
  )
  (if
    (and
      (= "*" (substr (cdr (assoc 2 elst)) 1 1))
      (setq blkRecHnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (cdr (assoc 330 elst)) '("AcDbBlockRepBTag")))))))
    )
    (cdr (assoc 2 (entget (handent blkRecHnd))))
    (cdr (assoc 2 elst))
  )
)

; (ChangeDynBlockColor (vla-get-name (vlax-ename->vla-object (car (entsel)))) (acad_colordlg 2))
(defun ChangeDynBlockColor (nme col / N_Mod blks i nmeLst)

  (defun N_Mod (blk)
    (vlax-for obj blk
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (not (vl-position (strcase (vla-get-effectivename obj)) nmeLst))
        )
        (setq nmeLst (append nmeLst (list (strcase (vla-get-effectivename obj))))) ; Append required.
        (vla-put-color obj col)
      )
    )
  )

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq nmeLst (list (strcase (KGA_BlockClassic_EffectiveName nme))))
  (setq i 0)
  (while (< i (length nmeLst))
    (setq nme (nth i nmeLst))
    (vlax-for blk blks
      (if (= nme (strcase (KGA_BlockClassic_EffectiveName (vla-get-name blk))))
        (N_Mod blk)
      )
    )
    (setq i (1+ i))
  )
)

(defun c:Test ( / col doc enm obj)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq enm (car (entsel)))
      (setq obj (vlax-ename->vla-object enm))
      (= "AcDbBlockReference" (vla-get-objectname obj))
      (setq col (acad_colordlg 2))
    )
    (progn
      (ChangeDynBlockColor (vla-get-name obj) col)
      (vla-regen doc acactiveviewport)
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

[handasa]

29 minutes ago, Roy_043 said:

Seems like a simple regen issue. Notice that the main function is not a command ('C:') function.

I have renamed the main function and added an example of a command function:

; Blk can be a block name or the ename of a "BLOCK" entity.
(defun KGA_BlockClassic_EffectiveName (blk / elst blkRecHnd)
  (setq elst
    (entget (if (= 'ename (type blk)) blk (tblobjname "block" blk)))
  )
  (if
    (and
      (= "*" (substr (cdr (assoc 2 elst)) 1 1))
      (setq blkRecHnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (cdr (assoc 330 elst)) '("AcDbBlockRepBTag")))))))
    )
    (cdr (assoc 2 (entget (handent blkRecHnd))))
    (cdr (assoc 2 elst))
  )
)

; (ChangeDynBlockColor (vla-get-name (vlax-ename->vla-object (car (entsel)))) (acad_colordlg 2))
(defun ChangeDynBlockColor (nme col / N_Mod blks i nmeLst)

  (defun N_Mod (blk)
    (vlax-for obj blk
      (if
        (and
          (= "AcDbBlockReference" (vla-get-objectname obj))
          (not (vl-position (strcase (vla-get-effectivename obj)) nmeLst))
        )
        (setq nmeLst (append nmeLst (list (strcase (vla-get-effectivename obj))))) ; Append required.
        (vla-put-color obj col)
      )
    )
  )

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq nmeLst (list (strcase (KGA_BlockClassic_EffectiveName nme))))
  (setq i 0)
  (while (< i (length nmeLst))
    (setq nme (nth i nmeLst))
    (vlax-for blk blks
      (if (= nme (strcase (KGA_BlockClassic_EffectiveName (vla-get-name blk))))
        (N_Mod blk)
      )
    )
    (setq i (1+ i))
  )
)

(defun c:Test ( / col doc enm obj)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq enm (car (entsel)))
      (setq obj (vlax-ename->vla-object enm))
      (= "AcDbBlockReference" (vla-get-objectname obj))
      (setq col (acad_colordlg 2))
    )
    (progn
      (ChangeDynBlockColor (vla-get-name obj) col)
      (vla-regen doc acactiveviewport)
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

this worked fine..thank you very much ,Roy 

[rlx]

nice one Roy!