delete all layouts except current

[FazBear]

Does anyone know a way to delete all but one layouts

 

i need to break down layouts from a coordinated building services drawing before i publish to the client, i will need to publish around 4000 layouts across 300 drawings (ish) in total. At present i can delete known layout tabs from the standard CIBSE codes but if any of the coordinators have created an off standard layouts these will be left and i will have to manualy delete them. Joy!!

 

For clarification the "but one" layout will be the layout specific to the sevice which i will be publishing.

 

Any advise would be greatly appreciated!

[lpseifert]

You can Shift+Left Click to select the Layout tabs, the Rt-click > Delete to get rid of them.

[FazBear]

Thank you for your reply but i was looking for a more automated way of doing this.

[ronjonp]

Here is something to delete all but current layout:

 

(defun c:deleteallbutcurrentlayout (/)
 (vl-load-com)
 (vlax-map-collection
   (vla-get-layouts
     (vla-get-activedocument (vlax-get-acad-object))
   )
   '(lambda (lay)
      (if (/= (vla-get-name lay) (getvar 'ctab))
    (vl-catch-all-apply 'vla-delete (list lay))
      )
    )
 )
)
(c:deleteallbutcurrentlayout)

[ShortChop]

Lee Mac,

 

Thanks for all your input I've been a lurker for a long time. I wanted to thank you also for all the links on the page: http://www.cadtutor.net/forum/showthread.php?p=337182#post337182

 

I had a question in the line:

 

(if (/= (vla-get-name lay) (getvar 'ctab))

 

In lieu of getting the variable current tab delete all but the "Site Plan" tab?

 

Second question is there a way to run this in a batch on 283 drawings? I've looked at a couple of the batch programs in the past but I've never settled on one. Any suggestions?

 

Thanks again,

 

Chris

[Lee Mac]

Happy that I could help in some way

 

Try this code

 

(defun c:DeleteAllLayoutsBut ( / exceptions )
 (vl-load-com)

 (setq exceptions '("Site Plan"))

 (vlax-for l
   (vla-get-Layouts
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
   (if (not
         (vl-position (vla-get-name l)
           (cons "Model" (cons (getvar 'ctab) exceptions))
         )
       )
     (if (vl-catch-all-error-p
           (vl-catch-all-apply 'vla-delete (list l))
         )
       (princ (strcat "\n** Error deleting layout: " (vla-get-name l) " **"))
     )
   )
 )

 (princ)
)

List your exceptions in the list at the top.

 

Also perhaps look at my TabSort.lsp in the Archive.

 

As for the batching - you could call the above from a script - perhaps look into my Script Writer program in my sig

 

Lee

[ShortChop]

You need to put the word "Turbo" in front of your name.

 

Thanks!

 

I'll give it a while and report my results.

[Lee Mac]

Hehe

 

(added (vl-load-com) at the top - missed it due to this)

[ShortChop]

Lee Mac,

 

I finally ran the script with the following:

_.open *file* model stripper _.saveas *file* _.close

and I get

Command: _.saveas

Current file format: AutoCAD 2007(LT 2007) Drawing

Enter file format

[R14(LT98&LT97)/2000(LT2000)/2004(LT2004)/2007(LT2007)/2010(LT2010)/Standards/DX

F/Template] : "C:\Documents and

Settings\Chris\Desktop\Sites\test\Q00-100-2620 (206392).dwg"

Invalid option keyword.

Current file format: AutoCAD 2007(LT 2007) Drawing

Enter file format

[R14(LT98&LT97)/2000(LT2000)/2004(LT2004)/2007(LT2007)/2010(LT2010)/Standards/DX

F/Template] : *Cancel*

 

It does set the model as current. Deletes all the tabs. But when it goes to save it gets stuck.

 

I'm trying to get the drawing to go to model then strip all the layouts (tabs). If it's on a layout it will not delete it.

 

Thanks in advance,

 

chris

Edited July 27, 2010 by ShortChop
I forgot to add the other resulfts

[Lee Mac]

Hi Chris,

 

Is 'stripper' a LISP routine?

 

Also, for the saveas, you need another space between saveas and the filename, else specify a filetype to save it as.

[ShortChop]

uh oh faux pas yes, it "strips" all the layouts away. Model stripper I didn't see that. Now that you mention it that's funny. It's actually the script you edited for me. It's just how I saved it. I just found out I have to do about 337 drawings. I have to erase all tabs but the Site Plan. Delete all layers that begin with the letter Q. Lastly Bind the Xref GR-LOGO XREF.dwg for the older drawings and X-X-GR-LOGO XREF.dwg for the newer drawings.

 

I think if I use your script writer with the script pro it outta work. I am going to do it one "strip" at a time - Tabs, Q layers, and xref binding.

 

They also wanted me to explode all the blocks and put everything on layer 0. I said it would take an additional 24 hours to do that and now I don't have to.

[Lee Mac]

My Script Writer should give the option to run the script straight away - let me know if you have any issues mate.

[ShortChop]

I put the space it and it was the same result. so I put two spaces in and got:

urrent file format: AutoCAD 2007(LT 2007) Drawing

Enter file format

[R14(LT98&LT97)/2000(LT2000)/2004(LT2004)/2007(LT2007)/2010(LT2010)/Standards/DX

F/Template] : Save drawing as

Settings\Chris\Desktop\Sites\test\Q00-100-2620 (206392).dwg>: "C:\Documents and

Settings\Chris\Desktop\Sites\test\Q00-100-2620 (206392).dwg" A drawing with

this name already exists.

Do you want to replace it? _.close

Yes or No, please.

A drawing with this name already exists.

 

So I put a YES in there and wallah. Going to run it now on all to get the tabs gone.

 

Thanks for the help!

[Lee Mac]

Just think of it as if you were going to do all the commands yourself and for every 'enter' you need a space.

 

You could perhaps use 'save' instead of 'saveas' but I suppose it doesn't matter

[ShortChop]

Well I completed deleting all Layout tabs. Scriptpro just kept crashing so I used Script Writer THanks!

I also used the eTransmit to bind/insert all the xrefs

Now I was looking at your post I can't post links lol "31569-Deleting-Layers-in-LISP&p=205091" and I searched the Internet (Google) and it keeps pointing me back here. So why fight it.

 

So I was looking at running the -laydel command wouldn't run in a LISP but then I found out Express Tools can't be run IN a LISP. That lead me back to here again. So I did a search on LAYDEL LISP....and wallah I found said post in link above.

 

I'd like to delete all Layers beginning with the letter Q. Do you think you could help me with that?

 

Cheers,

 

Chris

[ronjonp]

....

 

I'd like to delete all Layers beginning with the letter Q. Do you think you could help me with that?

 

Cheers,

 

Chris

 

(defun c:delq (/ ss)
 (if (setq ss (ssget "_x" '((8 . "Q*"))))
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel e))
 )
 (princ)
)

[ShortChop]

Thanks for the response ronjonp. I noticed when I ran delq the physical entities tied to the layer disappear. After running delq the layer dialogue shows the layers deleted as status of empty (it's greyed?) but still list as a layer. If a Q layer is current the delq doesn't delete it. I think we need a "-layer" "set" "" "0" "" "" in there to set the layer to zero or something to that effect.

 

Let me know what you think

 

 
(defun c:delq (/ ss)
(command "-layer" "set" "0" "")
 (if (setq ss (ssget "_x" '((8 . "Q*"))))
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel e))
 )
 (princ)
)

[Lee Mac]

Try this mate:

 

(defun c:test nil

 (LM:DeleteLayersIf "Q*")

 (princ)
)

;;-----------------=={ Delete Layers If }==-------------------;;
;;                                                            ;;
;;  Deletes layers in a drawing if the layer name matches a   ;;
;;  wildcard string                                           ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  wcstr - wildcard string to identify layers to delete      ;;
;;------------------------------------------------------------;;

(defun LM:DeleteLayersIf ( wcstr / layers locked ss )
 ;; © Lee Mac 2010

 (setq layers
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
 )

 (foreach x (setq locked (LM:GetLocked layers))
   (vla-put-lock x :vlax-false)
 )

 (setvar 'CLAYER "0")

 (if (setq ss (ssget "_X" (list (cons 8 wcstr))))
   (
     (lambda ( i / e )
       (while (setq e (ssname ss (setq i (1+ i))))
         (entdel e)
       )
     )
     -1
   )
 )

 (vlax-for l layers
   (if (wcmatch (vla-get-name l) wcstr)
     (LM:CatchApply vla-delete (list l))
   )
 )

 (foreach x locked
   (LM:CatchApply vla-put-lock (list x :vlax-true))
 )

 (princ)
)

;;-----------------=={ Get Locked Layers }==------------------;;
;;                                                            ;;
;;  Returns a list of VLA Layer Objects locked within the     ;;
;;  current drawing                                           ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  layers - the layers collection for the current drawing    ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Layer Objects, else nil             ;;
;;------------------------------------------------------------;;

(defun LM:GetLocked ( layers )
 ;; © Lee Mac 2010
 (vlax-for l layers
   (if (eq :vlax-true (vla-get-lock l))
     (setq locked (cons l locked))
   )
 )
 locked
)

;;---------------------=={ Catch Apply }==--------------------;;
;;                                                            ;;
;;  Applies a function to a list of arguments and catches     ;;
;;  an exception.                                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo  - function to be applied                             ;;
;;  args - list of arguments to be supplied to foo            ;;
;;------------------------------------------------------------;;
;;  Returns:  Result of applying foo, else nil if exception   ;;
;;------------------------------------------------------------;;

(defun LM:CatchApply ( foo args / result )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq result
         (vl-catch-all-apply (function foo) args)
       )
     )
   )
   result
 )
)

[ronjonp]

(defun c:delq (/ ss)
 (if (setq ss (ssget "_x" '((8 . "Q*"))))
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel e))
 )
 (princ)
)

 

Use Lee's or try this:

 

(defun c:delq (/ ss)
 (if (setq ss (ssget "_x" '((8 . "Q*"))))
   (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (entdel e))
   (vl-load-com)
   (vl-catch-all-apply 'setvar (list "clayer" "0"))
   (repeat 3 (vla-purgeall (vla-get-activedocument (vlax-get-acad-object))))
   )
 )
 (princ)
)

[Lee Mac]

Nice solution Ron, - mine probably seems a tad OTT now lol