Topic: Delete Objects on Layers from List

[GDF]

Ok, you mapcar foreach wildcard gurus, I have a request.

I would like to take the following code below and modify it to delete layers from a wildcard list
like the following:

(setq layer_name (list "A-DIM*,A-NOT*,A-SYM*"))

Code: [Select]

;;;original code by Fatty

(defun C:DELL  (/ ent acapp acsp adoc allrs layer_name)
  ;;(setq layer_name (getstring t "\n* Enter Layer name to Delete : "))
  ;;(setq ent (entsel) layer_name (cdr (assoc 8 (entget (CAR ent)))))
 
 

 

  (vl-load-com)
  (setq acapp (vlax-get-acad-object)
        adoc  (vla-get-activedocument acapp)
        acsp  (vla-get-block (vla-get-activelayout adoc))
        allrs (vla-get-layers adoc))
  (vlax-for
         lt  (vla-get-layouts adoc)
    (vlax-for
           ob  (vla-get-block lt)
      (if (eq (vla-get-layer ob) layer_name)
        (progn (if (eq (vla-get-freeze (vla-item allrs (vla-get-layer ob))) :vlax-true)
                 (vla-put-freeze (vla-item allrs (vla-get-layer ob)) :vlax-false))
               (if (eq (vla-get-lock (vla-item allrs (vla-get-layer ob))) :vlax-true)
                 (vla-put-lock (vla-item allrs (vla-get-layer ob)) :vlax-false))
               (if (eq (vla-get-layeron (vla-item allrs (vla-get-layer ob))) :vlax-false)
                 (vla-put-layeron (vla-item allrs (vla-get-layer ob)) :vlax-true))
               (vla-delete ob)
               (vlax-release-object ob)))))
  (vla-regen adoc acallviewports)
  (princ))

I'm not lazy, just lisp impaired...

Gary

[T.Willey]

I didn't look at the code, it is easier to write one to suit your needs.

Code: [Select]

(defun DeletObjLays (Doc LayList)

(vlax-for Lo (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block Lo)
  (if (vl-position T (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Layer Obj)) (strcase x))) LayList))
   (vla-Delete Obj)
  )
 )
)
(princ)
)

Called like (for current drawing, not case specific)

Code: [Select]

(DeleteObjLays (vla-get-ActiveDocument (vlax-get-Acad-Object)) '("A-dims*" "a-not*))


EDIT: The formatting fairy strikes again

[GDF]

Tim

Thanks. That was easier than hitting my "easy" button.
Works perfectly

(DeletObjLays (vla-get-ActiveDocument (vlax-get-Acad-Object)) '("A-DIM*" "A-NOT*" "A-SYM*"))

Gary

[T.Willey]

You're welcome. 

[GDF]

Tim

One more request.

In a related routine I want to xplode blocks from a wildcard list
similar to the routine you provided. Can this be done?

Once I have all of the pieces together I will post what I am
doing.

Gary

[T.Willey]

Tim

One more request.

In a related routine I want to xplode blocks from a wildcard list
similar to the routine you provided. Can this be done?

Once I have all of the pieces together I will post what I am
doing.

Gary

It can be unless they are NUS.  Here is what you want.

Code: [Select]

(defun ExplodeBlkList (Doc BlkList / cnt)

(setq cnt 0)
(vlax-for Lo (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block Lo)
  (if
   (and
    (= (vla-get-ObjectName Obj) "AcDbBlockReference")
    (vl-position T (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Name Obj)) (strcase x))) BlkList))
   )
   (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Explode (list Obj)))
    (setq cnt (1+ cnt))
   )
  )
 )
)
(prompt (strcat "\n " (itoa cnt) " were not able to be exploded."))
(princ)
)
Call the same way.  I think it should work, haven't tested it.

[GDF]

Tim

Yes it works. Thanks again.

Here is what I am trying to do. We have a building plan that has multiple unit plan xrefs in it.
We are asked to provide a CAD background files for the client. These files need to be bind
inserted with all unnessary layers deleted. The bind inserted blocks are the "UT*"

This is still a work in progress, no error checking, etc.

Code: [Select]

