TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: GDF 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*"))
;;;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
-
I didn't look at the code, it is easier to write one to suit your needs.
(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)
(DeleteObjLays (vla-get-ActiveDocument (vlax-get-Acad-Object)) '("A-dims*" "a-not*))
EDIT: The formatting fairy strikes again
-
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
-
You're welcome. :-D
-
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
-
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.
(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
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.
(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
-
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.
-
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
-
That problem is because of nesting. I think I can come up with a way to do that. Give me a minute.
-
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.
(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
(defun del_on_layer (layers / ss)
(if (setq ss (ssget "_all" (list (cons 8 layers))))
(vl-cmdf "_.erase" ss "")
)
)
-
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.
(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 get an unbalanced closing bracket.
And this gives me a syntax error
(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
-
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
(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
-
Sorry about that Gary. I didn't finish one part of the code. This should work.
(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)
)
-
(vlar-yourwelcome Gary)
Not sure if it will work with ObjectDBX though
-
(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
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
-
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
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
-
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
-
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
-
:-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)
-
Oops :oops:
<reply removed.>
-
(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.....
-
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:
;;;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
-
Gary;
Test this:
In the block list argument, place the following:
(list "UTA4" "UTA5" "UTA6") instead of ("UT*")
-
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.
;;;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
-
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)
-
And for your selection it can be:
(setq ss (ssget (list (cons 8 "A-ARE*,A-DIM*,A-NOT*,A-PAT*,A-SHT*,A-SYM*") (cons 2 "UT*"))))
-
I'm looking into this right now.
-
This works now. I tested it. Sorry about that.
(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)
)
-
(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))))
-
(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)
(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
-
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
-
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: