Maybe this time I ask too much, but I trust in your readiness.
This topic, perhaps it is the continuation of this:
http://www.theswamp.org/index.php?topic=40880.0I decided to open a new topic because the request is slightly different.
Thanks to the previous topic and all your tips I wrote the following code.
Practically loading it in the file TEST.dwg that enclose, when gate one or more lines is output an alert with the contents of a xdata stored within the lines.
I modified the code as I read the same xdata even when I use the stretch command.
(defun C:CmdOn () (Vlr_Cmd t))
(defun C:CmdOff () (Vlr_Cmd nil))
(setq *CmdEraseDebug* t)
(defun Vlr_Cmd (mode)
(vl-load-com)
(and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; only on during the erase command
;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; only on during the erase command
(cond
(mode
;; Load only once, if already loaded reactivate it if inactive
(and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
(and *vlr-CE (not (vlr-added-p *vlr-CE)) (vlr-add *vlr-CE))
(and *vlr-CC (not (vlr-added-p *vlr-CC)) (vlr-add *vlr-CC))
(or *vlr-CWS
(setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . CmdStartCommand)))))
(or *vlr-CE
(setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . CmdEndCommand)))))
(or *vlr-CC
(setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . CmdCancelCommand)))))
(princ "\nCommand Reactor is ON!")
(or *orEra (setq *orEra (vlr-acdb-reactor nil '((:vlr-objecterased . _ObjErased)))))
;; (or *orApp (setq *orApp (vlr-acdb-reactor nil '((:vlr-objectappended . _ObjAdded)))))
)
;; Turn the reactors off
(t
(and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
(and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
(and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
(princ "\nCommand Reactor is OFF!")
)
)
(princ)
)
(defun CmdStartCommand (Call CallBack / ssErase slen)
(if (OR
(= (strcase (car CallBack)) "ERASE")
(= (strcase (car CallBack)) "STRETCH")
)
(progn
(and *orEra (not (vlr-added-p *orEra)) (vlr-add *orEra)) ; trun on during the erase command
;; (and *orApp (not (vlr-added-p *orApp)) (vlr-add *orApp)) ; trun on during the erase command
(setq *EraseStarted* t
*IDlst nil)
(if (setq ssErase (cadr(ssgetfirst)))
(setq slen (sslength ssErase))
(setq slen 0)
)
(and *CmdEraseDebug*
(alert (strcat "Erase Started with " (rtos slen 2 0) " items selected.")))
)
)
(princ)
)
(defun CmdEndCommand (Call CallBack / slen ent)
(if (= (strcase (car CallBack)) "ERASE")
(progn
(and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
(setq *EraseStarted* nil) ; reset Erase command flag
(if (and *ErasedList (> (length *ErasedList) 0))
(setq slen (length *ErasedList))
(setq slen 0)
)
(foreach ent *ErasedList
(setq *IDlst (cons (get-xdata ent "NAMEAPP" "ID") *IDlst))
)
(setq *ErasedList nil)
(if (/= *IDlst nil)
(foreach el *IDlst
(if el (alert (strcat "ID = " el)))
)
)
)
)
(if (= (strcase (car CallBack)) "STRETCH")
(progn
(and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
;; (and *orApp (vlr-added-p *orApp) (vlr-remove *orApp)) ; turn OFF
(setq *EraseStarted* nil) ; reset Erase command flag
(if (and *ErasedList (> (length *ErasedList) 0))
(setq slen (length *ErasedList))
(setq slen 0)
)
(foreach ent *ErasedList
(setq *IDlst (cons (get-xdata_stretch ent "NAMEAPP" "ID") *IDlst))
)
(setq *ErasedList nil)
(if (/= *IDlst nil)
(foreach el *IDlst
(if el (alert (strcat "ID = " el)))
)
)
)
)
(princ)
)
(defun CmdCancelCommand (Call CallBack)
(if (OR
(= (strcase (car CallBack)) "ERASE")
(= (strcase (car CallBack)) "STRETCH")
)
(progn
(and *orEra (vlr-added-p *orEra) (vlr-remove *orEra)) ; turn OFF
;; (and *orApp (not (vlr-added-p *orApp)) (vlr-remove *orApp)) ; turn OFF
(setq *EraseStarted* nil) ; reset Erase command flag
(and *CmdEraseDebug* (princ "\nErase command canceled."))
)))
;; 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)) (progn
(setq *ErasedList (cons (cadr b) *ErasedList)) ; collect the ename
;;))
;; >>---> message to command line
(and *CmdEraseDebug*
(princ (strcat "\n" (vl-princ-to-string (cadr b)) " Deleted From Drawing")))
;; <---<< end message
)
)
)
(defun get-xdata (ogg nomeapp labeldato / nX exlist thexdata sublista labelfind dato)
(entdel ogg)
(setq nX 0)
(setq exlist (assoc -3 (entget ogg (list nomeapp))))
(if (/= exlist nil)
(progn
(setq thexdata (cdr (car (cdr exlist))))
;--
(setq sublista (nth nX thexdata))
(if sublista
(setq labelfind (splittae (cdr sublista) "=" 0))
(setq labelfind nil)
)
(while (/= labelfind nil)
(if (= labelfind labeldato)
(progn
(setq sublista (nth nX thexdata))
(if sublista (setq dato (splittae (cdr sublista) "=" 1)))
(setq labelfind nil)
)
(progn
(setq nX (+ nX 1))
(setq sublista (nth nX thexdata))
(if sublista
(setq labelfind (splittae (cdr sublista) "=" 0))
(setq labelfind nil)
)
)
)
)
(setq dato dato)
)
)
(entdel ogg)
(if dato dato)
)
(defun get-xdata_stretch (ogg nomeapp labeldato / nX exlist thexdata sublista labelfind dato)
(entdel ogg)
(setq nX 0)
(setq exlist (assoc -3 (entget ogg (list nomeapp))))
(if (/= exlist nil)
(progn
(setq thexdata (cdr (car (cdr exlist))))
;--
(setq sublista (nth nX thexdata))
(if sublista
(setq labelfind (splittae (cdr sublista) "=" 0))
(setq labelfind nil)
)
(while (/= labelfind nil)
(if (= labelfind labeldato)
(progn
(setq sublista (nth nX thexdata))
(if sublista (setq dato (splittae (cdr sublista) "=" 1)))
(setq labelfind nil)
)
(progn
(setq nX (+ nX 1))
(setq sublista (nth nX thexdata))
(if sublista
(setq labelfind (splittae (cdr sublista) "=" 0))
(setq labelfind nil)
)
)
)
)
(setq dato dato)
)
)
(entdel ogg)
(if dato dato)
)
(defun splittae (str delim numerostringa / ptr lst el_stringhe)
(while (setq ptr (vl-string-search delim str))
(setq lst (cons (substr str 1 ptr) lst))
(setq str (substr str (+ ptr 2)))
)
(setq el_stringhe (reverse (cons str lst)))
(length el_stringhe)
(if (>= (- (length el_stringhe) 1) numerostringa)
(nth numerostringa el_stringhe)
nil
)
)
(C:CmdOn)
As mentioned it works very well with the command erases, but with the stretch command does not work.
The code that I changed is that the function "CmdEndCommand"
Can you give me some idea?
Thank you.
