Topic: How to: Add an undo feature to this routine

[T.Willey]

The routine is used to erase objects from block definition ( lines, arc, etc.... ) by selecting them.  It works well, for me so far.  I was wondering how one would implement an undo feature?  I couldn't just add an ' entdel ' to bring back the entity, since I couldn't delete it with same function.  I don't want to have to save the block definition ( all entities ) and then recreate it all with code, so I was trying to find a simpler way.

Code: [Select]

(defun c:EraseObjectFromBlock (/ ActDoc Sel EntList DiaRtn tempName)
    ; Erase object selected from block, in block collection, so all blocks will update.
    ; Will let you select from dialog box if item is more that one nesting deeep.
    ; Sub's - 'SingleSelect
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setvar 'Errno 0)
    (while (not (equal (getvar 'ErrNo) 52))
        (if
            (and
                (setq Sel (nentsel "\n Select nested item to erase: "))
                (> (length Sel) 2)
                (setq EntList (last Sel))
                (not
                    (wcmatch
                        (setq tempName (cdr (assoc 2 (entget (car EntList)))))
                        "*|*"
                    )
                )
                (not
                    (equal
                        (logand
                            (cdr (assoc 70 (entget (tblobjname "block" tempName))))
                            4
                        )
                        4
                    )
                )
                (setq Entlist (cons (car Sel) EntList))
                (setq Ent
                    (if (< (length EntList) 3)
                        (car EntList)
                        (if
                            (setq DiaRtn
                                (SingleSelect
                                    (mapcar
                                        '(lambda (x)
                                            (cdr (assoc 0 (entget x)))
                                        )
                                        (reverse (cdr (reverse EntList)))
                                    )
                                    "Select item to be erased ( lowest to highest, nesting )."
                                    nil
                                )
                            )
                            (nth (setq DiaRtn (car DiaRtn)) EntList)
                        )
                    )
                )
                ;(entdel Ent)
                (or
                    (vla-Delete (vlax-ename->vla-object Ent))
                    (vlax-erased-p Ent)
                )
            )
            (progn
                (or
                    DiaRtn
                    (setq DiaRtn 0)
                )
                (foreach i (cdr (member Ent EntList))
                    (vla-Update (vlax-ename->vla-object i))
                )
                (prompt "\n Item deleted.")
            )
            (prompt "\n No item deleted.")
        )
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)

Sub-function

Code: [Select]

(defun SingleSelect (Listof Message Toggle / DiaLoad tmpStr tmpTog tmpList)

(setq DiaLoad (load_dialog "MyDialogs.dcl"))
(if (new_dialog "SingleSelect" DiaLOad)
(progn
(start_list "listbox" 3)
(mapcar 'add_list Listof)
(end_list)
(if Message
(set_tile "text1" Message)
)
(if (not Toggle)
(mode_tile "toggle1" 1)
)
(action_tile "listbox"
"(if (= $reason 4)
(progn
(setq tmpStr (get_tile \"listbox\"))
(if Toggle
(setq tmpTog (get_tile \"toggle1\"))
)
(done_dialog 1)
)
)"
)     
(action_tile "accept"
"(progn
(setq tmpStr (get_tile \"listbox\"))
(if Toggle
(setq tmpTog (get_tile \"toggle1\"))
)
(done_dialog 1)
)"
)
(action_tile "cancel" "(done_dialog 0)")
(if (= (start_dialog) 1)
(progn
(setq tmpList (read (strcat "(" tmpStr ")")))
(if (= tmpTog "1")
(cons T tmpList)
tmpList
)
)
)
)
)
)


[CAB]

Just thinking out loud, could you WBLOCK and the use the INSERT to redefine the block as a restore feature?

[MP]

Have you tried creating an objectdbx instance and copy to/from as necessary?

[T.Willey]

Good ideas.

[JohnK]

handles?!
Would this work?
[ http://www.theswamp.org/~stig/lisps/delrestore.lsp ]

[FengK]

maybe this works too:

1. for the block you're going to modify, say BLKA, attach a unique xdata to each object in its definition;
2. create a new block, say BLKB, and copy all objects from BLKA's definition to BLKB. those copied objects should have same xdata;
3. keep track of the xdata of object being deleted;
4. copy the object(s) with appropriate xdata when undo is needed.

[T.Willey]

handles?!
Would this work?
[ http://www.theswamp.org/~stig/lisps/delrestore.lsp ]

I don't think this would work, as it is still using ' entdel ' to bring the items back, and that didn't work in my testing.

maybe this works too:

1. for the block you're going to modify, say BLKA, attach a unique xdata to each object in its definition;
2. create a new block, say BLKB, and copy all objects from BLKA's definition to BLKB. those copied objects should have same xdata;
3. keep track of the xdata of object being deleted;
4. copy the object(s) with appropriate xdata when undo is needed.

I haven't worked with xdata too much, and I don't think I want anything permanent, so I would have to place it, and then remove it per item selected.

___________________________________________________________________________

I think I like Michael's idea best.  Shouldn't be hard to implement.  Copy all objects of selected block into a block withing the ObjectDBX doc, and add that definition to an associated list with the current blocks name.  The only problem I see is if the block is big, then you are copying a lot of information.  Not sure if that would slow anything down or not though.

I'll post back my findings.

[T.Willey]

It is slow on large blocks, so I might see how I can optimize it.

Edit:  Slow on the undo option that is.

Code: [Select]

(defun c:EraseObjectFromBlock (/ *error* ActDoc dbxApp oVer BlkCol dbxBlkCol cnt Sel tempList tempBlk tempObjList EntList tempName Ent DiaRnt
    fromBlk toBlk UndoList)
    ; Erase object selected from block, in block collection, so all blocks will update.
    ; Will let you select from dialog box if item is more that one nesting deeep.
    ; Sub's - 'SingleSelect
   
    (defun *error* (msg)
       
        (if dbxBlkCol (vlax-release-object dbxBlkCol))
        (if dbxApp (vlax-release-object dbxApp))
        (setq dbxBlkCol nil)
        (setq dbxApp nil)
        (if msg
            (prompt (strcat "\n  Error-> " msg))
        )
        (vla-EndUndoMark ActDoc)
    )
    ;-------------------------------------------------------------
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setq dbxApp
        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
        )
    )
    (setq BlkCol (vla-get-Blocks ActDoc))
    (setq dbxBlkCol (vla-get-Blocks dbxApp))
    (setq cnt 0)
    (setvar 'Errno 0)
    (while (not (equal (getvar 'ErrNo) 52))
        (if
            (or
                (initget "Undo")
                (setq Sel (nentsel "\n Select nested item to erase [Undo]: "))
            )
            (cond
                ( (= Sel "Undo")
                    (if (> (length UndoList) 0)
                        (progn
                            (setq tempList (car UndoList))
                            (setq tempBlk (vla-Item BlkCol (cdr tempList)))
                            (vlax-for i tempBlk
                                (vla-Delete i)
                            )
                            (setq tempObjList nil)
                            (vlax-for i (vla-item dbxBlkCol (car tempList))
                                (setq tempObjList (cons i tempObjList))
                            )
                            (vlax-invoke dbxApp 'CopyObjects tempObjList tempBlk)
                            (setq UndoList (cdr UndoList))
                            (vla-Regen ActDoc acActiveViewport)
                        )
                        (prompt "\n Nothing to undo.")
                    )
                )
                (
                    (and
                        (> (length Sel) 2)
                        (setq EntList (last Sel))
                        (not
                            (wcmatch
                                (setq tempName (cdr (assoc 2 (entget (car EntList)))))
                                "*|*"
                            )
                        )
                        (not
                            (equal
                                (logand
                                    (cdr (assoc 70 (entget (tblobjname "block" tempName))))
                                    4
                                )
                                4
                            )
                        )
                        (setq Entlist (cons (car Sel) EntList))
                        (setq Ent
                            (if (< (length EntList) 3)
                                (car EntList)
                                (if
                                    (setq DiaRtn
                                        (SingleSelect
                                            (mapcar
                                                '(lambda (x)
                                                    (cdr (assoc 0 (entget x)))
                                                )
                                                (reverse (cdr (reverse EntList)))
                                            )
                                            "Select item to be erased ( lowest to highest, nesting )."
                                            nil
                                        )
                                    )
                                    (nth (setq DiaRtn (car DiaRtn)) EntList)
                                )
                            )
                        )
                        (setq fromBlk (vla-Item BlkCol (setq tempName (cdr (assoc 2 (entget (cadr (member Ent EntList))))))))
                        (setq toBlk (vla-Add dbxBlkCol (vla-get-Origin fromBlk) (itoa cnt)))
                        (setq cnt (1+ cnt))
                        (or
                            (setq tempList nil)
                            (vlax-for i fromBlk
                                (setq tempList (cons i tempList))
                            )
                        )
                        (vlax-invoke ActDoc 'CopyObjects tempList toBlk)
                        (setq UndoList (cons (cons (vla-get-Name toBlk) tempName) UndoList))
                    )
                    (if
                        (or
                            (vla-Delete (vlax-ename->vla-object Ent))
                            (vlax-erased-p Ent)
                        )
                        (progn
                            (or
                                DiaRtn
                                (setq DiaRtn 0)
                            )
                            (foreach i (cdr (member Ent EntList))
                                (vla-Update (vlax-ename->vla-object i))
                            )
                            (prompt "\n Item deleted.")
                        )
                        (prompt "\n No item deleted.")
                    )
                )
                ( t (prompt "\n No item deleted.") )
            )
        )
    )
    (*error* nil)
    (princ)
)


[MP]

Thinking outside the block, I mean box ... another technique (over simplified for clarity; hopefully) you could exploit is to flag entities to be deleted from the block def, say with a simple xdata entry, and then set their visibility to false, the latter giving the user the illusion objects are being deleted. If a psuedo undo is triggered whilst in editing mode modify the xdata to reflect and restore visibility. Once processing is done, walk thru the block deleting objects that have the flag set and are not visible. The reason why I suggest using a flag is there are many objects, for example in Autoplant models (e.g. master nodes) that are legitimately not visible; you would not want to confuse these objects with those being processed by your proggy. Hope this all made some sense.

[T.Willey]

Thinking outside the block, I mean box ... another technique (over simplified for clarity; hopefully) you could exploit is to flag entities to be deleted from the block def, say with a simple xdata entry, and then set their visibility to false, the latter giving the user the illusion objects are being deleted. If a psuedo undo is triggered whilst in editing mode modify the xdata to reflect and restore visibility. Once processing is done, walk thru the block deleting objects that have the flag set and are not visible. The reason why I suggest using a flag is there are many objects, for example in Autoplant models (e.g. master nodes) that are legitimately not visible; you would not want to confuse these objects with those being processed by your proggy. Hope this all made some sense.

I like that idea.  No need for the xdata, as I can just keep a list of items to be erased.  Let me see how that works..... Should be a lot faster.  Thanks Michael!

[T.Willey]

Here it is, and it runs pretty fast even on the other big block drawings.  Thanks again Michael for the visibility suggestion.  Never would have come to my head.

Code: [Select]

(defun c:EraseObjectFromBlock (/ ActDoc Sel EntList Ent DiaRtn tempName tempList ErasedList ObjList Obj)
    ; Erase object selected from block, in block collection, so all blocks will update.
    ; Will let you select from dialog box if item is more that one nesting deeep.
    ; Sub's - 'SingleSelect
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setvar 'Errno 0)
    (while (not (equal (getvar 'ErrNo) 52))
        (if
            (or
                (initget "Undo")
                (setq Sel (nentsel "\n Select nested item to erase [Undo]: "))
            )
            (cond
                ( (= Sel "Undo")
                    (if (> (length ErasedList) 0)
                        (progn
                            (setq tempList (car ErasedList))
                            (vla-put-Visible (car tempList) :vlax-true)
                            (foreach i tempList
                                (vla-Update i)
                            )
                            (setq ErasedList (cdr ErasedList))
                        )
                        (prompt "\n Nothing to undo.")
                    )
                )
                (
                    (and
                        (> (length Sel) 2)
                        (setq EntList (last Sel))
                        (not
                            (wcmatch
                                (setq tempName (cdr (assoc 2 (entget (car EntList)))))
                                "*|*"
                            )
                        )
                        (not
                            (equal
                                (logand
                                    (cdr (assoc 70 (entget (tblobjname "block" tempName))))
                                    4
                                )
                                4
                            )
                        )
                        (setq Entlist (cons (car Sel) EntList))
                        (setq Ent
                            (if (< (length EntList) 3)
                                (car EntList)
                                (if
                                    (setq DiaRtn
                                        (SingleSelect
                                            (mapcar
                                                '(lambda (x)
                                                    (cdr (assoc 0 (entget x)))
                                                )
                                                (reverse (cdr (reverse EntList)))
                                            )
                                            "Select item to be erased ( lowest to highest, nesting )."
                                            nil
                                        )
                                    )
                                    (nth (setq DiaRtn (car DiaRtn)) EntList)
                                )
                            )
                        )
                        (setq ObjList (mapcar 'vlax-ename->vla-object (member Ent EntList)))
                    )
                    (if
                        (or
                            (vla-put-Visible (car ObjList) :vlax-false)
                            (setq ErasedList (cons ObjList ErasedList))
                        )
                        (progn
                            (foreach i ObjList
                                (vla-Update i)
                            )
                            (prompt "\n Item deleted.")
                        )
                        (prompt "\n No item deleted.")
                    )
                )
                ( t (prompt "\n No item deleted."))
            )
        )
    )
    (foreach i ErasedList (vla-Delete (car i)))
    (vla-EndUndoMark ActDoc)
    (princ)
)


[MP]

Keeping a list is a faster way to implement it for sure, but you may have need to have this perform between executions and/or have it be completely bomb proof / error recoverable, and if that's the case you'd have to keep the list as a global, which to me isn't so attractive, so some method of tracking from execution to execution, be it xdata, a dictionary etc. might be a consideration. But if you're not going to span executions AND you can guarantee the program won't crash (leaving objects in an error state; i.e. invisible when they should deleted) then a list would be the way to go. You're welcome Tim, thanks for the opportunity to float ideas.