Change Color of Dynamic Block Sub Entities

April 22, 2019

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

April 22, 2019

Hi,

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

April 22, 2019

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

April 22, 2019

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

April 22, 2019

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

April 22, 2019

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

April 22, 2019

7 minutes ago, dlanorh said:

Try the above

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

April 22, 2019

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

April 23, 2019

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

April 23, 2019

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

April 23, 2019

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

April 23, 2019

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

April 23, 2019

nice one Roy!

Sign In

Change Color of Dynamic Block Sub Entities

Recommended Posts

handasa

Tharwat

handasa

Tharwat

handasa

dlanorh

handasa

dlanorh

Roy_043

handasa

Roy_043

handasa

rlx

Join the conversation

Tutorials

Forums

Activity