Author Topic: Delete Objects on Layers from List  (Read 8586 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
Delete Objects on Layers from List
« on: August 28, 2006, 11:21:40 AM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #1 on: August 28, 2006, 11:29:30 AM »
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
« Last Edit: August 28, 2006, 12:19:01 PM by nivuahc »
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #2 on: August 28, 2006, 11:41:25 AM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #3 on: August 28, 2006, 11:47:23 AM »
You're welcome.  :-D
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #4 on: August 28, 2006, 12:11:47 PM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #5 on: August 28, 2006, 12:18:18 PM »
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #6 on: August 28, 2006, 12:36:35 PM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #7 on: August 28, 2006, 12:40:52 PM »
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.
« Last Edit: August 28, 2006, 12:43:09 PM by T.Willey »
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #8 on: August 28, 2006, 12:48:03 PM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #9 on: August 28, 2006, 12:58:47 PM »
That problem is because of nesting.  I think I can come up with a way to do that.  Give me a minute.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Delete Objects on Layers from List
« Reply #10 on: August 28, 2006, 01:01:34 PM »
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 "")
  )
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #11 on: August 28, 2006, 01:14:14 PM »
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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #12 on: August 28, 2006, 02:31:13 PM »
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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #13 on: August 28, 2006, 02:47:48 PM »
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
« Last Edit: August 28, 2006, 02:49:36 PM by Gary Fowler »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #14 on: August 28, 2006, 02:51:36 PM »
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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Delete Objects on Layers from List
« Reply #15 on: August 28, 2006, 02:57:51 PM »
(vlar-yourwelcome Gary)

Not sure if it will work with ObjectDBX though
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #16 on: August 28, 2006, 03:00:19 PM »
(vlar-yourwelcome Gary)

Not sure if it will work with ObjectDBX though
Nope.  You can't use (ssget.... ) with ObjectDBX.  I just code that way most of the time now, no biggie Alan.  If it's only for the current draiwng, no need to.  :wink:
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #17 on: August 28, 2006, 03:30:56 PM »
Tim

Thanks

So is this how I should call it?

(DeletLays_ExplodeBlk
    (vla-get-ActiveDocument (vlax-get-Acad-Object)) '("A-ARE*" "A-DIM*" "A-NOT*" "A-PAT*" "A-SHT*" "A-SYM*") '("UT*"))

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #18 on: August 28, 2006, 03:47:12 PM »
Tim

Thanks

So is this how I should call it?

(DeletLays_ExplodeBlk
    (vla-get-ActiveDocument (vlax-get-Acad-Object)) '("A-ARE*" "A-DIM*" "A-NOT*" "A-PAT*" "A-SHT*" "A-SYM*") '("UT*"))

Gary

For the current draiwng, yes.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #19 on: August 28, 2006, 04:10:28 PM »
Tim

Thanks. I was not sure. I get this error.

Because I can't speak vla I just want to be sure that the code expodes the blocks before deleteing the layers.


