Layer = Colour dynamic nested blocks and others

[Sambuddy]

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


(defun ChangeDynBlockLayer (nme layDef / 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)))))
        ;(vla-put-color obj col)
	(vla-put-layer obj layDef)
      )
    )
  )

  (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:DefC ( / layDef 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 layDef "Defpoints")
    )
    (progn
      (ChangeDynBlockLayer (vla-get-name obj) layDef)
      (vla-regen doc acactiveviewport)
    )
  )
  (vla-endundomark doc)
  (princ)
)

I am having an issue here, hope someone could help:

(ssget '((-4 . "<or") (8 . "Defpoints") (62 . 30) (-4 . "or>") ))

What I am trying to do is this routine to select one or however many objects to then : if any entities in dynamic blocks are in colour 30 to put them under layer "Defpoints" and leave the colour as is (Since Defpoints has a different colour under Layer Properties Manager) so I do not want to make anything ByLayer.

 

In short > Change the layer to "Defpoints" on all entities that are colour 30

I would also appreciate if there is a selection option: either select objects one by one or Window selection.

Also I was not sure how to include simple line, arc, pline, etc... if the objects are not blocks, dynamic or nested blocks  - example once I am inside the block editor or if no block is made and I would like to be able to have the routine does the same!

 

Thanks

[Sambuddy]

I succeeded in accomplishing it with the dynamic blocks, the question is:

How do I make this work for non-block entities:

Thank you

; blkObj = Block definition object.
; Return value: List of block definition objects with the same effective name belonging to the same blocks object or nil (block is not dynamic).
(defun KGA_Block_DynDefinitionList (blkObj / hnd ret)
  (if
    (setq hnd
      (cond
        ((= :vlax-true (vla-get-isdynamicblock blkObj))
          (vla-get-handle blkObj)
        )
        ((wcmatch (vla-get-name blkObj) "`*[Uu]*")
          (cdr (assoc 1005 (cdadr (assoc -3 (entget (vlax-vla-object->ename blkObj)'("AcDbBlockRepBTag"))))))
        )
      )
    )
    (progn
      (vlax-for blkObj (KGA_Sys_ObjectOwner blkObj)
        (cond
          ((= hnd (vla-get-handle blkObj))
            (setq ret (cons blkObj ret))
          )
          (
            (and
              (wcmatch (vla-get-name blkObj) "`*[Uu]*")
              (= hnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (vlax-vla-object->ename blkObj)'("AcDbBlockRepBTag")))))))
            )
            (setq ret (cons blkObj ret))
          )
        )
      )
      (reverse ret)
    )
  )
)

(defun KGA_Conv_Collection_To_List (coll / ret)
  (vl-remove
    nil
    (reverse
      (vlax-for a coll
        (setq ret (cons a ret))
      )
    )
  )
)

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

(defun c:DEFC ( / N_Modify N_Process blk blks blkToDoLst blkDoneLst doc lyrLckLst onm ss)

  (defun N_Modify (obj)
    (setq onm (vla-get-objectname obj))
    (cond
      ((vl-position onm '("AcDb2dPolyline" "AcDbArc" "AcDbCircle" "AcDbLine" "AcDbPolyline" "AcDbText" "AcDbAttributeDefinition"))

        (cond
          ((=  30 (vla-get-color obj)) (vla-put-layer obj "Defpoints")) ; if found change layer
        )
      )
      ((= "AcDbHatch" onm)
        (cond
          ((=  30 (vla-get-color obj)) (vla-put-layer obj "Defpoints"))
        )
      )
      ((vl-position onm '("AcDbBlockReference" "AcDbMInsertBlock"))
        (setq blk (vla-item blks (vla-get-name obj)))
        (foreach blk (cond ((KGA_Block_DynDefinitionList blk)) ((list blk)))
          (if
            (and
              (not (vl-position blk blkDoneLst))
              (not (vl-position blk blkToDoLst))
            )
            (setq blkToDoLst (append blkToDoLst (list blk)))
          )
        )
      )
    )
  )

  (defun N_Process (objLst)
    (setq blks (vla-get-blocks doc))
    (setq lyrLckLst
      (vl-remove-if
        '(lambda (lyr) (= :vlax-false (vla-get-lock lyr)))
        (KGA_Conv_Collection_To_List (vla-get-layers doc))
      )
    )
    (foreach lyr lyrLckLst (vla-put-lock lyr :vlax-false))
    (foreach obj objLst (N_Modify obj))
    (while blkToDoLst
      (if (= :vlax-false (vla-get-isxref (car blkToDoLst)))
        (vlax-for obj (car blkToDoLst)
          (N_Modify obj)
        )
      )
      (setq blkDoneLst (cons (car blkToDoLst) blkDoneLst))
      (setq blkToDoLst (cdr blkToDoLst))
    )
    (foreach lyr lyrLckLst (vla-put-lock lyr :vlax-true))
    (vla-regen doc acactiveviewport)
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (N_Process (KGA_Conv_Pickset_To_ObjectList ss))
  )
  (vla-endundomark doc)
  (princ)
  )

I could use something like this, but now that I am going all VLA stuff, I was hoping someone would be able to help:

(command "_.chprop" (ssget "X" '((0 . "~VIEWPORT") (62 . 30) (-4 . "<OR")  (8 . "Defpoints") (62 . 30) (-4 . "OR>"))) "" "LA" "Defpoints" "")

 

Edited December 9, 2020 by Sambuddy