Simple Object Reactor

[Hippe013]

I am having trouble defining an object reactor.

 

Here is what I have so far:

 

(defun c:go ()
 (setq obj (vlax-ename->vla-object (car (entsel "\nSelect Polyline: "))))
 ;Get Polyline Object
 (setq tobj (vlax-ename->vla-object (car (entsel "\nSelect Text: "))))
 ;Get Text Object
 (setq reactor (vlr-object-reactor (list obj) nil '((:vlr-objectClosed . updatetext))))
 ;Set the reactor
 (setq x 0)
 ;Set a counter for debugging purposes
 )
(defun updatetext (dat1 dat2 dat3)
 (princ (strcat "\nGo - " (itoa x )))
 ;Print to command line current count for debugging purposes
 (setq D1 dat1 D2 dat2 D3 dat3)
 ;Make Global for debugging purposes
 (setq a (vlax-get-property dat1 'Area))
 ;Get the Area of the Modified Polyline
 (setq a (/ a 43560.00))
 ;Convert to Acres
 (setq str (strcat "AREA = " (rtos a 2 2)))
 ;Build a String
 (vlax-put-property tobj 'TextString str)
 ;Set the String
 (setq x (+ x 1))
 ;Advance the Counter
 (princ)
 ;Exit Clean
 )

 

The problem I am encountering is that the callback is being called over and over again. I figured it should only be called once.

 

Any help is much appreciated.

 

Regards,

 

Hippe013

[BIGAL]

Dont understand what is you are doing if its update "area" as text then use a field very simple no reactors.

[Hippe013]

But BIGAL, that would be too easy! This more of an exercise in creating object reactors. Though thanks for the input.

[Tharwat]

Hi,

 

I am not that experienced guy with reactors but your thread encouraged me to read the help document, and I really find it a little bit easy this time to come up with the following codes and it might not be that excellent codes but it checks for errors that might take a place and pass over them safely and many more.

 

Please try the following program and I hope it would meet your needs of learning about reactors as it did force me to read for about two hours.

 

(defun c:Test (/ pl pl-obj tx)
 ;; Tharwat 17.Mar.2016 ;;
 (if
   (and
     (setq pl (car (entsel "\nSelect Polyline: ")))
     (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
     (setq pl-obj (vlax-ename->vla-object pl))
     (setq tx (car (entsel "\nSelect Text: ")))
     (wcmatch (cdr (assoc 0 (entget tx))) "*TEXT")
     (setq *tx-obj nil
           *tx-obj (vlax-ename->vla-object tx)
     )
   )
    (progn
      (vlax-put-property
        [b][color="red"]*[/color][/b]tx-obj
        'TextString
        (strcat "AREA = "
                (rtos (/ (vlax-get-property pl-obj 'Area) 43560.00) 2 2)
        )
      )
      (vlr-object-reactor
        (list pl-obj)
        nil
        '((:VLR-modified . UpDateTextArea))
      )
    )
 )
 (princ)
)

(defun UpDateTextArea (obj rct arg)
 (cond
   ((vlax-erased-p obj) (vlr-remove rct))
   ((vlax-erased-p *tx-obj)
    (alert "Text Object has been removed !")
   )
   (t
    (vlax-put-property
      *tx-obj
      'TextString
      (strcat "AREA = "
              (rtos (/ (vlax-get-property obj 'Area) 43560.00) 2 2)
      )
    )
   )
 )
 (princ)
)(vl-load-com)

Edited March 17, 2016 by Tharwat
asterisk was missing. updated

[BlackBox]

Most new to development, particularly those not coding in .NET, ARX, etc. are surprised to learn just how often Objects are repeatedly opened for Modify... Simply changing the Polyline's color will cause your reactor to update the text.

 

 

Some observations -

 

Once you register the reactor, store the ObjectIds for the Polyline, and Text entities as Grouped Pair in a global variable. Then within your callback function, first verify the Object being modified is the Polyline (or one in the stored list of grouped pairs), and only then update the 'paired' Text.

 

Now, you can also employ OpenedForModify event to first store the area of any 'watched' Polylines, and then upon Modified event compare the resultant area, only then updating applicable Text entities, but that's a bit more overhead.

 

Another consideration is persistent storage of your 'watched' pairs, which might include writing this information to NOD, etc., otherwise you'd have to re-assign each-and-every-single Polyline + Text each-and-every-single time the drawing is opened.

 

 

 

... These only some of the reasons you should use a Field instead; particularly if this is just for exercise, consider selecting a Polyline and inserting the necessary FieldCode for the Text to be paired.

 

 

Cheers

[Lee Mac]

Given that this exercise is just for practice with Object Reactors, to answer your original question:

 

The problem I am encountering is that the callback is being called over and over again. I figured it should only be called once.

 

The issue relates to retrieving the ActiveX area property, as this operation triggers a modification event for the polyline, which consequently causes an infinite callback loop.

 

One way to avoid this is to use vlax-curve-getarea instead:

(defun c:linkobjects ( / ply txt )
   (foreach rtr (cdar (vlr-reactors :vlr-object-reactor))
       (if (and (listp (vlr-data rtr)) (= "area-reactor" (car (vlr-data rtr))))
           (vlr-remove rtr)
       )
   )
   (if (and (setq ply (LM:selectifobject "\nSelect polyline: " "LWPOLYLINE"))
            (setq txt (LM:selectifobject "\nSelect text: "     "TEXT"))
       )
       (vlr-object-reactor
           (list (vlax-ename->vla-object ply))
           (list "area-reactor" (vlax-ename->vla-object txt))
          '((:vlr-modified . area-reactor-callback))
       )
   )
   (princ)
)
(defun area-reactor-callback ( own rtr arg / txt )
   (if (and (vlax-read-enabled-p own)
            (listp (setq txt (vlr-data rtr)))
            (= 'vla-object (type (setq txt (cadr txt))))
            (vlax-write-enabled-p txt)
       )
       (vla-put-textstring txt (strcat "AREA = " (rtos (/ (vlax-curve-getarea own) 43560.0) 2 2)))
   )
   (princ)
)

;; Select if Object  -  Lee Mac
;; Continuously prompts the user for a selection of a specific object

(defun LM:selectifobject ( msg typ / ent )
   (while
       (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent) nil)
               (   (/= typ (cdr (assoc 0 (entget ent))))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   ent
)

(vl-load-com) (princ)

[BIGAL]

A little reactor I wrote may be usefull http://www.cadtutor.net/forum/showthread.php?93661-Lisp-for-fillet-radius./page3 I have added more functions using the error trapping, code is at home will post.

[Tharwat]

The problem I am encountering is that the callback is being called over and over again. I figured it should only be called once.

 

Hi,

The culprit is the functions vlax-get-property(s) so try to replace it with vlax-curvegetarea as Lee did and it should not run than once.

 

I just found out that I need to remove the previous created reactors with the same data cause that would interact with the other already created reactors and would cause an error.

[Hippe013]

Thank you everyone for your input! Lee, thank you for the tip on vlax-curve-getarea. I didn't realize that retrieving a property of an object would be considering it modified.

[Lee Mac]

Lee, thank you for the tip on vlax-curve-getarea. I didn't realize that retrieving a property of an object would be considering it modified.

 

It shouldn't, and most properties do not behave this way, but there are many bugs within the VL ActiveX framework...