Topic: Link Circle's Radiuses - Using Object Reactor and ??? Reactor

[Grrr1337]

Hi guys,
I was wondering could someone help me to figure this out:

1. Initial settings: Select circles to link their radiuses - set default radius value of 50
2. Reactor's action: When One of the circle's radius is modified match the radiuses of the rest of the circles to the one we just modified


So my thinking logic is to:

1.Select few circles, apply to them the same radius, include them in a list as vla-objects
2.Include them in a Object reactor to be watched
3.In the callback check for every watched object's radius and activate ?X? reactor (I'm not sure what type) that will match the radiuses, then immediately remove the ?X? reactor
 

Does that approach seems right?
What would be the most appropriate second ?X? reactor?

[Grrr1337]

Ok, this seems to work:

Code - Auto/Visual Lisp: [Select]

1. (defun C:LockRadius ( / SS i o )
2.   (setq *CR_Radius* 50) ; initial radius
3.   (cond ; Using "CR" prefix ("Circle Radius") for all global variables
4.     ( (setq SS (ssget "_:L-I" '((0 . "CIRCLE"))))
5.       (and *CR_Lowners* *CR_Ortr* (mapcar (function (lambda (x) (vlr-owner-remove *CR_Ortr* x))) *CR_Lowners*))
6.       (and *CR_Lowners* (setq *CR_Lowners* nil))
7.       (and *CR_Ortr* (vlr-remove *CR_Ortr*) (setq *CR_Ortr* nil))
8.       (repeat (setq i (sslength SS))
9.         (setq *CR_Lowners* (cons (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) *CR_Lowners*))
10.         (vla-put-Radius o *CR_Radius*)
11.       ); repeat
12.       (foreach rtr (cdar (vlr-reactors :VLR-Object-Reactor)) (if (= "CircleRadiuses" (vlr-data rtr)) (vlr-remove rtr)) )
13.       (setq *CR_Ortr* (VLR-Object-Reactor *CR_Lowners* "CircleRadiuses" '((:VLR-modified . CR_Object:CB)))) ; globalise it for the (CR_Editor:CB)
14.      
15.       (foreach rtr (cdar (vlr-reactors :VLR-Editor-Reactor)) (if (= "CircleRadiuses" (vlr-data rtr)) (vlr-remove rtr)) )  
16.       (VLR-Editor-Reactor "CircleRadiuses" '((:VLR-commandEnded . CR_Editor:CB)(:VLR-lispEnded . CR_Editor:CB)))
17.     )
18.   ); cond
19.   (princ)
20. ); defun C:LockRadius
21.  
22. (defun C:UnLockAllRadiuses ( / ) ; DO NOT localise the global variables to remove them.
23.   (vlr-remove *CR_Ortr*) ; doesn't work if localised here
24.   (mapcar (function (lambda (x) (vlr-owner-remove *CR_Ortr* x))) *CR_Lowners*)
25.   ; (foreach rtr (cdar (vlr-reactors :VLR-Object-Reactor)) (if (= "CircleRadiuses" (vlr-data rtr)) (vlr-remove rtr)) )
26.   (foreach rtr (cdar (vlr-reactors :VLR-Editor-Reactor)) (if (= "CircleRadiuses" (vlr-data rtr)) (vlr-remove rtr)) )  
27.   (mapcar 'set '(*CR_Ortr* *CR_Lowners* *CR_Radius*) '(nil nil nil))
28.   (princ)
29. ); defun C:UnLockAllRadiuses
30.  
31. (defun CR_Object:CB ( ownr rtr args )
32.   (setq *CR_Radius* (vla-get-Radius ownr)) ; store to pass this flag to the (CR_Editor:CB)
33.   (mapcar (function (lambda (x) (vlr-owner-remove rtr x))) *CR_Lowners*)  ; remove all objects (from watching) (this is temporarily)
34.   (princ)
35. ); defun CR_Object:CB
36.  
37. (defun CR_Editor:CB ( rtr args )
38.   (cond
39.     (*CR_Radius* ; check flag if theres list to process
40.       (mapcar (function (lambda(x) (and (vlax-write-enabled-p x) (vla-put-Radius x *CR_Radius*)))) *CR_Lowners*) ; apply changes
41.       (mapcar (function (lambda (x) (vlr-owner-add *CR_Ortr* x))) *CR_Lowners*) ; reinclude all objects in the reactor
42.       (setq *CR_Radius* nil) ; restore - so it wont stack and to avoid redundant modifications
43.     ); *CR_Radius*
44.   ); cond
45.   (princ)
46. ); defun CR_Editor:CB
47.  

[Crank]

OK if you've a lot of circles, but have you considered to use constraints?

[Grrr1337]

I am aware of dimensional constrants,
Actually I was wondering more about how to construct properly such object reactor - so came up with that simple example.
Other variation might be to link text contents, using the same approach.

[Lee Mac]

Providing you can prevent a reactor-callback loop, this form of task can be accomplished using a single reactor, e.g.:

Code - Auto/Visual Lisp: [Select]

1. (defun c:radlink ( / idx lst sel )
2.     (foreach rtr (cdar (vlr-reactors :vlr-object-reactor))
3.         (if (= "radlink" (vlr-data rtr)) (vlr-remove rtr))
4.     )
5.     (if (setq sel (ssget "_:L" '((0 . "CIRCLE"))))
6.         (progn
7.             (repeat (setq idx (sslength sel))
8.                 (setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
9.             )
10.             (radlink-callback (car lst) (vlr-object-reactor lst "radlink" '((:vlr-modified . radlink-callback))) nil)
11.         )
12.     )
13.     (princ)
14. )
15. (defun radlink-callback ( own rtr arg / rad )
16.     (if (and (vlax-read-enabled-p own) (setq rad (vla-get-radius own)))
17.         (foreach obj (vlr-owners rtr) (radlink-updateradius obj rad))
18.     )
19. )
20. (defun radlink-updateradius ( obj rad )
21.     (if (and (vlax-read-enabled-p obj)
22.              (not (equal (vla-get-radius obj) rad 1e-8))
23.              (vlax-write-enabled-p obj)
24.         )
25.         (vla-put-radius obj rad)
26.     )
27. )
28. (vl-load-com) (princ)

Demo:

[Grrr1337]

Wow Lee, thats very clever how you applied the initial radius!
I thought that I would get error for trying to modify a object thats being watched by the object reactor.
So I went with some old advice of yours posted somewhere about wiring-up two reactors.

Not sure but I think that the trick that makes the your routine successful is that you iterate over the all owners, to make modifications,
bypassing the "own" argument inside the radlink-callback ..with.. Some printed results:

Code: [Select]

(vlax-read-enabled-p own) -> T
(vlax-write-enabled-p own) -> nil

So even if the callback was like this it still works (tested) :

Code - Auto/Visual Lisp: [Select]

1. (defun radlink-callback ( own rtr arg / rad )
2.   (if (and (vlax-read-enabled-p own) (setq rad (vla-get-radius own)))
3.     (foreach obj (vlr-owners rtr)
4.       (if (and (vlax-read-enabled-p obj)
5.         (not (equal (vla-get-radius obj) rad 1e-8))
6.         (vlax-write-enabled-p obj)
7.       )
8.       (vla-put-radius obj rad)
9.       )
10.     )
11.   )
12. )

So overall the approach I tried may be useful only if its intended to modify the watched object "own",
Such as storing it as a global variable to be processed by the same/another reactor - For instance changing circle's layer if its modified.

Thank you, again!

[Lee Mac]

Thanks Grrr1337 

Since the owner which triggers evaluation of the callback function has the target radius, the expression (not (equal (vla-get-radius obj) rad 1e-8)) will return false when this owner is processed by the function to update the radius, avoiding the infinite callback loop.

Lee

[Grrr1337]

Ah now I see why you did that, however (vlax-write-enabled-p own) would always return nil, i.e. if foreach reaches that same object - that check should prevent attempting the radius modification, but still the radius comparsion would backup the error-proof code (aswell skipping circles that already have the radius).
BTW another alternative could be to use :VLR-AcDb-Reactor with :VLR-objectModified event - but I'm guessing that the callback will be similair to the :VLR-Object-Reactor's - and even less efective since the "watched" objects will be all objects in the drawing (not a relatively small range).
Object reactors seem the hardest type of reactors to work with - but theres also alot of fun.

Overall the main thing I like is that you provide perfect examples that actually work!

EDIT: Oh now I visualised what you mean - processing all owners in the callback function in a infinite loop.

[thanhduan2407]

Can you help me if replace "Circle" => Text ?
Thanks Lee Mac very much!
I'm newbie!

Edit: while wait....i have do that. But.....if many Objects => Autocad => Exit.
If i want to save event when later, it can is continue
Can you help me?

[Grrr1337]

Can you help me if replace "Circle" => Text ?
Thanks Lee Mac very much!

Learning from LM's, the following structure should work:

Code - Auto/Visual Lisp: [Select]

1. ; Link the Text Content of the selected objects (only for objects that have 'TextString Property)
2. ; TxtLinkOn - to enable the reactor
3. ; TxtLinkOff - to disable the reactor
4. ; TxtUnLink - to unlink selection (exclude)
5. ; TxtLink - to link selection (include)
6.  
7. (defun C:TxtLinkOn ( / L )
8.   (cond
9.     ( (not TxtLink:CB) (princ "\nError: \"TxtLink:CB\" not defined.") )
10.     ( (setq L (_Sel "Select texts to Link: " '((0 . "*TEXT")) nil))
11.       (_RemoveReactor :vlr-object-reactor "TextLink" nil)
12.       (TxtLink:CB (car L) (vlr-object-reactor L "TextLink" '((:vlr-modified . TxtLink:CB))) nil)
13.       (alert (strcat "\n\"TextLink\" Reactor enabled!"))
14.     ); L
15.   ); cond
16.   (princ)
17. ); defun C:TxtLinkOn
18.  
19. (defun C:TxtLinkOff nil (_RemoveReactor :vlr-object-reactor "TextLink" T) (princ) )
20.  
21. (defun C:TxtUnLink ( / rtr sL L)
22.   (and (setq rtr (_Reactorp :vlr-Object-reactor "TextLink"))
23.     ; (_Sel "Select texts to UnLink: " '((0 . "*TEXT")) (lambda (o) (vlr-owner-remove rtr o))) ; NOT WORKING - WHY?
24.     (setq sL (_Sel "Select texts to UnLink: " '((0 . "*TEXT")) nil)) ; The above row is not working, redefine the reactor then!
25.     (setq L (vlr-owners rtr))
26.     (progn
27.       (_RemoveReactor :vlr-object-reactor "TextLink" nil)
28.       (vlr-object-reactor (vl-remove-if (function (lambda (x) (member x sL))) L) "TextLink" '((:vlr-modified . TxtLink:CB)))
29.     ); progn
30.   ); and
31.   (princ)
32. ); defun C:TxtUnLink
33.  
34. (defun C:TxtLink ( / rtr s )
35.   (and (setq rtr (_Reactorp :vlr-Object-reactor "TextLink")) (setq s (vla-get-TextString (car (vlr-owners rtr))))
36.     (_Sel "Select texts to Link: " '((0 . "*TEXT")) (lambda (o) (vla-put-TextString o s) (vlr-owner-add rtr o)))
37.   ); and
38.   (princ)
39. ); defun C:TxtLink
40.  
41. ; Callback Function:
42.  
43. (defun TxtLink:CB ( own rtr arg / txt )
44.   (and (vlax-read-enabled-p own) (vlax-property-available-p own 'TextString) (setq txt (vla-get-TextString own))
45.     (foreach o (vlr-owners rtr)
46.     (and
47.       (vlax-read-enabled-p o) (/= (vla-get-TextString o) txt)
48.       (vlax-write-enabled-p o) (vla-put-TextString o txt)
49.     ); and
50.   ); foreach
51.   ); and
52. ); defun TxtLink:CB
53.  
54. ; SubFunctions:
55.  
56. (defun _Sel ( msg ssft mapfoo / SS i o L )
57.   (cond ; prompt for a filtered SS and map a function
58.     (
59.       (and
60.         (princ (strcat "\n" (if (eq 'STR (type msg)) msg "")))
61.         (setq SS (apply 'ssget (append '("_:L-I") (if ssft (list ssft)))) )
62.       ); and
63.       (repeat (setq i (sslength SS))
64.         (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
65.         (setq L (cons (if mapfoo (mapfoo o) o) L))
66.       ); repeat
67.       (reverse L)
68.     )
69.   ); cond
70. ); defun _Sel
71.  
72. (defun _RemoveReactor ( RtrType RtrName msg )
73.   (foreach r (cdar (vlr-reactors RtrType)) (if (= RtrName (vlr-data r)) (vlr-remove r)) )
74.   (if msg (alert (strcat "\n\"" RtrName "\" Reactor disabled!")))
75. ); defun _RemoveReactor
76.  
77. (defun _Reactorp ( RtrType RtrName ) ; Should return the reactor object if present
78.   (vl-some (function (lambda (x) (if (= RtrName (vlr-data x)) x)))(cdar (vlr-reactors RtrType)))
79. ); defun _Reactorp
80.  

Ofcourse no XDATA attaching/detaching nor external .txt file that stores the object's handles - which means it won't work if you reopen the drawing.

[thanhduan2407]

Thanks Grrr1337 very much!
I learning from LM's too!

Code: [Select]

(defun C:LTEXT (/ IDX LST SEL)
  (setq sel (ssget "_:L" '((0 . "*TEXT,MTEXT"))))
  (IF sel
    (progn
      (repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object
  (ssname sel (setq idx (1- idx)))
)
lst
  )
)
      )
      (Tlink-callback
(car lst)
(vlr-object-reactor
  lst
  "Tlink"
  '((:vlr-modified . Tlink-callback))
)
nil
      )
    )
  )
  (Alert
    (strcat
      "C\U+00F3 t\U+1EA5t c\U+1EA3 "
      (rtos (sslength sel) 2 0)
      " \U+0111\U+01B0\U+1EE3c link li\U+00EAn k\U+1EBFt v\U+1EDBi nhau"
    )
  )
  (Princ)
)
(defun c:RLTEXT ()
  (foreach rtr (cdar (vlr-reactors :vlr-object-reactor))
    (if (= "Tlink" (vlr-data rtr))
      (vlr-remove rtr)
    )
  )
  (Alert "\U+0110\U+00E3 x\U+00F3a Link Text")
  (princ)
)

(defun Tlink-callback (own rtr arg / h)
  (if (and (vlax-read-enabled-p own) (setq h (vla-get-height own)))
    (foreach obj (vlr-owners rtr) (Tlink-updateHeight obj h))
  )
)
(defun Tlink-updateHeight (obj h)
  (if (and (vlax-read-enabled-p obj)
   (not (equal (vla-get-height obj) h 1e-8))
   (vlax-write-enabled-p obj)
      )
    (vla-put-height obj h)
  )
)

However, with multi Object (Ex: Quantity Max > 200 Object) => Program Exit. Report "warning unwind skipped on exception...".
Is there a way to fix this?
Thanks Grrr1337 have reply!