As before, there could be more bugs, but here are a few changes to consider:
;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / *error* all app doc ent exd flg idx llp ls1 obj obn old sel sor spc urp )
(defun *error* ( msg )
(if (= 'str (type old)) (setvar 'ctab old))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if (setq app (vlax-get-acad-object)
doc (vla-get-activedocument app)
spc (vla-get-modelspace doc)
exd (vla-getextensiondictionary spc)
sor (cond ((catchapply 'vla-getobject (list exd "acad_sortents")))
((catchapply 'vla-addobject (list exd "acad_sortents" "acdbsortentstable")))
)
)
(progn
(vlax-for obj spc
(cond
( (= "AcDbHatch" (setq obn (vla-get-objectname obj)))
(setq ls1 (cons obj ls1))
)
( (= "AcDbRasterImage" obn)
(setq ls1 (cons obj ls1))
)
( (and (= "AcDbBlockReference" obn) (= (vla-get-layer obj) "$XREF"))
(setq ls1 (cons obj ls1))
)
)
)
(if ls1 (vlax-invoke sor 'movetobottom ls1))
)
(princ "\nUnable to retrieve Modelspace Sortents Table.")
)
(setq old (getvar "ctab"))
(foreach tab (layoutlist)
(setvar "ctab" tab)
(if (setq sel (ssget "_X" (list '(0 . "INSERT") '(8 . "$TB") (cons 410 tab))))
(progn
(vla-put-mspace doc :vlax-false)
(vla-zoomextents app)
(setq obj (vlax-ename->vla-object (ssname sel 0)))
(if (wcmatch (strcase (LM:blockname obj)) "*_BDR,*_BRDR,*_BORD,TB,*_TITLE")
(progn ;; This is a title block
(vla-getboundingbox obj 'llp 'urp)
(setq llp (trans (vlax-safearray->list llp) 0 1)
urp (trans (vlax-safearray->list urp) 0 1)
all (ssget "_X" (list (cons 410 tab)))
sel (ssget "_C" (mapcar '- llp '(1e-2 1e-2)) (mapcar '+ urp '(1e-2 1e-2)) (list (cons 410 tab)))
)
(repeat (setq idx (sslength all))
(if
(not
(or (ssmemb (setq ent (ssname all (setq idx (1- idx)))) sel)
(and (= "INSERT" (cdr (assoc 0 (entget ent))))
(wcmatch (strcase (LM:blockname (vlax-ename->vla-object ent))) "PLOT STAMP*")
)
)
)
(progn
(entdel ent)
(or flg (setq flg (princ "\nObject(s) found outside the title block and will now be deleted.")))
)
)
)
(setq all nil
sel nil
)
(vla-zoomextents app)
)
(progn ;; This is not a title block
(alert
(strcat
"An object that does not appear to be a titleblock was found on the layer $TB."
"\nPlease move this object to the correct layer and try saving or plotting again."
)
)
(vla-getboundingbox obj 'llp 'urp)
(vla-zoomwindow app llp urp)
(quit)
)
)
(gc)
)
)
)
(setvar "ctab" old)
(vla-regen doc acallviewports)
(princ)
)
(defun catchapply ( fun arg / rtn )
(if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)
(defun draworder:callback ( obj arg )
(if (wcmatch (strcase (car arg)) "SAVE,QSAVE,SAVEAS")
(setdraworder)
)
(princ)
)
;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference
(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)
(vl-load-com)
(if (null draworder:reactor)
(setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)
PS: I recommend disabling any 'Insert Tabs' option in the code editor you are using - they mess with the code formatting.