Topic: Erase outside titleblock

[cmwade77]

I am trying to make a save and plot reactor that will automatically change the draworder of all xref backgrounds (on the layer $xref), hatches and raster images to the back (this part is working fine) and erase everything that is outside the title block on each layout (this is the part that is not working). I get an error whenever I run this of Invalid Extents.

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / exd ls1 obn sor spc ll ur)
    (if (setq spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
              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))
                    )
                    ((= "AcDbBlockReference" obn)
                    (if (= (vla-get-layer obj) "$XREF")
                    (progn                   
                    (setq ls1 (cons obj ls1))
                    )
                    )
                    )
                )
            )
            (if ls1 (vlax-invoke sor 'movetobottom ls1))
        )
        (princ "\nUnable to retrieve Sortents Table.")
    )
    (foreach pair (dictsearch (namedobjdict) "ACAD_LAYOUT")
(if (= 3 (car pair))
(progn
(if (/= (strcase (cdr pair)) "MODEL")
(progn
(vl-cmdf "._layout" "set" (cdr pair))
(if (setq spc (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
              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
                    ((= "AcDbBlockReference" obn)
                    (if (= (vla-get-layer obj) "$TB")
                    (progn                       
                    (vla-getboundingbox obj 'll 'ur) ; ****** This seems to be the problem line of code, maybe I am just missing something?
                    (vl-cmdf "._erase" "all" "r" ll ur "")
                    )
                    )
                    )
                )
            )
        )
        (princ "\nUnable to retrieve Sortents Table.")
    )
)
)
)
)
)
    (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,PLOT")
        (setdraworder)
    )
    (princ)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)

[roy_043]

Two issues:

1.
The ll and ur variables will contain points as safearrays. You will need to translate these to lists with vlax-safearray->list.

2.
You are using commands inside a reactor callback. This is usually not possible.

[Lee Mac]

The following is untested, but should fix most of the problems with the code:

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / all app doc ent exd idx llp ls1 obn sel sor spc urp )
    (if (setq doc (vla-get-activedocument (vlax-get-acad-object))
              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.")
    )
    (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)
                (vla-getboundingbox (vlax-ename->vla-object (ssname sel 0)) '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 (ssmemb (setq ent (ssname all (setq idx (1- idx)))) sel))
                        (entdel ent)
                    )
                )
                (setq all nil
                      sel nil
                )
                (gc)
            )
        )
    )
    (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,PLOT")
        (setdraworder)
    )
    (princ)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)

[cmwade77]

I ended up sorting it out, but I took a slightly different approach to it:

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568 and http://www.theswamp.org/index.php?topic=47158.msg521914#msg521914
;Additional code adapted from CAB's code at: http://www.theswamp.org/index.php?topic=10451.msg133019#msg133019
(defun setdraworder ( / exd ls1 obn sor spc ll ur ename ss_all ss_w i obj2 xrname currenttab)
    (if (setq spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
              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))
                    )
                    ((= "AcDbBlockReference" obn)
                    (if (= (vla-get-layer obj) "$XREF")
                    (progn                   
                    (setq ls1 (cons obj ls1))
                    )
                    )
                    )
                )
            )
            (if ls1 (vlax-invoke sor 'movetobottom ls1))
        )
        (princ "\nUnable to retrieve Modelspace Sortents Table.")
    )
    (setq currenttab (getvar 'ctab))
(foreach tab (layoutlist)
(setvar 'ctab tab)
(vla-ZoomExtents (vlax-get-acad-object))
(if (setq spc (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
              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
            (setq obn (vla-get-objectname obj))
                (cond
                    ((= "AcDbBlockReference" obn)
                    (setq xrname (strcase (vla-get-name obj)))
                    (if (or (= (wcmatch xrname "BEI_BDR*") T) (= (wcmatch xrname "BEI_BRDR*") T))
                    (progn
(vla-getboundingbox obj 'll 'ur)
(setq ll (vlax-safearray->list ll)
  ur (vlax-safearray->list ur)
  ss_all (ssget "_X" (list (cons 410 (getvar "ctab"))))
  ss_w (ssget "_W" ll ur)
  i -1
)
(while (setq ename (ssname ss_w (setq i (1+ i))))
    (ssdel ename ss_all)
    )
    (ssdel (vlax-vla-object->ename obj) ss_all)
    (setq i -1)
    (while (setq ename (ssname ss_all (setq i (1+ i))))
    (setq obj2 (vlax-ename->vla-object ename))
    (if (= (vla-get-objectname obj2) "AcDbBlockReference")
    (progn
    (if (= (wcmatch (strcase (vla-get-name obj2)) "PLOT STAMP*") nil)
    (vla-delete obj2)
    )
)
(vla-delete obj2)
)
    )                    
                    )
                    )
                    )
                )
            )
        )
        (princ "\nUnable to retrieve Paperspace Sortents Table.")
    )
)
(setvar 'ctab currenttab)
    (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,PLOT")
        (setdraworder)
    )
    (princ)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)But my guess is that your version will be more reliable than mine, as that usually seems to be the case....LOL

[ronjonp]

Why would you still use a command call to set the layout when you could use (setvar 'ctab tab) ?

[cmwade77]

Why would you still use a command call to set the layout when you could use (setvar 'ctab tab) ?

That's the next thing I was about to test and change.

EDIT: I have updated the code in my previous post to fix this as well.

[cmwade77]

The following is untested, but should fix most of the problems with the code:

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / all app doc ent exd idx llp ls1 obn sel sor spc urp )
    (if (setq app (vlax-get-acad-object); <-------This line was missing
              doc (vla-get-activedocument (vlax-get-acad-object))
              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.")
    )
    (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)
                (vla-getboundingbox (vlax-ename->vla-object (ssname sel 0)) 'llp 'urp) ;<--------- The 'urp was just 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 (ssmemb (setq ent (ssname all (setq idx (1- idx)))) sel))
                        (entdel ent)
                    )
                )
                (setq all nil
                      sel nil
                )
                (gc)
            )
        )
    )
    (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,PLOT")
        (setdraworder)
    )
    (princ)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)

