Jump to content
MJLM

Reactor when entity copied. How to pass the ss

Recommended Posts

MJLM

I have two texts associated to a line. Because the texts represent some data of the line they are always considered children of the line and visible next to it. Through some lisp routines, if the data of the line change, the text entities reflect the change by changing their text. For that I have stored the handle of the line to each text as xdata and vice versa, e.g. the handles of the texts into the line.

 

The problem arises when I copy the  line with the texts where each one gets a new handle but the stored xdata are giving the old handles which leads to further problems. I thought the vlr-copied reactor could solve my problem but since I am not very proficient with reactors I cant seem to make it work. Could someone point me to the right direction? I found this

 

http://www.theswamp.org/index.php?topic=42654.0

 

but I cannot understand when I make a selection set of lines but also including non relevant other entities, how to pass the correct ss to the reactor and get the handles updated.

 

Any suggestion appreciated. Thank you.

Share this post


Link to post
Share on other sites
MJLM
Posted (edited)

First of all many many thanks to Lee Mac for helping me out on this here.

 

So I managed to do it. Next step is to have a reactor so that when the line (owner)  is deleted, the two texts (as children of the line) also get deleted. I can make a link between the line and the texts and through the call back function have them deleted. The problem now is that many many lines are assigned to the same reactor which means that there is a list of many owners. The line has the handles of the texts (e.g. 1005 code)  as Xdata but I cant use them since it is already deleted. Any ideas how could I get the info before hitting delete?

 

The other workaround I could find is to assign the reactor :vlr-erased to the text as well making them owners but it seems I m loosing it on how to get the corresponding texts and not other lines texts. This what I have come up so far. Near the end of the code the nth +1  and nth +2 object although should be the texts, it is not working properly.

 

(if (= 'vlr-object-reactor (type linedelReactor)
  (foreach n delObjLst
  	(vlr-owner-add linedelReactor n)
  )

(vlr-set-notification
	(setq linedelReactor
		;(vlr-object-reactor (list (vlax-ename->vla-object entlst)) "Line deleted Reactor"
			(vlr-object-reactor delObjLst "Line deleted Reactor"
				'((:vlr-erased . LL_delcallback))
			)
		)
		'active-document-only
	)
)


(defun LL_delcallback (notifierobj reactorobj paramls)
 
	(vlr-command-reactor "LL_deleted_re"
	   '(
			(:vlr-commandended     . LL_delended)
			(:vlr-commandcancelled . LL_delcancelled)
			(:vlr-commandfailed    . LL_delcancelled)
		)
	)
)


(defun LL_delended ( reactor params / i deletedobj vlaobj2rem)
	
	(vlr-remove reactor)
	
	(setq i -1)
	(while (setq deletedobj (nth (setq i (1+ i)) (vlr-owners linedelReactor)))
		(if (vlax-erased-p deletedobj)
			(progn
				(vla-erase (nth (1+ i) (vlr-owners linedelReactor)))
				(vla-erase (nth (+ 2 i) (vlr-owners linedelReactor)))
			)
		)
	)

(princ)
)



	
											

 

 

Here is a visualization of the problem.

 

Is Lee listening? Any one else is of course very welcome.

 

 

 

Record_2019_07_08_17_02_10_754.gif

Edited by MJLM

Share this post


Link to post
Share on other sites
Roy_043

An object reactor can monitor several events. The :vlr-openedForModify event can be used to gather Xdata before an object gets deleted. Storing the data in some sort of global list will make it available later.

Share this post


Link to post
Share on other sites
marko_ribar

Here is my version, if it can help you somehow...

 

;; | -----------------------------------------------------------------------------
;; | SSgetXD
;; | -----------------------------------------------------------------------------
;; | Function : Does an ssget and applies extended entity data check also.
;; | Arguments: 'filtr'    - Selection Set filter criteria
;; |                         Do not give Application Name with 'filtr'
;; |                         as this is given separately in the last parameter
;; |            'XdChk'    - Xdata condition to check
;; |             XdChk is in the form '('pos' 'operator' 'value')
;; |                 where
;; |                    'pos'      is the position of Xdata (starts with 1)
;; |                    'operator' is the comparison operator, can be either
;; |                               = , < , <= , >= or /=
;; |                    'value'    is the value to be checked
;; |                               wildcards can be used for string fields.
;; |                               If the 'value' parameter is a string
;; |                               and if the 'operator' is =, a literal
;; |                               equality check is done else if it is a *
;; |                               a wildcard match (wcmatch) is preformed.
;; |                    'RetFmt'   Return Format
;; |                               0 - Selection Set
;; |                               1 - List containing (ename XdataValue)
;; |
;; |            'AppName'  - Application Name to check
;; | Author   : (C) Rakesh Rao, Singapore
;; | Return   : Selection set matching criteria
;; | Updated  : 24 July 1998
;; | e-mail   : [email protected] 
;; | Web      : www.4d-technologies.com
;; | -----------------------------------------------------------------------------

(defun XD_readX (ename AppName)
  (cddr (assoc AppName (cdr (assoc -3 (entget ename (list "*"))))))
)

(defun SS_getappid ( AppName / filtr ss )

  (setq
    AppName (cdr (assoc 2 (tblsearch "APPID" AppName)))
    filtr   (append filtr (list (list -3 (list AppName))))
    ss      (ssget "_X" filtr)
  )

  ss
)

(defun SS_getallappids ( / a app appl ss )

  (setq app (cdr (assoc 2 (setq a (tblnext "APPID" t)))))
  (setq appl (cons app appl))
  (while (setq a (tblnext "APPID"))
    (setq app (cdr (assoc 2 a)))
    (setq appl (cons app appl))
  )
  (setq ss (ssadd))
  (foreach app appl
    (foreach e (if (SS_getappid app) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SS_getappid app)))))
      (ssadd e ss)
    )
  )
  
  ss
)

