Help with routine

[Roperg]

Hi

I have found a routine for cleaning up xref’s which I am modifying and adding to to suit my needs.

I have come up against a few problems that I would like some help with please.

1. I would like the burst command to repeat until all blocks inc. nested blocks are burst. I have used the repeat but this is a little clumsy and requires the user to press enter if there aren’t blocks nested 3 times (if you get what I mean).

2. I would like to purge the drawing once all the layers have been sorted but I can’t figure out how to add the purge command to the end of the routine.

Many thanks.

Grayham


;COMMANDS TO CLEAN XREFS
(defun C:XCL (/ ss1 ss2 la layer dest-layer)


(command "undo" "begin")
(setvar "cmdecho" 0)



(command "-xref" "d" "*")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Burst all begin

(repeat 3(setq ssall (ssget "all"))
(sssetfirst nil ssall)
(c:burst)
) ;; End repeat

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Burst all end




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Overkill begin

(setq SelectionSet (ssget "X"))

Then run overkill.

(load "overkillsup")

(acet-overkill2 (list SelectionSet 0.000001 nil T nil nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Overkill end


(command "layon") ; Turns on all layers
(c:layers-erase) ; Delets frozen layers


(command "undo" "begin")
(setvar "cmdecho" 0)



;first purges drawing

(repeat 5 (command "PURGE" "ALL" "*" "N"))

(command "-layer" "set" "0" "")

;creates new xref layers

(command ".-layer" "new" "X-WALLS" "COLOR" "253"
"X-WALLS" "new" "X-TEXT" "COLOR" "252"
"X-TEXT" "new" "X-CEILING" "COLOR" "252"
"X-CEILING" "new" "X-GRID" "COLOR" "14"
"X-GRID" "new" "X-FURN" "COLOR" "252"
"X-FURN" "new" "X-HATCH" "COLOR" "252"
"X-HATCH" "new" "X-SAN" "COLOR" "252"
"X-SAN" "new" "X-DIMS" "COLOR" "252"
"X-DIMS" "new" "X-USER1" "COLOR" "252"
"X-USER1" "new" "X-USER2" "COLOR" "252"
"X-USER2" "new" "X-USER3" "COLOR" "252"
"X-USER3" "new" "X-USER4" "COLOR" "252"
"X-USER4" "new" "X-USER5" "COLOR" "252" "X-USER5"
"")

(command ".-layer" "freeze" "X-WALLS" "freeze"
"X-TEXT" "freeze" "X-GRID" "freeze"
"X-FURN" "freeze" "X-HATCH" "freeze"
"X-SAN" "freeze" "X-DIMS" "freeze"
"X-USER1" "freeze" "X-USER2" "freeze"
"X-USER3" "freeze" "X-USER4" "freeze"
"X-USER5" ""
)


;------------------------------------------------------------------error handler
error
handler
(setq older *error*)

(defun myerr (msg)
(princ "\n\n **** Cancelled - Variables Reset ok ****")
(princ)
(setq *error* older)
(setvar "cmdecho" 1)
(setq blockname nil
e1 nil
ed nil
ss1 nil
ss2 nil
la nil
layer nil
dest-layer
nil
older nil
)
(command "-layer" "on" "*" "")
(command "-layer" "thaw" "*" "")
(command "undo" "end")

(princ"\nRoutine exited")(princ)
)
(setq *error* myerr)

;--------------------------------------------------------------------

(while (= 1 1)

;asks user for object and isolates that layer

(setq ss1 nil)
(setq ss1 (entsel "\nSelect object or escape: "))
(while (= ss1 nil)
(setq ss1 (entsel "\nYou missed, select again or escape: "))
) ;while
(setq la (CDR (Assoc 8 (entget (car ss1)))))

(command ".-layer" "s" la "off" "*" "n" "")
(setq ss2
(ssget
"X"
(list (cons 8 (getvar "clayer")) (cons 410 (getvar "CTAB")))
)
)

;asks user for destination layer#
(initget "C D F G H S T W U1 U2 U3 U4 U5")
(setq dest-layer
(getkword
"\nDestination layer; x-(C)eiling, x-(D)ims, x-(F)urn, x-(G)rid, x-(H)atch, x-(S)an, x-(T)ext, x-(W)alls, x-(U1)ser1, x-(U2)ser2, x-(U3)ser3, x-(U4)ser4, x-(U5)ser5: "
)
)

(if (= dest-layer "C")
(setq layer "X-CEILING")
) ;end if

(if (= dest-layer "D")
(setq layer "X-DIMS")
) ;end if

(if (= dest-layer "F")
(setq layer "X-FURN")
) ;end if

(if (= dest-layer "G")
(setq layer "X-GRID")
) ;end if

(if (= dest-layer "H")
(setq layer "X-HATCH")
) ;end if

(if (= dest-layer "S")
(setq layer "X-SAN")
) ;end if

(if (= dest-layer "T")
(setq layer "X-TEXT")
) ;end if

(if (= dest-layer "W")
(setq layer "X-WALLS")
) ;end if

(if (= dest-layer "U1")
(setq layer "X-USER1")
) ;end if

(if (= dest-layer "U2")
(setq layer "X-USER2")
) ;end if

(if (= dest-layer "U3")
(setq layer "X-USER3")
) ;end if

(if (= dest-layer "U4")
(setq layer "X-USER4")
) ;end if

(if (= dest-layer "U5")
(setq layer "X-USER5")
) ;end if

;moves selection set ss2 to destination layer

(command "chprop" ss2 "" "color" "bylayer" "lweight" "bylayer" "")
(command "chprop" ss2 "" "layer" layer "")

;turns all layers back on for next selection

(command "-layer" "on" "*" "")


);while
(setvar "cmdecho" 1)
(command "undo" "end")





) ;end defun

[Roperg]

Bump

[scot-65]

Gropes,

I do not have your answer but I see something in your program others might not be aware of...

(command ".undo" "begin")

Since about 2004 the editor recognizes LISP and will skip completely over the routine when one manually uses the Undo command - without including a skip over a command previous to the routine being run. Hard to explain... it is like the LISP expression is now a command...

Unfortunately the undo begin and undo end markers does not work inside a routine if there are AutoCAD commands inside the routine - it will not skip completely over the routine, or skip to the beginning/ending markers, rather continues to stop just before each command inside the routine. Setting OSMODE or CMDECHO just before the command inside a routine is par for the course, but when one uses undo tags, it still stops between the OSMODE/CMDECHO line and the command line. I have not tried this on 2007, my guess it is still broken.

My best advise to you is to remove all undo's from your program and tell others that when this routine is run, do not undo, rather erase and keep going forward.

Good Luck!

Scot-65