Thanks dub....I have that one as well, just thought it would be a good add-on for CDG Purge.
Here is my compilation of cleanup utils:
(defun c:ninja-lite (/ TXT NB NAMES BLK lay ent name removed cnt *acad* curdwg pslayout x)
;_____________________________________________________________________________
;; DELETES ALL LAYER FILTERS
;_____________________________________________________________________________
(vl-Load-Com)
(vl-Catch-All-Apply
'(lambda ()
(vla-Remove
(vla-GetExtensionDictionary
(vla-Get-Layers
(vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
)
)
)
"ACAD_LAYERFILTERS"
)
)
)
;_____________________________________________________________________________
;; DELETES NUL LINES OF TEXT, MTEXT, AND BLOCKS
;_____________________________________________________________________________
(if (setq TXT (ssget "X"
'((-4 . "<and")
(-4 . "<or")
(0 . "MTEXT")
(0 . "TEXT")
(-4 . "or>")
(-4 . "<or")
(1 . "")
(1 . " ")
(1 . " ")
(1 . " ")
(1 . "{}")
(1 . "{ }")
(1 . "{ }")
(1 . "{ }")
(1 . "{}\P")
(1 . "{ }\P")
(1 . "{ }\P")
(1 . "{ }\P")
(-4 . "or>")
(-4 . "and>")
)
)
)
(progn
(command "_erase" TXT "")
(princ (strcat "\n "
(itoa (sslength TXT))
" nul text strings deleted. "
)
)
)
(princ "\n No nul text strings found. ")
)
(setq BLK (tblnext "BLOCK" T)
NAMES nil
)
(while BLK
(if (= (cdr (assoc 0 (entget (cdr (assoc -2 BLK))))) "ENDBLK")
(progn
(if (setq NB (ssget "X" (list (assoc 2 BLK))))
(command "_erase" NB "")
)
(setq NAMES (cons (cdr (assoc 2 BLK)) NAMES))
)
)
(setq BLK (tblnext "BLOCK"))
)
(if NAMES
(progn (textscr)
(princ "\n Nul blocks found and need purging: ")
(foreach X NAMES (princ "\n ") (princ X))
)
(princ "\n No nul blocks found. ")
)
(princ)
)
;_____________________________________________________________________________
;;CLEARS ALL LAYER STATES
;_____________________________________________________________________________
(
(lambda (/ lay ent)
(while (setq lay (tblnext "layer" (not lay)))
(if (and
(setq
ent (entget (tblobjname "layer" (cdr (assoc 2 lay)))
'("RAK")
)
)
(assoc -3 ent)
)
(entmod (subst '(-3 ("RAK")) (assoc -3 ent) ent))
)
)
)
)
;_____________________________________________________________________________
;;DELETES REGISTERED APPLICATIONS EXCEPT FOR WID*
;____________________________________________________________________________
(vl-load-com)
(setq cnt 0)
(if (not *acad*)
(setq *acad* (vlax-get-acad-object))
)
(setq allapp (vla-get-registeredapplications
(vla-get-activedocument *acad*)
)
) ;(setq name nil)
(vlax-for app allapp
;(setq name (append name (list (vla-get-name app)))))
(setq name (vla-get-name app))
(cond ((or
(not (wcmatch (strcase name) (strcase "WID*")))
)
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-delete
(list app)
)
)
)
(progn
(setq cnt (1+ cnt))
(setq removed
(princ
(strcat
"\nRemoved application \""
name
"\""
)
)
)
) ;end progn
)
(if (not removed)
(princ "\nNo applications were removable.")
(print cnt)
)
)
)
)
(princ)
(setq name nil
removed nil
cnt nil
allapp nil
)
;_____________________________________________________________________________
;;DELETES ALL PAGESETUPS
;_____________________________________________________________________________
(vl-load-com)
(setq
curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
) ;_ end of setq
;; Call RefreshPlotDeviceInfo before GetPlotDeviceNames
(vla-RefreshPlotDeviceInfo pslayout)
(vlax-for x (vla-get-Plotconfigurations curdwg)
(vla-delete x)
) ;_ end of vlax-for
(c:ninja-lite)
Ron