(defun C:XXX  ()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;by Tim Willey 8/24/06
(defun ReloadBindXrefs (Doc / XrefList LstLen TroubleList)
  (vlax-for
Blk  (vla-get-Blocks Doc)
    (if (= (vla-get-IsXref Blk) :vlax-true)
      (progn
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Reload (list Blk)))
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Detach (list Blk)))
    (setq TroubleList (cons Blk TroubleList))
    (prompt (strcat "\n Detached xref: " (vla-get-Name Blk))))
  (progn (vla-Bind Blk :vlax-true)
(if (and (= (vla-get-IsXref Blk) :vlax-true)
  (not (vl-position (vla-get-Name Blk) XrefList)))
   (setq XrefList (cons Blk XrefList))))))))
  (setq LstLen (length XrefList))
  (while (and (> LstLen 0) (> LstLen (setq LstLen (length XrefList))))
    (foreach
   Blk XrefList
      (if (or (= (vla-get-IsXref Blk) :vlax-false)
      (and (vla-Bind Blk :vlax-true) (= (vla-get-IsXref Blk) :vlax-true)))
(setq XrefList (vl-remove Blk XrefList)))))
  (foreach
Blk  (append XrefList TroubleList)
    (prompt (strcat "\n Unable to bind xref: " (vla-get-Name Blk))))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;by Tim Willey 8/28/06
  (defun DeletObjLays  (Doc LayList)
    (vlax-for
   Lo  (vla-get-Layouts Doc)
      (vlax-for
     Obj  (vla-get-Block Lo)
(if
  (vl-position
    T
    (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Layer Obj)) (strcase x)))
    LayList))
   (vla-Delete Obj))))
    (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;by Tim Willey 8/28/06
(defun ExplodeBlkList  (Doc BlkList / cnt)
  (setq cnt 0)
  (vlax-for
Lo  (vla-get-Layouts Doc)
    (vlax-for
   Obj (vla-get-Block Lo)
      (if
(and (= (vla-get-ObjectName Obj) "AcDbBlockReference")
     (vl-position
       T
       (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Name Obj)) (strcase x)))
       BlkList)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Explode (list Obj)))
   (setq cnt (1+ cnt)))))
    (prompt (strcat "\n " (itoa cnt) " were not able to be exploded."))
    (princ)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (ReloadBindXrefs (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (ExplodeBlkList
  (vla-get-ActiveDocument (vlax-get-Acad-Object))
  '("UT*"))
  (DeletObjLays
    (vla-get-ActiveDocument (vlax-get-Acad-Object))
    '("*A-ARE*" "*A-DIM*" "*A-NOT*" "*A-PAT*" "*A-SYM*"))
  (princ))
(princ)

Gary

[T.Willey]

All of those can be called with an ObjectDBX document if you want Gary.  Hope they all work the way you want them to.

Edit:  If speed is an issue, I would combind the two I just gave you, as they both step through each object in each space.  Might as well only do that once, instead of two seprate times.

[GDF]

Tim

Yes, that will be my next stage. I can handle that one, will post when it is ready.

I just noticed that when I have multiple xrefed unit plans that have been bound
within the building plan do not all get exploded when the have the same name.

For example the building plan has within it: first, second and third floors (not on top of
each other of course, but located within the same file "x" distance away)

All of these bound unit plans need to be exploded so that all of the wildcard layers
can be removed.

Gary

Gary

[T.Willey]

That problem is because of nesting.  I think I can come up with a way to do that.  Give me a minute.

[CAB]

For those who don't mind using a command.


(del_on_layer "A-DIM*,A-NOT*,A-SYM*")

  ;;  layers is a string containing layers
  ;;  ignores case & excepts wild cards
 
This honers locked layers but not frozen layers.
 

Code: [Select]

(defun del_on_layer (layers / ss)
  (if (setq ss (ssget "_X" (list (cons 8 layers))))
    (vl-cmdf "_.erase" ss "")
  )
)
This one honers locked & frozen layers

Code: [Select]

(defun del_on_layer (layers / ss)
  (if (setq ss (ssget "_all" (list (cons 8 layers))))
    (vl-cmdf "_.erase" ss "")
  )
)

[T.Willey]

Here you go Gary.  I combined them both.  Now it will check for nested blocks also.  I'm not sure about Locked layers (good point Alan) and this routine, if it is a problem, then it can be fixed easily.

Code: [Select]

(defun DeletLays_ExplodeBlk (Doc LayList BlkList / cnt)


(defun ExplodeList (ObjList BlkList / NewObjList)

(mapcar
 '(lambda (x)
  (if
   (and
    (= (vla-get-ObjectName x) "AcDbBlockReference")
    (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList))
   )
   (if
     (vl-catch-all-error-p
      (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode")))
     )
    )
    (setq cnt (1+ cnt))
    (ExPlodeList NewObjList BlkList)
   )
  )
 )
)
(princ)
)
;------------------------------------------------------------------------------
(setq cnt 0)
(vlax-for Lo (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block Lo)
  (cond
   ((vl-position T (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Layer Obj)) (strcase x))) LayList))
    (vla-Delete Obj)
   )
   ((and
     (= (vla-get-ObjectName x) "AcDbBlockReference")
     (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList))
    )
    (if
     (vl-catch-all-error-p
      (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode")))
     )
     (setq cnt (1+ cnt))
     (ExPlodeList NewObjList BlkList)
    )
   )   
  )
 )
)
(princ)
)


