Jump to content

Layer = Colour dynamic nested blocks and others


Recommended Posts

(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

Link to post
Share on other sites

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 by Sambuddy
Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...