Topic: vlr-erased - start before cancellation

[Lupo76]

Hello everyone,
is the first time you use the reactors and I have a problem.
I wrote the following code that starts when I edit a line containing the XData:
 
(setq lineReactor   
(vlr-object-reactor (list vlaent) "TEST"
   '((:vlr-modified . modificaT)
   (:vlr-erased . cancellaT)  ) )
)
 
then the following function:
 
(defun cancellaT (notifier-object reactor-object parameter-list / )
   (setq ogg (vlax-vla-object->ename notifier-object))
   (if (= ogg nil)(alert "nil")) ;*******probably the object has already been deleted and then the rest of the code can not work!
   (setq id (ReadXdata ogg "TESTXDATA" "ID"))
)
 
Can you help?

[CAB]

Don't think ALERT is allowed in a reactor.
Try (princ "\nnil value)

[alanjt]

Don't think ALERT is allowed in a reactor.
Try (princ "\nnil value)

I swear it has worked for me in the past.

[CAB]

I was just guessing. Didn't feel like testing it. 

[alanjt]

I was just guessing. Didn't feel like testing it. 

I figured as much, just wanted to share my experience... or at least try and remember it.

[Lupo76]

Don't think ALERT is allowed in a reactor.
Try (princ "\nnil value)

The problem is not "alert".
The real problem is that ogg=nil so I can not get the xdata stored in it before deleting it.

Let's take an example:
The object that I have to cancel, is a block with attributes
The reactor should behave in this way:
1. The user starts the command "erase", select the object and hit return
2. The reactor part, reads the value of an attribute of the selected block, and performs other operations with this
3. The object is removed permanently.

How can I do?
Do you have any advice?

[Lee Mac]

The :vlr-erased Event will fire after the object is erased, hence the vlax-vla-object->ename will return nil when passed a VLA Object that is erased.

Maybe use a Command Reactor instead, triggered by the :vlr-commandwillstart Event, and test for the Erase command in the callback function. If the Erase command has been used, store the xData for the object.

Then, have another callback function triggered by the :vlr-commandended Event; again, testing for the Erase command and also for the data collected in the :vlr-commandwillstart callback function.

[Lupo76]

Thank you!
finally a serious answer.
it is from this morning that I surf and I write on various forums.

Unfortunately I still have not understand how to solve the problem.
Surely it is because of my low knowledge of reactors: oops:

Thanks to your information and taken some indication on the internet I wrote the following code.
It does not quite understand how I can intercept the objects that the user decides to select to manipulate them before deleting them.
Can you give me some advice if possible with a little 'code? I hope not to ask too: oops:


(setq hyp-rctCmds (vlr-command-reactor nil '((:vlr-commandCancelled . hyp-cmdAbort)
        (:vlr-commandEnded . AnnullaCmd)
        (:vlr-commandCancelled . AnnullaCmd)
        (:vlr-commandWillStart . StartCmd)
      )
    )
)
 

(defun AnnullaCmd (param1 param2)
  (if (= (car param2) "ERASE")
    (progn
      (alert "The End")
    )
  )
)
 
 
(defun StartCmd (param1 param2 / currentlayer)
    (if (= (car param2) "ERASE")
      (progn
        (alert "Erase Started")
        ;Adesso come faccio ad intercettare gli oggetti che l'utente desidera cancellare?
      )
    )
)

[CAB]

What are you trying to do to the objects before the erase?

Code - Auto/Visual Lisp: [Select]

1. (defun C:CmdOn () (Vlr_Cmd t))
2.  
3. (defun C:CmdOff () (Vlr_Cmd nil))
4.  
5. (defun Vlr_Cmd (mode)
6.   (vl-load-com)
7.   (cond
8.     (mode
9.       ;; Load only once, if already loaded reactivate it if inactive
10.       (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
11.       (and *vlr-CE (not (vlr-added-p *vlr-CE)) (vlr-add *vlr-CE))
12.       (and *vlr-CC (not (vlr-added-p *vlr-CC)) (vlr-add *vlr-CC))
13.       (or *vlr-CWS
14.          (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
15.       (or *vlr-CE
16.          (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
17.       (or *vlr-CC
18.          (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
19.       (print "Command Reactor is ON!")
20.     )
21.  
22.     ;;  Turn the reactors off
23.     (t
24.       (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
25.       (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
26.       (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
27.       (print "Command Reactor is OFF!")
28.     )
29.   )
30.   (princ)
31. )
32.  
33.  
34.  
35. (defun CmdEndCommand (Call CallBack)
36.   (if (= (strcase (car CallBack)) "ERASE")
37.     (progn
38.       (alert "The End")
39.     )
40.   )
41. )
42.  
43.  
44. (defun CmdStartCommand (Call CallBack / ss slen)
45.     (if (= (strcase (car CallBack)) "ERASE")
46.       (progn
47.         (if (setq ss (cadr(ssgetfirst)))
48.           (setq slen (sslength ss))
49.           (setq slen 0)
50.         )
51.         (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected."))
52.       )
53.     )
54. )

[Lupo76]

What are you trying to do to the objects before the erase?

Your example is very good, but does not work.
The function must check every object selected by the user for the erase operation;
If the group selection there are blocks with a given name must obtain the value of an attribute, and only later, delete objects in the selection set.

At the time, your example is fine, that is, to get me to say how many items have been selected by the user.
With your code:
1. Load the file with your lisp code in AutoCAD
2. Start the command "CmdOn"
3. Start the command "erase" and select eg. 3 items
4. get an alert that always says 0 objects have been selected.

In practice, the selection set (setq ss (CADR (ssgetfirst)) is always zero! My problem is just that!: Cry:

[irneb]

I hope I'm understanding this properly: You want to save some data (attribute or xdata) from a block just before it gets erased. I'm not sure where you want to save (backup) the data though.

The principle (since there's no such thing as a reactor for objectAboutToBeErased) is to extract that data before the erase happens, then after the erase happened to actually save it into wherever you want.

AFAIK the "simplest" way you can effectively get at this would be to use a vlr-acdb-reactor ... on a :vlr-objectOpenedForModify event you test if the ename refers to an insert of the name you know. If so extract the data from that insert into a global association list (key being the ename of the object), add this to the list - since there could be more than one block erased at the same time. Then on the :vlr-objectErased event, check using assoc on the ename of the erased object if there's data storeds in the global list, if so save this to your choice of backup medium and remove the item from the global list. You might also need to run a :vlr-objectModified event to remove the item from the list if it was only modified but not erased.

You could play around with the command reactor, but as you've noted the selection would be nil if erase was started without a PickFirst selection set. So I'm guessing this would not work in all cases.

An alternative idea would be to open a vlr-object-reactor on all the inserts matching your block name, every time the DWG opens (or make it persistent). Then you could use the :vlr-erased event since this fires when a flag is changed for the object to be erased - it only gets erased when the :vlr-goodbye event fires. Though I wouldn't recommend this idea as I've had bad experiences with object reactors. Not to mention, this would not work on blocks inserted after the DWG was opened - unless you add yet another vlr-acdb-reactor on :vlr-objectAppended.

[Lupo76]

The problem is very simple.
The solution perhaps a bit less: cry:

From your response you seem to want to solve a problem much more complicated than mine.
I am also willing to pay, just to solve the simple example of "CAB" or to issue an "alert" with the number of selected objects.
Obviously has to work, both running the command "erase" or by pressing the DEL key on the keyboard.

I tried to solve the problem with the reactor object but did not succeed (see my first post).
There are at least 4 days I try to solve this problem: 
If you had the sample code I would be very grateful!   
I do not know where to head-banging

[CAB]

Very little testing but this may be what you are looking for.

Code - Auto/Visual Lisp: [Select]

1. (defun C:CmdOn () (Vlr_Cmd t))
2.  
3. (defun C:CmdOff () (Vlr_Cmd nil))
4.  
5. (defun Vlr_Cmd (mode)
6.  (vl-load-com)
7.  (cond
8.    (mode
9.      ;; Load only once, if already loaded reactivate it if inactive
10.      (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
11.      (and *vlr-CE (not (vlr-added-p *vlr-CE)) (vlr-add *vlr-CE))
12.      (and *vlr-CC (not (vlr-added-p *vlr-CC)) (vlr-add *vlr-CC))
13.      (or *vlr-CWS
14.         (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
15.      (or *vlr-CE
16.         (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
17.      (or *vlr-CC
18.         (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
19.      (princ "\nCommand Reactor is ON!")
20.    )
21.  
22.    ;;  Turn the reactors off
23.    (t
24.      (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
25.      (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
26.      (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
27.      (princ "\nCommand Reactor is OFF!")
28.    )
29.  )
30.  (princ)
31. )
32.      
33.      
34.      
35.    
36.      
37. (defun CmdStartCommand (Call CallBack / ssErase slen)
38.    (if (= (strcase (car CallBack)) "ERASE")
39.      (progn
40.        (setq *EraseStarted* t)
41.        ;;(or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
42.        (or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
43.        (if (setq ssErase (cadr(ssgetfirst)))
44.          (setq slen (sslength ssErase))
45.          (setq slen 0)
46.        )
47.        (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected."))
48.      )
49.    )
50.   (princ)
51. )
52.  
53.  
54. (defun CmdEndCommand (Call CallBack / slen)
55.  (if (= (strcase (car CallBack)) "ERASE")
56.    (progn
57.      (setq *EraseStarted* nil) ; need for Canceled too
58.      (if (and *ErasedList (> (length *ErasedList) 0))
59.        (setq slen (length *ErasedList))
60.        (setq slen 0)
61.      )
62.      (setq *ErasedList nil)
63.      (alert (strcat "Erase Ended with " (rtos slen 2 0) " items erased."))
64.    )
65.  )
66.   (princ)
67. )
68.  
69. (defun CmdCancelCommand (Call CallBack / slen)
70.  (if (= (strcase (car CallBack)) "ERASE")
71.    (progn
72.      (setq *EraseStarted* nil) ; need for Canceled too
73. )))
74.  
75.      
76. (defun _ObjAdded (a b / nent)
77.   (if *EraseStarted*
78.     (progn
79.       (setq nent (vl-princ-to-string (cadr b)))
80.       (princ (strcat "\n" nent " Added to Drawing"))
81.     )
82.   )
83. )
84.      
85. (defun _ObjErased (a b / delent)
86.   (if *EraseStarted*
87.     (progn
88.       (if (not (vl-position (cadr b) *ErasedList))
89.         (setq *ErasedList (cons (cadr b) *ErasedList))
90.       )              
91.       (setq delent (vl-princ-to-string (cadr b)))
92.       (princ (strcat "\n" delent " Deleted From Drawing"))
93.     )
94.   )
95. )

[CAB]

Another version where the objecterased reactor is only on during the ERASE command.

Code - Auto/Visual Lisp: [Select]

1. (defun C:CmdOn () (Vlr_Cmd t))
2.  
3. (defun C:CmdOff () (Vlr_Cmd nil))
4.  
5. (setq *CmdEraseDebug* t)
6.  
7. (defun Vlr_Cmd (mode)
8.  (vl-load-com)
9.  (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; only on during the erase command
10.  ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; only on during the erase command
11.  
12.  (cond
13.    (mode
14.      ;; Load only once, if already loaded reactivate it if inactive
15.      (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
16.      (and *vlr-CE  (not (vlr-added-p *vlr-CE))  (vlr-add *vlr-CE))
17.      (and *vlr-CC  (not (vlr-added-p *vlr-CC))  (vlr-add *vlr-CC))
18.      (or *vlr-CWS
19.         (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
20.      (or *vlr-CE
21.         (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
22.      (or *vlr-CC
23.         (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
24.      (princ "\nCommand Reactor is ON!")
25.    
26.      (or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
27.      ;; (or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
28.   )
29.  
30.    ;;  Turn the reactors off
31.    (t
32.      (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
33.      (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
34.      (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
35.      (princ "\nCommand Reactor is OFF!")
36.    )
37.  )
38.  (princ)
39. )
40.      
41.      
42.      
43.    
44.      
45. (defun CmdStartCommand (Call CallBack / ssErase slen)
46.    (if (= (strcase (car CallBack)) "ERASE")
47.      (progn
48.        (and *orEra (not (vlr-added-p *orEra)) (vlr-add *orEra)) ; trun on during the erase command
49.        ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-add *orApp)) ; trun on during the erase command
50.        (setq *EraseStarted* t)
51.        (if (setq ssErase (cadr(ssgetfirst)))
52.          (setq slen (sslength ssErase))
53.          (setq slen 0)
54.        )
55.        (and *CmdEraseDebug*
56.             (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected.")))
57.      )
58.    )
59.   (princ)
60. )
61.  
62.  
63. (defun CmdEndCommand (Call CallBack / slen)
64.  (if (= (strcase (car CallBack)) "ERASE")
65.    (progn
66.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
67.      ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
68.      (setq *EraseStarted* nil) ; reset Erase command flag
69.      (if (and *ErasedList (> (length *ErasedList) 0))
70.        (setq slen (length *ErasedList))
71.        (setq slen 0)
72.      )
73.      (setq *ErasedList nil)
74.      (and *CmdEraseDebug*
75.           (alert (strcat "Erase Ended with " (rtos slen 2 0) " items erased.")))
76.    )
77.  )
78.   (princ)
79. )
80.  
81. (defun CmdCancelCommand (Call CallBack)
82.  (if (= (strcase (car CallBack)) "ERASE")
83.    (progn
84.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
85.      ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-remove *orApp)) ; turn OFF
86.      (setq *EraseStarted* nil) ; reset Erase command flag
87.      (and *CmdEraseDebug* (princ "\nErase command canceled."))
88.  
89. )))
90.  
91. ;|  This function is not used
92. (defun _ObjAdded (a b / nent)
93.   (if *EraseStarted*
94.     (progn
95.       ;;  >>---> message to mommand line
96.       (and *CmdEraseDebug*
97.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Added to Drawing")))
98.       ;;  <---<<  end message
99.     )
100.   )
101. )
102. |;
103.  
104.  
105. ;;  If ERASE command then collect ename of all erased entities
106. (defun _ObjErased (a b / delent)
107.   (if *EraseStarted*  ; flag for ERASE command started
108.     (progn
109.       ;;  may not be necessary but check the ent list to be
110.       ;;  sure the ename is not there already
111.       (if (not (vl-position (cadr b) *ErasedList))
112.         (setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
113.       )
114.       ;;  >>---> message to mommand line
115.       (and *CmdEraseDebug*
116.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing")))
117.       ;;  <---<<  end message
118.     )
119.   )
120. )

[Lupo76]

Another version where the objecterased reactor is only on during the ERASE command.

Sorry for the delay of my answer.
I do not know how to thank you for the enormous job you did!

Indeed you have solved the problem that I had requested last post, but in a way that does not fit my actual needs. 
If you read my first post you'll see that I must find the value of some XDATA stored inside objects before they are deleted.
I try to explain better:

each object can contain the following XDATA:
(-3 ("NAMEAPP" (1000 . "ID=5")))

To extract the xdata ID of an object, usually using the following function:

Code: [Select]

(setq id_obj (ReadXdata obj "NAMEAPP" "ID"))


Code: [Select]

(defun ReadXdata (ogg nomeapp labeldato / dato elist exlist thexdata labelfind dato nX sublista)
   (setq nX 0)
   (setq elist (entget ogg (list nomeapp)))
   (setq exlist (assoc -3 elist))
   (if (/= exlist nil)
     (progn
   (setq thexdata (cdr (car (cdr exlist))))
   ;--
   (setq sublista (nth nX thexdata))
   (if sublista
       (setq labelfind (splittaemi (cdr sublista) "=" 0))
       (setq labelfind nil)
   )
   (while (/= labelfind nil)
       (if (= labelfind labeldato)
(progn
    (setq sublista (nth nX thexdata))
    (if sublista (setq dato (splittaemi (cdr sublista) "=" 1)))
    (setq labelfind nil)
)
(progn
   (setq nX (+ nX 1))
   (setq sublista (nth nX thexdata))
   (if sublista
     (setq labelfind (splittaemi (cdr sublista) "=" 0))
     (setq labelfind nil)

   )
)
       )
   )
   (setq dato dato)
      )
    )
   ;--
)

Everything works fine when the object is present in the drawing.
Now I need to obtain the xdata "ID" immediately before it is deleted.
With your function unfortunately I can not do it ....

I'm sorry you missed all this time.
I am so insistent because I absolutely need to solve this problem, otherwise the interruption of the entire application. 
Hope you can help me some more ....

[irneb]

That's exactly what I was referring to. And CAB's code actually does. The only point is that instead of wanting to list the object you want its XData. So instead of the princ in CAB's _ObjErased callback you want something else.

Fine so you can call your ReadXdata here instead. But that's not going to help much as it simply retrieves the data. What do you want to do with it? Just princ it to the command line? Or should this call some other function which updates something in your app?

[Lupo76]

Having obtained the value dell'xdata this value is used to update other objects in your drawing.
The code is already written and needs only the list of values ​​of xdata contained in objects to be deleted.

I tried to change your function but it does not work:

Code: [Select]

;;  If ERASE command then collect ename of all erased entities
(defun _ObjErased (a b / delent)
  (if *EraseStarted*  ; flag for ERASE command started
    (progn
      ;;  may not be necessary but check the ent list to be
      ;;  sure the ename is not there already
      (if (not (vl-position (cadr b) *ErasedList))
        (setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
      )
      ;;  >>---> message to mommand line
      (and
        *CmdEraseDebug*
        (alert (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing"))
        ;---
        (setq ID (ReadXdata (cadr b) "NAMEAPP" "ID"))
        (alert (strcat "ID1 = " ID))
        ;---
        (setq ID (ReadXdata (vlax-ename->vla-object b) "NAMEAPP" "ID"))
        (alert (strcat "ID2 = " ID))
        ;---
        (setq ID (ReadXdata (vlax-ename->vla-object (cadr b) "NAMEAPP" "ID")))
        (alert (strcat "ID3 = " ID))
      )
      ;;  <---<<  end message
    )
  )
)


[irneb]

Sorry, should've mentioned (and noticed  ) ... CAB's is checking for a flag variable called *CmdEraseDebug* ... if this is nil that portion doesn't happen. So either place it outside the (and *CmdEraseDebug* .... ) grouping, or set *CmdEraseDebug* to something other than nil.

[CAB]

Yes I knew my code was not a complete solution. 
Untested but this should collect xData in a global variable *IDlst

Code - Auto/Visual Lisp: [Select]

1. (defun C:CmdOn () (Vlr_Cmd t))
2.  
3. (defun C:CmdOff () (Vlr_Cmd nil))
4.  
5. (setq *CmdEraseDebug* t)
6.  
7. (defun Vlr_Cmd (mode)
8.  (vl-load-com)
9.  (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; only on during the erase command
10.  ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; only on during the erase command
11.  
12.  (cond
13.    (mode
14.      ;; Load only once, if already loaded reactivate it if inactive
15.      (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
16.      (and *vlr-CE  (not (vlr-added-p *vlr-CE))  (vlr-add *vlr-CE))
17.      (and *vlr-CC  (not (vlr-added-p *vlr-CC))  (vlr-add *vlr-CC))
18.      (or *vlr-CWS
19.         (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
20.      (or *vlr-CE
21.         (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
22.      (or *vlr-CC
23.         (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
24.      (princ "\nCommand Reactor is ON!")
25.    
26.      (or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
27.      ;; (or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
28.   )
29.  
30.    ;;  Turn the reactors off
31.    (t
32.      (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
33.      (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
34.      (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
35.      (princ "\nCommand Reactor is OFF!")
36.    )
37.  )
38.  (princ)
39. )
40.      
41.      
42.      
43.    
44.      
45. (defun CmdStartCommand (Call CallBack / ssErase slen)
46.    (if (= (strcase (car CallBack)) "ERASE")
47.      (progn
48.        (and *orEra (not (vlr-added-p *orEra)) (vlr-add *orEra)) ; trun on during the erase command
49.        ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-add *orApp)) ; trun on during the erase command
50.        (setq *EraseStarted* t)
51.        (if (setq ssErase (cadr(ssgetfirst)))
52.          (setq slen (sslength ssErase))
53.          (setq slen 0)
54.        )
55.        (and *CmdEraseDebug*
56.             (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected.")))
57.      )
58.    )
59.   (princ)
60. )
61.  
62.  
63. (defun CmdEndCommand (Call CallBack / slen)
64.  (if (= (strcase (car CallBack)) "ERASE")
65.    (progn
66.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
67.      ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
68.      (setq *EraseStarted* nil) ; reset Erase command flag
69.      (if (and *ErasedList (> (length *ErasedList) 0))
70.        (progn
71.          (setq slen   (length *ErasedList)
72.                *IDlst nil)
73.          (mapcar(function(lambda(x)
74.               (setq *IDlst (cons (ReadXdata (vlax-ename->vla-object x "NAMEAPP" "ID")) *IDlst))))
75.                 *ErasedList
76.          )
77.        )
78.        (setq slen 0)
79.      )
80.      (setq *ErasedList nil)
81.      (and *CmdEraseDebug*
82.           (alert (strcat "Erase Ended with " (rtos slen 2 0) " items erased.")))
83.    )
84.  )
85.   (princ)
86. )
87.  
88. (defun CmdCancelCommand (Call CallBack)
89.  (if (= (strcase (car CallBack)) "ERASE")
90.    (progn
91.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
92.      ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-remove *orApp)) ; turn OFF
93.      (setq *EraseStarted* nil) ; reset Erase command flag
94.      (and *CmdEraseDebug* (princ "\nErase command canceled."))
95.  
96. )))
97.  
98. ;|  This function is not used
99. (defun _ObjAdded (a b / nent)
100.   (if *EraseStarted*
101.     (progn
102.       ;;  >>---> message to mommand line
103.       (and *CmdEraseDebug*
104.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Added to Drawing")))
105.       ;;  <---<<  end message
106.     )
107.   )
108. )
109. |;
110.  
111.  
112. ;;  If ERASE command then collect ename of all erased entities
113. (defun _ObjErased (a b / delent)
114.   (if *EraseStarted*  ; flag for ERASE command started
115.     (progn
116.       ;;  may not be necessary but check the ent list to be
117.       ;;  sure the ename is not there already
118.       (if (not (vl-position (cadr b) *ErasedList))
119.         (setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
120.       )
121.       ;;  >>---> message to mommand line
122.       (and *CmdEraseDebug*
123.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing")))
124.       ;;  <---<<  end message
125.     )
126.   )
127. )
128.  
129.  
130. (defun ReadXdata (ogg nomeapp labeldato / dato elist exlist thexdata labelfind dato nX sublista)
131.    (setq nX 0)
132.    (setq elist (entget ogg (list nomeapp)))
133.    (setq exlist (assoc -3 elist))
134.    (if (/= exlist nil)
135.      (progn
136.            (setq thexdata (cdr (car (cdr exlist))))
137.            ;--
138.            (setq sublista (nth nX thexdata))
139.            (if sublista
140.                (setq labelfind (splittaemi (cdr sublista) "=" 0))
141.                (setq labelfind nil)
142.            )
143.            (while (/= labelfind nil)
144.                (if (= labelfind labeldato)
145.                  (progn
146.                     (setq sublista (nth nX thexdata))
147.                     (if sublista (setq dato (splittaemi (cdr sublista) "=" 1)))
148.                     (setq labelfind nil)
149.                  )
150.                  (progn
151.                    (setq nX (+ nX 1))
152.                    (setq sublista (nth nX thexdata))
153.                    (if sublista
154.                      (setq labelfind (splittaemi (cdr sublista) "=" 0))
155.                      (setq labelfind nil)
156.  
157.                    )
158.                  )
159.                )
160.            )
161.            (setq dato dato)
162.       )
163.     )
164.    ;--
165. )  

   

[irneb]

CAB, there's something going wrong. The only thing I can get to work is using a Command will start when there's a sssetfirst. Then iterate through all the entities in that selection set, extracting the enames & their xdata into a list (where they're blocks named e.g. "TESTBLOCK").

Then if command completed list that xdata.

I've tried going the OpenedForModify route, but neither entget nor vlax-ename->vla-object gives anything (the later actually exits with error). It's as if nothing else may even read from the entity while it's being edited.

The only way I can see this happening is by searching through the database and extract ALL blocks with their xdata on an Erase command start. Then on the object erased extract that data from the list by assoc'ing on the ename returned. I.e. get the data before it gets locked by the erase command in the first place. And that would make for a very inefficient algorithm!  :pissed:

 :ugly: ... methinks this might be a job for DotNet rather. Perhaps it's Database.ObjectErased  event might just be able to read the data while it's being erased. .... Actually scratch that, from the DBObject class's help:

OpenMode.ForRead

Up to 256 readers can be opened at once, as long as object is not already open kForWrite or kForNotify. Member functions invoked when an object is opened kForRead should not cause object to be modified.

So it seems even here you cannot open an object to read its data while another process has it open to modify such data.

[Lupo76]

Yes I knew my code was not a complete solution. 
Untested but this should collect xData in a global variable *IDlst

Hello CAB,
Many thanks to you for your interest in my problem!

I tried your solution.
I had to correct the line:
(setq *IDlst (cons (ReadXdata (vlax-ename->vla-object x "NAMEAPP" "ID")) *IDlst))))

with

(setq *IDlst (cons (ReadXdata  x "NAMEAPP" "ID") *IDlst))))

But unfortunately, *IDlst is always nil     

I attach a DWG file containing some objects connected with xdata.

I'm losing my hopes   

[CAB]

OK I'll test it but please post the function splittaemi

[CAB]

This is a working version with my xData get routine.
The problem is that the xData is unavailable in a deleted entity so you must undelete it, get the xData then delete it again.

Code - Auto/Visual Lisp: [Select]

1. (defun C:CmdOn () (Vlr_Cmd t))
2.  
3. (defun C:CmdOff () (Vlr_Cmd nil))
4.  
5. (setq *CmdEraseDebug* t)
6.  
7. (defun Vlr_Cmd (mode)
8.  (vl-load-com)
9.  (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; only on during the erase command
10.  ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; only on during the erase command
11.  
12.  (cond
13.    (mode
14.      ;; Load only once, if already loaded reactivate it if inactive
15.      (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
16.      (and *vlr-CE  (not (vlr-added-p *vlr-CE))  (vlr-add *vlr-CE))
17.      (and *vlr-CC  (not (vlr-added-p *vlr-CC))  (vlr-add *vlr-CC))
18.      (or *vlr-CWS
19.         (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
20.      (or *vlr-CE
21.         (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
22.      (or *vlr-CC
23.         (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
24.      (princ "\nCommand Reactor is ON!")
25.    
26.      (or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
27.      ;; (or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
28.   )
29.  
30.    ;;  Turn the reactors off
31.    (t
32.      (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
33.      (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
34.      (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
35.      (princ "\nCommand Reactor is OFF!")
36.    )
37.  )
38.  (princ)
39. )
40.      
41.      
42.      
43.    
44.      
45. (defun CmdStartCommand (Call CallBack / ssErase slen)
46.    (if (= (strcase (car CallBack)) "ERASE")
47.      (progn
48.        (and *orEra (not (vlr-added-p *orEra)) (vlr-add *orEra)) ; trun on during the erase command
49.        ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-add *orApp)) ; trun on during the erase command
50.        (setq *EraseStarted* t
51.              *IDlst nil)
52.        
53.        (if (setq ssErase (cadr(ssgetfirst)))
54.          (setq slen (sslength ssErase))
55.          (setq slen 0)
56.        )
57.        (and *CmdEraseDebug*
58.             (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected.")))
59.      )
60.    )
61.   (princ)
62. )
63.  
64.  
65. (defun CmdEndCommand (Call CallBack / slen ent)
66.  (if (= (strcase (car CallBack)) "ERASE")
67.    (progn
68.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
69.      ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
70.      (setq *EraseStarted* nil) ; reset Erase command flag
71.      (if (and *ErasedList (> (length *ErasedList) 0))
72.        (setq slen   (length *ErasedList))
73.        (setq slen 0)
74.      )
75.      (foreach ent *ErasedList
76.        ;;(setq *IDlst (cons (ReadXdata ent "NAMEAPP" "ID") *IDlst))
77.        (setq *IDlst (cons (get-xdata ent "NAMEAPP") *IDlst))
78.      )
79.      (setq *ErasedList nil)
80.      (and *CmdEraseDebug*
81.           (princ (strcat "\nxData Colloected: " (vl-princ-to-string *IDlst))))
82.      (and *CmdEraseDebug*
83.           (alert (strcat "Erase Ended with " (rtos slen 2 0) " items erased.")))
84.    )
85.  )
86.   (princ)
87. )
88.  
89. (defun CmdCancelCommand (Call CallBack)
90.  (if (= (strcase (car CallBack)) "ERASE")
91.    (progn
92.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
93.      ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-remove *orApp)) ; turn OFF
94.      (setq *EraseStarted* nil) ; reset Erase command flag
95.      (and *CmdEraseDebug* (princ "\nErase command canceled."))
96.  
97. )))
98.  
99.  
100. ;;  If ERASE command then collect ename of all erased entities
101. (defun _ObjErased (a b / delent)
102.   (if *EraseStarted*  ; flag for ERASE command started
103.     (progn
104.       ;;  may not be necessary but check the ent list to be
105.       ;;  sure the ename is not there already
106.       ;;(if (not (vl-position (cadr b) *ErasedList)) (progn
107.         (setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
108.       ;;))
109.       ;;  >>---> message to command line
110.       (and *CmdEraseDebug*
111.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing")))
112.       ;;  <---<<  end message
113.     )
114.   )
115. )
116.  
117.  
118. (defun get-xdata (ent appName / myData)
119.   (entdel ent)
120.   (setq myData (cadr (assoc -3 (entget ent (list appName)))))
121.   (entdel ent)
122.   myData
123. )

[Lupo76]

This is a working version with my xData get routine.
The problem is that the xData is unavailable in a deleted entity so you must undelete it, get the xData then delete it again.

Very good!!
This is fantastic!     

I implemented the rest of the code and now everything is ok.
I am only sorry not to be able to thank enough.

[Lupo76]

Thanks also to everyone else for the help!

This forum is exceptional! I've saved on my favorites and carved in stone. 

[CAB]

Glad we could solve your programing problem. 

Feel free to >donate< to this web site to keep the door open
and an advertising free environment. Every little bit helps. 

[Lupo76]

Hello CAB,
Unfortunately, I noticed another problem using your code.
It is fantastic, but does not allow the cancellation of the VIEWPORT contained within paper space

The problem is in the code:

Code: [Select]

(defun get-xdata (ent appName / myData)
  (entdel ent)
  (setq myData (cadr (assoc -3 (entget ent (list appName)))))
  (entdel ent)
  myData
)

When I start the command "erase" and select a VIEWPORT you see a message saying that I have selected two objects (and not one!).
I think the problem is limited to windows, in fact, AutoCAD, in some cases, on the property, says that objects are two : VIEWPORT + POLYLINE.

I tried to edit your lisp, but I could not solve the problem.
Can you help me?

[irneb]

... in some cases, on the property, says that objects are two : VIEWPORT + POLYLINE.

That happens on clipped viewports all the time. A clipped viewport is in fact 2 entities: the rectangular viewport and the polyline defining its boundary (even if that polyline is the exact same rectangle as the viewport). So if you select any one of them, both are selected.

[CAB]

Yes Clipped VPs are two entities tied together.
http://www.theswamp.org/index.php?topic=24268.msg293389#msg293389

[Lupo76]

Hello CAB,
thanks for the answer.

I modified the function you indicated with "sel-vport" as a parameter:

Code: [Select]

(defun vp_sel (sel-vport / vpflag sel-vport entvport vptest)
  (if (= (getvar "TileMode") 1) ; in model space
    ;;------------------------------------------------
    (progn
      (alert "****  You must be in Paper Space to run this routine.  ****")
    )
    ;;------------------------------------------------
    (progn ;else in a layout
      (if (/= (getvar "cvport") 1)
        (vl-cmdf "_.pspace") ; close the view port
      )
      (setq vpflag (getvar "cvport")) ; get viewport #
      (while (= vpflag 1) ; No active viewport, Loop until one is picked
        ;(setq sel-vport (car (entsel "\nSelect view port: ")))
        (if (= sel-vport nil)
          (alert
            "You must select a viewport\r\n    --=<  Try again!  >=--"
          )
          (progn
            (setq entvport (entget sel-vport))
            (if (and ;; not all vp objects are LWPolylines
                     ;;(= (cdr (assoc 0 entvport)) "LWPOLYLINE")
                     (setq vptest (member '(102 . "{ACAD_REACTORS") entvport))
                     (setq vptest (member '(102 . "}") (reverse vptest)))
                     (assoc 330 vptest)
                )
              (setq entvport (entget (cdr (assoc 330 vptest))))
            )
            ;;  Make VP active
            (if (= (cdr (assoc 0 entvport)) "VIEWPORT")
              (progn
                (setq vpflag (cdr (assoc 69 entvport)))
                (vl-cmdf "_.mspace") ; activate the last vp active
                (setvar "cvport" vpflag) ; switch to this vp
              ) ;  endif  viewport
            )
          )
        ) ;  endif cond  sel-vport
      ) ;endwhile (= vpFlag 1)
      (vl-cmdf "_.pspace") ; close the view port
    )
  )
  ;;  return the ename of vp or nil
  (cond (entvport (cdr (assoc -1 entvport))))
)

I state that when the user selects a VIEWPORT I do not care to rescue any data on it but should simply be deleted.
I then modified the function:

Code: [Select]

(defun get-xdata (ent appName / myData a)
  (entdel ent)
  (setq myData (cadr (assoc -3 (entget ent (list appName)))))
  (if (= (vall 0 ent) "VIEWPORT")
    (progn
      (setq a (vp_sel ent))
      (entdel a)
    )
  )
  (entdel ent)
  myData
)

Unfortunately it does not work, even me error on line (setvar "cvport" vpflag). 
Can you help me?

[CAB]

Does the routine, before you modified it, work other than reporting two object?

[Lupo76]

Hello CAB,
I do not understand your question, perhaps because of my bad English. 
Interests me, retrieve, some objects xdata, before they are deleted.
Honestly, the code you posted has been considerably modified to fit my context.
I preferred not to include here all the code to avoid confusion.

The user can select multiple objects at once, I would like the function, realizes that among these objects there are one or more VIEPORT and then simply deleting them, for other objects (LINE, ARC, LWPOLYLINE, etc..) Function must, instead, return the xdata.

I hope it's clear now otherwise do not hesitate to ask.