Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Posts: 13
Registered: ‎05-21-2007
Message 1 of 3 (83 Views)

Help with routine

83 Views, 2 Replies
09-20-2007 07:17 AM

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.


(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)
) ;; 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
(setq older *error*)

(defun myerr (msg)
(princ "\n\n **** Cancelled - Variables Reset ok ****")
(setq *error* older)
(setvar "cmdecho" 1)
(setq blockname nil
e1 nil
ed nil
ss1 nil
ss2 nil
la nil
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
(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
"\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" "*" "")

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

) ;end defun
Posts: 13
Registered: ‎05-21-2007
Message 2 of 3 (83 Views)

Re: Help with routine

09-21-2007 08:04 AM in reply to: Groper
*Expert Elite*
Posts: 2,179
Registered: ‎12-11-2003
Message 3 of 3 (83 Views)

Re: Help with routine

09-24-2007 03:46 PM in reply to: Groper

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!

Dyslexia is a permanent physical disability that cannot be seen.
Introverts is proof that there is indeed intelligent life on this planet.
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.