(defun SS_SSgetXD (filtr XdChk RetFmt AppName / ss ss1 ssl _type xd cnt ename entl itm _itm pos Operator value Lst)

  (setq
    AppName (cdr (assoc 2 (tblsearch "APPID" AppName)))
    filtr   (append filtr (list (list -3 (list AppName))))
    ss      (ssget "_X" filtr)
  )

  (if (= RetFmt 0)
    (setq ss1 (ssadd))
    (setq Lst '())
  )

  (if ss
    (progn
      (setq
        ssl      (sslength ss)
        cnt      0
        pos      (nth 0 XdChk)
        Operator (nth 1 XdChk)
        value    (nth 2 XdChk)
      )
      (repeat ssl
        (setq
          ename (ssname ss cnt)
          xd    (XD_readX ename AppName)
          cnt   (1+ cnt)
        )
        (if xd
          (progn
            (setq itm (nth (1- pos) xd))
            (if itm
              (progn
                (setq _type (type itm))
                (cond
                  ((member _type (list 'REAL 'INT))
                   (if ((eval (read Operator)) itm value)
                     (progn
                       (if (= RetFmt 0)
                         (ssadd ename ss1)
                         (setq Lst (cons (list ename itm) Lst))
                       )
                     )
                   )
                  )
                  ((= _type 'LIST)
                   (if ((eval (read Operator)) (cdr itm) value)
                     (progn
                       (if (= RetFmt 0)
                         (ssadd ename ss1)
                         (setq Lst (cons (list ename itm) Lst))
                       )
                     )
                   )
                  )
                  ((= _type 'STR)
                   (setq _itm (strcase itm))
                   (cond
                     ((= Operator "=")
                      (if (equal _itm value)
                        (progn
                          (if (= RetFmt 0)
                            (ssadd ename ss1)
                            (setq Lst (cons (list ename _itm) Lst))
                          )
                        )
                      )
                     )
                     ((= Operator "*")
                      (if (wcmatch _itm value)
                        (progn
                          (if (= RetFmt 0)
                            (ssadd ename ss1)
                            (setq Lst (cons (list ename itm) Lst))
                          )
                        )
                      )
                     )
                   )
                  )
                )
              )
            )
          )
        )
      )
    )
  )

  (if (= RetFmt 0)
    (if (> (sslength ss1) 0)
      ss1
      nil
    )
    Lst
  )
)

(defun c:linktxtss2ent ( / ent txtss i txt txtx )
  (while
    (not (setq ent (car (entsel "\nPick LINE entity to which to link texts..."))))
    (prompt "\nMissed...")
  )
  (while
    (or
      (prompt "\nSelect TEXT entities that represent LINE entity handle and LINE length...")
      (not (setq txtss (ssget "_:L" '((0 . "TEXT")))))
    )
    (prompt "\nEmpty sel.set...")
  )
  (if (not (tblsearch "APPID" "txt2entlnks"))
    (regapp "txt2entlnks")
  )
  (repeat (setq i (sslength txtss))
    (setq txt (ssname txtss (setq i (1- i))))
    (setq txtx (entget txt))
    (entupd (cdr (assoc -1 (entmod (append txtx (list (list -3 (list "txt2entlnks" '(1002 . "{") (cons 1005 (cdr (assoc 5 (entget ent)))) '(1002 . "}")))))))))
  )
  (princ)
)

(defun c:copyent-txtlinks ( / ent txtss bp dp entn i txt )
  (while
    (or
      (not (setq ent (car (entsel "\nPick LINE entity to copy along with text links..."))))
      (if ent
        (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))))
      )
    )
    (prompt "\nMissed or picked LINE entity on locked layer...")
  )
  (setq txtss (SS_SSgetXD '((0 . "TEXT")) (list 1 "=" (cdr (assoc 5 (entget ent)))) 0 "txt2entlnks"))
  (initget 1)
  (setq bp (getpoint "\nPick or specify base point : "))
  (initget 1)
  (setq dp (getpoint "\nPick or specify destination point : "))
  (vl-cmdf "_.COPY" ent "" "_non" bp "_non" dp)
  (setq entn (entlast))
  (repeat (setq i (sslength txtss))
    (setq txt (ssname txtss (setq i (1- i))))
    (vl-cmdf "_.COPY" txt "" "_non" bp "_non" dp)
    (entupd (cdr (assoc -1 (entmod (subst (cons 1 (if (= (cdr (assoc 1 (entget (entlast)))) (cdr (assoc 5 (entget ent)))) (cdr (assoc 5 (entget entn))) (cdr (assoc 1 (entget txt))))) (assoc 1 (entget (entlast) '("*"))) (subst (list -3 (list "txt2entlnks" '(1002 . "{") (cons 1005 (cdr (assoc 5 (entget entn)))) '(1002 . "}"))) (assoc -3 (entget (entlast) '("*"))) (entget (entlast) '("*"))))))))
  )
  (vlr-owner-add *TheReactor* (vlax-ename->vla-object entn))
  (vl-cmdf "_.REGEN")
  (princ)
)

(defun c:eraseent-txtlinks ( / ent txtss )
  (while
    (or
      (not (setq ent (car (entsel "\nPick LINE entity to erase along with text links..."))))
      (if ent
        (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))))
      )
    )
    (prompt "\nMissed or picked LINE entity on locked layer...")
  )
  (setq *TheReactor* (_setq-reactor-vlr-owner-remove *TheReactor* (vlax-ename->vla-object ent)))
  (setq txtss (SS_SSgetXD '((0 . "TEXT")) (list 1 "=" (cdr (assoc 5 (entget ent)))) 0 "txt2entlnks"))
  (ssadd ent txtss)
  (acet-ss-entdel txtss)
  (princ)
)

(defun _setq-reactor-vlr-owner-remove ( reactor owner / owners data typ reactions )
  (setq owners (vlr-owners reactor))
  (setq owners (vl-remove owner owners))
  (setq data (vlr-data reactor))
  (setq typ (vlr-type reactor))
  (if (= (type data) 'str)
    (setq reactions (vlr-reactions reactor))
  )
  (vlr-remove reactor)
  (if (= (type data) 'str)
    ((eval (read (substr (vl-prin1-to-string typ) 2))) owners data reactions)
    ((eval (read (substr (vl-prin1-to-string typ) 2))) owners data)
  )
)

(defun LIN:ObjReactor ( owner reactor lstename / txtss i txt txtx )
  (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename owner)))) "LINE")
    (progn
      (setq txtss (SS_SSgetXD '((0 . "TEXT")) (list 1 "=" (cdr (assoc 5 (entget (vlax-vla-object->ename owner))))) 0 "txt2entlnks"))
      (repeat (setq i (sslength txtss))
        (setq txt (ssname txtss (setq i (1- i))))
        (setq txtx (entget txt '("*")))
        (if (or (and (/= (cdr (assoc 1 txtx)) "hand") (/= (cdr (assoc 1 txtx)) (cdr (assoc 5 (entget (vlax-vla-object->ename owner)))))) (= (cdr (assoc 1 txtx)) "dist"))
          (setq txtx (subst (cons 1 (rtos (vla-get-length owner) 2 2)) (assoc 1 txtx) txtx))
          (setq txtx (subst (cons 1 (cdr (assoc 5 (entget (vlax-vla-object->ename owner))))) (assoc 1 txtx) txtx))
        )
        (entupd (cdr (assoc -1 (entmod txtx))))
      )
    )
  )
  (princ "\nReaction occured")
)

(setq *TheReactor*
  (vlr-object-reactor
    (
     (lambda ( / SS i L )
       (if (setq SS (ssget "_X" (list '(0 . "LINE") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
         (repeat (setq i (sslength SS))
           (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L))
         )
       )
       (reverse L)
     )
    )
    "Lines Object Reactor"
    '((:VLR-modified . LIN:ObjReactor))
  )
)

(vl-load-com)
(princ)

LINEREACTOR.gif.42f0043dc98fedda89b7b3cd82b6ecc3.gif

Share this post


Link to post
Share on other sites
MJLM
17 hours ago, Roy_043 said:

An object reactor can monitor several events. The :vlr-openedForModify event can be used to gather Xdata before an object gets deleted. Storing the data in some sort of global list will make it available later.

 

can the :vlr-openedForModify be used to get Xdata when the entity is simply clicked? Intent is to delete it therefore get the Xdata before gone and without a custom erase function as marko_ribar suggested.

Share this post


Link to post
Share on other sites
Roy_043

Clicking an object will not fire the :vlr-openedForModify event.

Some test code:

(defun c:Test ( / enm)
  (if (setq enm (car (entsel "\nSelect object with Xdata: ")))
    (vlr-object-reactor
      (list (vlax-ename->vla-object enm))
      nil
      '((:vlr-openedformodify . callBackOpenedForModify))
    )
  )
  (princ)
)


(defun callBackOpenedForModify (own rea lst)
  (print (entget (vlax-vla-object->ename own) '("*")))
)
  1. Load the code.
  2. Run c:Test.
  3. Erase the object selected in step #2.

Share this post


Link to post
Share on other sites
MJLM

Thanks but if I'm going to use a function to delete entities why use a reactor anyway? I d rather just select the entities, get Xdata of other entities that need to go along with the parent entities and boom, done, delete all. I only wanted to find a way to simply hit the delete button and get down the texts too. The only way I could find so far is through a list of the handles of all lines given along with their text handles, so in a way (... (linehdl txt1hdl txt2hdl)...). When the entity is deleted the callback function will check whether the entity is deleted by parsing through all the handles in the list, something like. if nil then get the handles of texts in this atom.

 

The problem with this is that am stuck with a very very important and very large global list as the lines could be thousands. I could store it in the database and call it back if nil or whatever but I m not feeling comfortable with the idea. I may try it however and see how it goes.

Share this post


Link to post
Share on other sites
Roy_043
Posted (edited)

Checking my archive I now see that grabbing Xdata from an object when it fires an :vlr-openedformodify event is possible in BricsCAD (the program I use), but not in AutoCAD.

In AutoCAD the solution is indeed to collect this data in advance.

See here for an example:

https://www.theswamp.org/index.php?topic=52466.msg573976#msg573976

Edited by Roy_043

Share this post


Link to post
Share on other sites
Roy_043
Posted (edited)

Possible alternatives:

  1. Create an AutoCAD group for each set of objects.
  2. Use a separate object reactor for each set of objects. The grouping can then be retrieved by checking the owners of the reactor.
Edited by Roy_043
Spelling...

Share this post


Link to post
Share on other sites
MJLM
Posted (edited)

Thanks.

 

When you say groups you mean standard blocks? If not, could you please elaborate a bit more?

 

Also, do you mean creating a new reactor each time a line & texts are born? I wonder if thousands of reactors for thousands of lines and texts is a prudent technique. What is the vla command to check the name of the reactor?

Edited by MJLM

Share this post


Link to post
Share on other sites
MJLM
Posted (edited)

[text erased as redundant]

Edited by MJLM

Share this post


Link to post
Share on other sites
Roy_043

In DwgCAD you can group entities with the _Group command. You can also create these groups with code. Depending on the PICKSTYLE setting, selecting one object will select all objects in the same group.

 

Having thousands of object reactors no doubt will have some effect. I have never tried this.

Share this post


Link to post
Share on other sites
MJLM

Thanks. This group functionality seems to be helpful. I will investigate.

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...