Author Topic: vlr-erased - start before cancellation  (Read 10368 times)

0 Members and 1 Guest are viewing this topic.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: vlr-erased - start before cancellation
« Reply #15 on: February 14, 2012, 04:06:14 AM »
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?
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #16 on: February 14, 2012, 07:57:16 AM »
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

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: vlr-erased - start before cancellation
« Reply #17 on: February 14, 2012, 08:14:18 AM »
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.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

CAB

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

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: vlr-erased - start before cancellation
« Reply #19 on: February 14, 2012, 03:12:39 PM »
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:
Quote
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.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #20 on: February 15, 2012, 01:26:19 AM »
Yes I knew my code was not a complete solution.  8-)
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  :cry:  :cry:  :cry:

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

I'm losing my hopes   :-(
« Last Edit: February 15, 2012, 01:29:43 AM by Lupo76 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: vlr-erased - start before cancellation
« Reply #21 on: February 15, 2012, 09:30:28 AM »
OK I'll test it but please post the function splittaemi
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: vlr-erased - start before cancellation
« Reply #22 on: February 15, 2012, 10:30:04 AM »
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.  (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; only on during the erase command
  9.  ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; only on during the erase command
  10.  
  11.  (cond
  12.    (mode
  13.      ;; Load only once, if already loaded reactivate it if inactive
  14.      (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
  15.      (and *vlr-CE  (not (vlr-added-p *vlr-CE))  (vlr-add *vlr-CE))
  16.      (and *vlr-CC  (not (vlr-added-p *vlr-CC))  (vlr-add *vlr-CC))
  17.      (or *vlr-CWS
  18.         (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
  19.      (or *vlr-CE
  20.         (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
  21.      (or *vlr-CC
  22.         (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
  23.      (princ "\nCommand Reactor is ON!")
  24.    
  25.      (or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
  26.      ;; (or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
  27.   )
  28.  
  29.    ;;  Turn the reactors off
  30.    (t
  31.      (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
  32.      (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
  33.      (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
  34.      (princ "\nCommand Reactor is OFF!")
  35.    )
  36.  )
  37.  (princ)
  38. )
  39.      
  40.      
  41.      
  42.    
  43.      
  44. (defun CmdStartCommand (Call CallBack / ssErase slen)
  45.    (if (= (strcase (car CallBack)) "ERASE")
  46.      (progn
  47.        (and *orEra (not (vlr-added-p *orEra)) (vlr-add *orEra)) ; trun on during the erase command
  48.        ;; (and *orApp (not (vlr-added-p *orApp)) (vlr-add *orApp)) ; trun on during the erase command
  49.        (setq *EraseStarted* t
  50.              *IDlst nil)
  51.        
  52.        (if (setq ssErase (cadr(ssgetfirst)))
  53.          (setq slen (sslength ssErase))
  54.          (setq slen 0)
  55.        )
  56.        (and *CmdEraseDebug*
  57.             (alert (strcat "Erase Started with " (rtos slen 2 0) " items selected.")))
  58.      )
  59.    )
  60.   (princ)
  61. )
  62.  
  63.  
  64. (defun CmdEndCommand (Call CallBack / slen ent)
  65.  (if (= (strcase (car CallBack)) "ERASE")
  66.    (progn
  67.      (and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
  68.      ;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
  69.      (setq *EraseStarted* nil) ; reset Erase command flag
  70.      (if (and *ErasedList (> (length *ErasedList) 0))
  71.        (setq slen   (length *ErasedList))
  72.        (setq slen 0)
  73.      )
  74.      (foreach ent *ErasedList
  75.        ;;(setq *IDlst (cons (ReadXdata ent "NAMEAPP" "ID") *IDlst))
  76.        (setq *IDlst (cons (get-xdata ent "NAMEAPP") *IDlst))
  77.      )
  78.      (setq *ErasedList nil)
  79.      (and *CmdEraseDebug*
  80.           (princ (strcat "\nxData Colloected: " (vl-princ-to-string *IDlst))))
  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.  
  99. ;;  If ERASE command then collect ename of all erased entities
  100. (defun _ObjErased (a b / delent)
  101.   (if *EraseStarted*  ; flag for ERASE command started
  102.     (progn
  103.       ;;  may not be necessary but check the ent list to be
  104.       ;;  sure the ename is not there already
  105.       ;;(if (not (vl-position (cadr b) *ErasedList)) (progn
  106.         (setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
  107.       ;;))
  108.       ;;  >>---> message to command line
  109.       (and *CmdEraseDebug*
  110.            (princ (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing")))
  111.       ;;  <---<<  end message
  112.     )
  113.   )
  114. )
  115.  
  116.  
  117. (defun get-xdata (ent appName / myData)
  118.   (entdel ent)
  119.   (setq myData (cadr (assoc -3 (entget ent (list appName)))))
  120.   (entdel ent)
  121.   myData
  122. )
« Last Edit: February 15, 2012, 10:35:15 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #23 on: February 16, 2012, 02:33:39 AM »
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!  :lmao:  :lmao:  :lmao:

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



Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #24 on: February 16, 2012, 02:34:57 AM »
Thanks also to everyone else for the help!

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


CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: vlr-erased - start before cancellation
« Reply #25 on: February 16, 2012, 07:14:42 AM »
Glad we could solve your programing problem.  8-)

Feel free to >donate< to this web site to keep the door open
and an advertising free environment. Every little bit helps.  :-)
« Last Edit: February 16, 2012, 07:57:19 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #26 on: April 07, 2012, 12:10:22 PM »
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 :cry: :cry:

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. :cry:
Can you help me? :oops:

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: vlr-erased - start before cancellation
« Reply #27 on: April 09, 2012, 10:07:44 AM »
... 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.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: vlr-erased - start before cancellation
« Reply #28 on: April 09, 2012, 11:57:11 AM »
Yes Clipped VPs are two entities tied together.
http://www.theswamp.org/index.php?topic=24268.msg293389#msg293389
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lupo76

  • Bull Frog
  • Posts: 343
Re: vlr-erased - start before cancellation
« Reply #29 on: April 10, 2012, 09:24:38 AM »
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).  :cry:
Can you help me?