[GDF]

Tim

I get an unbalanced closing bracket.

And this gives me a syntax error

Code: [Select]


(defun DeletLays_ExplodeBlk  (Doc LayList BlkList / cnt)
  (defun ExplodeList  (ObjList BlkList / NewObjList)
    (mapcar
      '(lambda (x)
(if (and (= (vla-get-ObjectName x) "AcDbBlockReference")
  (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList)))
   (if
     (vl-catch-all-error-p
       (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode")))))
   (setq cnt (1+ cnt))
   (ExPlodeList NewObjList BlkList))))) ;(princ))
    ;------------------------------------------------------------------------------
  (setq cnt 0)
  (vlax-for
Lo  (vla-get-Layouts Doc)
    (vlax-for
   Obj (vla-get-Block Lo)
      (cond
((vl-position
   T
   (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Layer Obj)) (strcase x)))
   LayList))
(vla-Delete Obj))
((and (= (vla-get-ObjectName x) "AcDbBlockReference")
      (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList)))
(if (vl-catch-all-error-p
       (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode"))))
   (setq cnt (1+ cnt))
   (ExPlodeList NewObjList BlkList))))))
  (princ))
Gary

[GDF]

Alan

(del_on_layer "A-DIM*,A-NOT*,A-SYM*")

  ;;  layers is a string containing layers
  ;;  ignores case & excepts wild cards
 

This one honers locked & frozen layers

Code: [Select]

(defun del_on_layer (layers / ss)
  (if (setq ss (ssget "_all" (list (cons 8 layers))))
    (vl-cmdf "_.erase" ss "")
  )
)

vla-Thanks, I like it. I may have to use this one.

Gary

[T.Willey]

Sorry about that Gary.  I didn't finish one part of the code.  This should work.

Code: [Select]

(defun DeletLays_ExplodeBlk (Doc LayList BlkList / cnt)


(defun ExplodeList (ObjList BlkList / NewObjList)

(mapcar
 '(lambda (x)
  (if
   (and
    (= (vla-get-ObjectName x) "AcDbBlockReference")
    (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList))
   )
   (if
    (vl-catch-all-error-p
     (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode")))
    )
    (setq cnt (1+ cnt))
    (ExPlodeList NewObjList BlkList)
   )
  )
  ObjList
 )
)
(princ)
)
;------------------------------------------------------------------------------
(setq cnt 0)
(vlax-for Lo (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block Lo)
  (cond
   ((vl-position T (mapcar '(lambda (x) (wcmatch (strcase (vla-get-Layer Obj)) (strcase x))) LayList))
    (vla-Delete Obj)
   )
   ((and
     (= (vla-get-ObjectName x) "AcDbBlockReference")
     (vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList))
    )
    (if
     (vl-catch-all-error-p
      (setq NewObjList (vla-catch-all-apply 'vlax-invoke (list x "Explode")))
     )
     (setq cnt (1+ cnt))
     (ExPlodeList NewObjList BlkList)
    )
   )   
  )
 )
)
(princ)
)