As I suspected Lee, your code is much more stable than mine (although I did have to make two fixes to it, which are updated in the quote above and commented). Mine keeps erasing extra things that I don't want erased, but yours doesn't do this.

That being said, there is one odd thing that happens. After this runs, solid hatches disappear. They don't get deleted though and can be displayed again using the Regen command. Obviously, I can't run the regen command from the reactor, so I don't know any other way to automatically handle this.

[Lee Mac]

As I suspected Lee, your code is much more stable than mine (although I did have to make two fixes to it, which are updated in the quote above and commented). Mine keeps erasing extra things that I don't want erased, but yours doesn't do this.

Many thanks for correcting my typos Chris, I thought there might be a couple lurking 

Obviously, I can't run the regen command from the reactor, so I don't know any other way to automatically handle this.

You could use the regen method of the document object, though, repeatedly regenerating the drawing is slow and not an ideal solution:

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / all app doc ent exd idx llp ls1 obn sel sor spc urp )
    (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.")
    )
    (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)
                (vla-getboundingbox (vlax-ename->vla-object (ssname sel 0)) '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 (ssmemb (setq ent (ssname all (setq idx (1- idx)))) sel))
                        (entdel ent)
                    )
                )
                (setq all nil
                      sel nil
                )
                (gc)
            )
        )
    )
    (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,PLOT")
        (setdraworder)
    )
    (princ)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)

[cmwade77]

As I suspected Lee, your code is much more stable than mine (although I did have to make two fixes to it, which are updated in the quote above and commented). Mine keeps erasing extra things that I don't want erased, but yours doesn't do this.

Many thanks for correcting my typos Chris, I thought there might be a couple lurking 

Obviously, I can't run the regen command from the reactor, so I don't know any other way to automatically handle this.

You could use the regen method of the document object, though, repeatedly regenerating the drawing is slow and not an ideal solution:

No problem,  I had to make some further changes, even before the regen issue. For example I had to remove the plot command, because we found that it would go through each tab when starting the plot command, when previewing the plot command and when finishing the plot command (twice if making a PDF), which caused the plot command to become unusable.

Additionally, I needed to warn users when there is a block that is inserted on the $TB layer that is not a title block and make them change the layer to the correct layer. Yes, I could have programmed it to ignore these blocks, but I want to better enforce our CAD Standards.

Code: [Select]

;Code adapted from LeeMac's code at: http://www.theswamp.org/index.php?topic=43352.msg507568#msg507568
(defun setdraworder ( / all app doc ent exd idx llp ls1 obn sel sor spc urp oldTab obj Obj_Name AlertShown OBN)
    (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 oldTab (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)))
                (setq obj_Name (strcase (vla-get-name Obj)))               
                (if (and (= (wcmatch Obj_Name "*_BDR") nil) (= (wcmatch Obj_Name "*_BRDR") nil) (= (wcmatch Obj_Name "*_BORD") nil) (= (wcmatch Obj_Name "*_BORDER") nil) (= (wcmatch Obj_Name "TB") nil) (= (wcmatch Obj_Name "*_TITLE") nil))
                (progn;This is not a title block
                (alert "An object that does not appear to be a titleblock was found on the layer $TB. Please move this object to the correct layer and try saving or plotting again.")
                (vla-getboundingbox Obj 'llp 'urp)               
                (vla-zoomwindow app llp urp)
                (quit)
                )
                (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 (ssmemb (setq ent (ssname all (setq idx (1- idx)))) sel))
                    (progn
                (setq Obj (vlax-ename->vla-object ent))
                (setq obn (vla-get-objectname obj))
                (If (/= "AcDbBlockReference" obn)
                (setq objName "")
            (setq obj_Name (strcase (vla-get-name Obj)))
        )
                (if (OR (AND (= "AcDbBlockReference" obn) (= (wcmatch Obj_Name "PLOT STAMP*") nil)) (/= "AcDbBlockReference" obn))
                (progn
                (entdel ent)                                    
                    (if (= AlertShown nil)
                    (progn
                    (PRINC "\nObject(s) found outside the title block and will now be deleted.")
                    (setq AlertShown T)
                    )
                    )
             )
             )
                  )
              )
                )
                (setq all nil
                      sel nil
                )
                (vla-zoomextents app)
             )
         )
                (gc)
            )
        )
    )
    (setvar "ctab" oldTab)
    (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)
)
(vl-load-com)
(if (null draworder:reactor)
    (setq draworder:reactor (vlr-command-reactor nil '((:vlr-commandwillstart . draworder:callback))))
)
(princ)
Hopefully I didn't end up introducing too many bugs into this.

[Lee Mac]

As before, there could be more bugs, but here are a few changes to consider:

Code: [Select]

;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.