Command: (DeletLays_ExplodeBlk
(_>     (vla-get-ActiveDocument (vlax-get-Acad-Object))
(_>     '("A-ARE*" "A-DIM*" "A-NOT*" "A-PAT*" "A-SHT*" "A-SYM*")
(_>     '("UT*"))
; error: bad argument type: VLA-OBJECT nil

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #20 on: August 28, 2006, 04:16:02 PM »
vla-have vla-you vla-check vla-how vla-many vla-arguments vla-the vla-function vla-is vla-required vla-?

vlax-just vlax-guessing

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #21 on: August 28, 2006, 04:25:51 PM »
vla-have vla-you vla-check vla-how vla-many vla-arguments vla-the vla-function vla-is vla-required vla-?

vlax-just vlax-guessing

Luis

vla-this-many -> (defun DeletLays_ExplodeBlk (Doc LayList BlkList / cnt)

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #22 on: August 28, 2006, 04:40:43 PM »
:-D

Have not tested Tim's code.... are you making sure that is possible to explode the block? and is not nested?, it is a valid list of blocks, it is check with vla-item? against vla-get-blocks?.... (again guessing)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Delete Objects on Layers from List
« Reply #23 on: August 28, 2006, 04:53:33 PM »
Oops :oops:
<reply removed.>
« Last Edit: August 28, 2006, 04:54:57 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #24 on: August 28, 2006, 04:55:14 PM »
Code: [Select]
(vl-position (strcase (vla-get-Name x)) (mapcar 'strcase BlkList))

Notice in the above code line, you are passing a wild card name not the valid block name.... and I think in the other calls too.....

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #25 on: August 28, 2006, 04:55:42 PM »
Luis

:-D

Have not tested Tim's code.... are you making sure that is possible to explode the block? and is not nested?, it is a valid list of blocks, it is check with vla-item? against vla-get-blocks?.... (again guessing)

Yes, the unit blocks are have been "bind inserted" from xrefs that can be exploded.
It is not nested. It does however occur multiple times within the building plan.

Example: "building plan" drawing file has the following unit plans that were xrefed, but are now blocks within the drawing:
UTA4  four blocks
UTA5  four blocks
UTA6  two blocks

I hope this is clear. If I understood vlisp better I could read Tim's code

Here is what I am using:

Code: [Select]
;;;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 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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (ReloadBindXrefs (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (DeletLays_ExplodeBlk
    (vla-get-ActiveDocument (vlax-get-Acad-Object))
    '("A-ARE*" "A-DIM*" "A-NOT*" "A-PAT*" "A-SHT*" "A-SYM*")
    '("UT*"))
  (princ))
(princ)

Gary
« Last Edit: August 28, 2006, 04:57:57 PM by Gary Fowler »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #26 on: August 28, 2006, 05:05:03 PM »
Gary;

Test this:

In the block list argument, place the following:

(list "UTA4" "UTA5"  "UTA6") instead of ("UT*")

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #27 on: August 28, 2006, 05:14:17 PM »
Luis

I already tried that. Also the wildcard worked in Tim's eariler example.
However it only exploded one occurance of the block and not all four.

This one works for exploding the block...just not all of the ones with the same name.
Code: [Select]
;;;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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #28 on: August 28, 2006, 05:15:02 PM »
Maybe an old fashion way of using the undocumented QAFLAGS variable = 1 and then to 0 and in between simple call the explode command on your selection set.

(setvar "qaflags" 1)
(command "_.explode" your_selection_set "")
(setvar "qaflags" 0)
« Last Edit: August 28, 2006, 05:44:26 PM by LE »

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #29 on: August 28, 2006, 05:21:03 PM »
And for your selection it can be:

Code: [Select]
(setq ss (ssget (list (cons 8 "A-ARE*,A-DIM*,A-NOT*,A-PAT*,A-SHT*,A-SYM*") (cons 2 "UT*"))))

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #30 on: August 28, 2006, 05:22:42 PM »
I'm looking into this right now.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #31 on: August 28, 2006, 05:37:38 PM »
This works now.  I tested it.  Sorry about that.
Code: [Select]
(defun DeletLays_ExplodeBlk (Doc LayList BlkList / cnt)


(defun ExplodeList (ObjList BlkList / NewObjList)

(foreach Obj ObjList
 (if
  (and
   (= (vla-get-ObjectName Obj) "AcDbBlockReference")
   (vl-position
    T
    (mapcar
     '(lambda (y)
      (wcmatch (strcase (vla-get-Name Obj)) (strcase y))
     )
     BlkList
    )
   )
  )
  (if
   (vl-catch-all-error-p
    (setq NewObjList (vl-catch-all-apply 'vlax-invoke (list Obj "Explode")))
   )
   (setq cnt (1+ cnt))
   (progn
    (vla-Delete Obj)
    (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 Obj) "AcDbBlockReference")
     (vl-position
      T
      (mapcar
       '(lambda (y)
        (wcmatch (strcase (vla-get-Name oBJ)) (strcase y))
       )
       BlkList
      )
     )
    )
    (if
     (vl-catch-all-error-p
      (setq NewObjList (vl-catch-all-apply 'vlax-invoke (list Obj "Explode")))
     )
     (setq cnt (1+ cnt))
     (progn
      (vla-Delete Obj)
      (ExPlodeList NewObjList BlkList)
     )
    )
   )   
  )
 )
)
(princ)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Delete Objects on Layers from List
« Reply #32 on: August 28, 2006, 05:40:45 PM »
Code: [Select]
(defun c:tst  (/ ss)
  (if (setq ss
     (ssget
       (list (cons 8 "A-ARE*,A-DIM*,A-NOT*,A-PAT*,A-SHT*,A-SYM*")
     (cons 2 "UT*"))))
    (progn
      (setvar "qaflags" 1)
      (command "_.explode" ss "")
      (setvar "qaflags" 0))))

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #33 on: August 28, 2006, 05:41:52 PM »
(vlar-yourwelcome Gary)

Not sure if it will work with ObjectDBX though

Alan

I tried this also. Works now with the qaflags (as per Luis suggestion)

Code: [Select]
(defun exp_on_layer (layers / ss)
  (setvar "qaflags" 1)
  (if (setq ss (ssget "_all" (list (cons 8 layers))))
    (vl-cmdf "_.explode" ss "")
  )
  (setvar "qaflags" 0)
)

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

(defun C:TEST ()
  (exp_on_layer "0-XREF")
  (del_on_layer "A-ALT-WIND-2,A-ALT-WIND-3,A-ARE*,A-DIM*,A-NOT*,A-PAT*,A-SYM*,A-SHT*,DEF*,0-XREF,*NOTE")
)

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Delete Objects on Layers from List
« Reply #34 on: August 28, 2006, 05:51:23 PM »
Tim

Works great now...you da man.

This works now.  I tested it.  Sorry about that.

Thank you. I like this version over Alan's because it can be used by objectdbx.

Anyway, I still have to fine tone it and add in the objectdbx code. Will post it
when I get it all togeher.

This routine is a big time saver.

I can now put up my "easy" button and get back to work.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Delete Objects on Layers from List
« Reply #35 on: August 28, 2006, 05:56:45 PM »
Tim

Works great now...you da man.

This works now.  I tested it.  Sorry about that.

Thank you. I like this version over Alan's because it can be used by objectdbx.

Anyway, I still have to fine tone it and add in the objectdbx code. Will post it
when I get it all togeher.

This routine is a big time saver.

I can now put up my "easy" button and get back to work.

Gary
Happy to help.  :wink:
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.