Nested layer located in which block

Hello anyone;

A cad file with many blocks........

Need Lisp to find the Nested Layer located in which block name?

thanks

Siva

Nested layer ? Am I missing something?

Hi,

Try this program:

(defun c:Test  (/ s x n e)
 ;;	Tharwat. 1.May.2016	;;
 (if (and (setq s (car (entsel "\nSelect a block :")))
          (= (cdr (assoc 0 (entget s))) "INSERT")
          )
   (progn
     (setq x (tblobjname "BLOCK" (if (wcmatch (setq n (cdr (assoc 2 (entget s)))) "`*U*")
                                   (vla-get-effectivename (vlax-ename->vla-object s))
                                   n)
              )
           )
     (while (setq x (entnext x))
       (if (= (cdr (assoc 0 (setq e (entget x)))) "INSERT")
         (princ (strcat "\nBlock name found <" (if (wcmatch (setq n (cdr (assoc 2 e))) "`*U*")
                                                 (vla-get-effectivename (vlax-ename->vla-object x))
                                                 n)
                        "> resides on Layer name <" (cdr (assoc 8 e)) ">"))
         )
       )
     )
   (princ "\nFailed it is not a block !")
   )
 (princ)
 )(vl-load-com)

Hi,

 

Try this program:

 

(defun c:Test  (/ s x n e)
 ;;	Tharwat. 1.May.2016	;;
 (if (and (setq s (car (entsel "\nSelect a block :")))
          (= (cdr (assoc 0 (entget s))) "INSERT")
          )
   (progn
     (setq x (tblobjname "BLOCK" (if (wcmatch (setq n (cdr (assoc 2 (entget s)))) "`*U*")
                                   (vla-get-effectivename (vlax-ename->vla-object s))
                                   n)
              )
           )
     (while (setq x (entnext x))
       (if (= (cdr (assoc 0 (setq e (entget x)))) "INSERT")
         (princ (strcat "\nBlock name found <" (if (wcmatch (setq n (cdr (assoc 2 e))) "`*U*")
                                                 (vla-get-effectivename (vlax-ename->vla-object x))
                                                 n)
                        "> resides on Layer name <" (cdr (assoc 8 e)) ">"))
         )
       )
     )
   (princ "\nFailed it is not a block !")
   )
 (princ)
 )(vl-load-com)

Sorry! Much more busy

tomorrow i will try

Sorry! Much more busy

tomorrow i will try

Okay, let's see.

I would suggest something like this :

(defun c:NestedLayer ( / checkinsert lay ss i e l pn ll s x y )

 (vl-load-com)

 (defun checkinsert ( e / obj n )
   (setq obj (tblobjname "BLOCK" (setq n (if (wcmatch (setq n (cdr (assoc 2 (entget e)))) "`*U") (vla-get-effectivename (vlax-ename->vla-object e)) n))))
   (setq e obj)
   (while (setq e (entnext e))
     (cond
       ( (and (= (cdr (assoc 8 (entget e))) lay) (/= (cdr (assoc 0 (entget e))) "INSERT"))
         (setq l (cons (list n e) l))
       )
       ( (and (= (cdr (assoc 8 (entget e))) lay) (= (cdr (assoc 0 (entget e))) "INSERT"))
         (setq l (cons (list n e) l))
         (checkinsert e)
       )
       ( (and (/= (cdr (assoc 8 (entget e))) lay) (= (cdr (assoc 0 (entget e))) "INSERT"))
         (checkinsert e)
       )
     )
   )
 )

 (if (null dos_proplist)
   (setq lay (getstring t "\nSpecify Layer name for which to do inspection : "))
   (setq lay (dos_listbox "LAYERS" "Choose Layer to inspect" (ai_table "LAYER" 4)))
 )
 (setq ss (ssget "_X"))
 (repeat (setq i (sslength ss))
   (setq e (ssname ss (setq i (1- i))))
   (cond
     ( (and (= (cdr (assoc 8 (entget e))) lay) (/= (cdr (assoc 0 (entget e))) "INSERT"))
       (setq l (cons e l))
     )
     ( (and (= (cdr (assoc 8 (entget e))) lay) (= (cdr (assoc 0 (entget e))) "INSERT"))
       (setq l (cons e l))
       (checkinsert e)
     )
     ( (and (/= (cdr (assoc 8 (entget e))) lay) (= (cdr (assoc 0 (entget e))) "INSERT"))
       (checkinsert e)
     )
   )
 )
 (foreach d l
   (if (= (type d) 'LIST)
     (progn
       (setq pn (car d))
       (setq ll (cons d ll))
       (while (and (cdr (assoc 331 (reverse (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" pn)))))))) (setq pn (cdr (assoc 2 (entget (cdr (assoc 330 (entget (cdr (assoc 331 (reverse (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" pn))))))))))))))))
         (if (not (wcmatch pn "*Model*,*Paper*"))
           (setq ll (list (append (list pn) ll)))
         )
       )
     )
     (setq ll (cons d ll))
   )
 )
 (alert (vl-prin1-to-string ll))
 (prin1 l)
 (setq s (ssadd))
 (foreach x ll
   (if (= (type x) 'LIST)
     (while (and (= (type x) 'LIST) (setq y (car x)))
       (setq s (acet-ss-union (list (ssget "_X" (list '(0 . "INSERT") (cons 2 y))) s)))
       (setq x (cadr x))
     )
     (ssadd x s)
   )
 )
 (sssetfirst nil s)
 (princ)
)

Okay, let's see.

Thanks very much for your quick response.

I have tested in one drawing, it's looks like finding the nested blocks details with there layer names within the block

What I am looking for is we got some layers cleanup works for some clients

Tools - Quick Select - Object type (Multiple) - Properties (Layer) - click (ok)

0 item(s) selected.

but when I try Purge it is not purging

So the layer is in use, It is inside some of the blocks, if a drawing has many blocks

I have to open each block one by one & check where the layer is located

***Program should find the specify layer is located in which block name***

thanks

Siva

Thanks very much for your quick response.

 

I have tested in one drawing, it's looks like finding the nested blocks details with there layer names within the block

 

What I am looking for is we got some layers cleanup works for some clients

Tools - Quick Select - Object type (Multiple) - Properties (Layer) - click (ok)

0 item(s) selected.

but when I try Purge it is not purging

So the layer is in use, It is inside some of the blocks, if a drawing has many blocks

I have to open each block one by one & check where the layer is located

 

***Program should find the specify layer is located in which block name***

 

thanks

Siva

Siva, that's why I wrote my version... You can check it...

HTH, M.R.

A lesson taken not to post codes anymore unless the needs of the program is VERY VERY clear.