TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: HasanCAD on April 15, 2011, 12:18:10 PM
-
I am searching for simple example for reactor.
How to move an object related to another object?
-
Should be something here:
----------- Reactor ----------------
http://www.theswamp.org/index.php?topic=26380.0 Length Rector by CAB
http://www.theswamp.org/index.php?topic=8710.0 Object Reactor
http://www.theswamp.org/index.php?topic=10248.0 AreaReactor Thread
http://www.theswamp.org/index.php?topic=22733.msg273953#msg273953 Layer Create Reactor CAB
http://www.theswamp.org/index.php?topic=28604.msg349372#msg349372
http://www.theswamp.org/index.php?topic=30943.0 LeeMac text2object
----------- Close DWG Reactors -----------
http://www.theswamp.org/index.php?topic=12986.msg157991#msg157991
http://www.theswamp.org/index.php?topic=12986.msg158077#msg158077
http://www.theswamp.org/index.php?topic=26752.msg322500#msg322500
-
An example of using an Object Reactor to link a Circle and Text object, original code by Kerry, all credit to him.
;; Original Code by Kerry:
;; http://www.theswamp.org/index.php?topic=33215.msg386624#msg386624
;;
;; Modified by Lee Mac to serve as an example.
(defun c:test ( / acdoc acspc p1 rad vla-circle vla-text ) (vl-load-com)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
)
(if (or *ex:circle->text *ex:text->circle)
(progn
(foreach reactor '(*ex:circle->text *ex:text->circle)
(if (boundp reactor) (vlr-remove (eval reactor)))
(set reactor nil)
)
(princ "\n--> Reactors Disabled.")
)
(if
(and
(setq p1 (getpoint "\nSpecify Point for Circle: "))
(setq rad (getdist p1 "\nSpecify Circle Radius: "))
)
(progn
(setq p1 (vlax-3D-point (trans p1 1 0)))
(setq VLA-Circle (vla-addCircle acspc p1 rad))
(vla-put-color VLA-Circle acgreen)
(setq VLA-Text (vla-addText acspc (rtos rad 2 2) p1 (* rad 0.3)))
(vla-put-color VLA-Text acyellow)
(vla-put-alignment VLA-Text acalignmentmiddlecenter)
(vla-put-textalignmentpoint VLA-Text p1)
(setq *ex:circle->text (vlr-object-reactor (list VLA-Circle) VLA-Text '((:vlr-modified . ex:circle->text))))
(setq *ex:text->circle (vlr-object-reactor (list VLA-Text) VLA-Circle '((:vlr-modified . ex:text->circle))))
)
)
)
(princ)
)
(defun ex:circle->text ( owner reactor params )
(ex:update-text-for-circle (vlr-data reactor) owner)
)
(defun ex:text->circle ( owner reactor params )
(ex:update-circle-for-text (vlr-data reactor) owner)
)
(defun ex:update-text-for-circle ( VLA-Text VLA-Circle / rad p1 )
(if
(and
(vlax-write-enabled-p VLA-Text)
(vlax-read-enabled-p VLA-Circle)
(not (vlax-erased-p VLA-Text))
(not (vlax-erased-p VLA-Circle))
(setq rad (vla-get-radius VLA-Circle))
(setq p1 (vla-get-center VLA-Circle))
)
(progn
(vla-put-color VLA-Text acyellow)
(vla-put-insertionpoint VLA-Text p1)
(vla-put-height VLA-Text (* rad 0.3))
(vla-put-textstring VLA-Text (rtos rad 2 2))
(vla-put-alignment VLA-Text acalignmentmiddlecenter)
(vla-put-textalignmentpoint VLA-Text p1)
)
)
(princ)
)
(defun ex:update-circle-for-text ( VLA-Circle VLA-Text / rad p1 )
(if
(and
(vlax-write-enabled-p VLA-Circle)
(vlax-read-enabled-p VLA-Text)
(not (vlax-erased-p VLA-Text))
(not (vlax-erased-p VLA-Circle))
(setq rad (atof (vla-get-textstring VLA-Text)))
(setq p1 (vla-get-textalignmentpoint VLA-Text))
(not (eq rad (vla-get-radius VLA-Circle)))
(> rad 0.0)
)
(progn
(vla-put-color VLA-Circle acgreen)
(vla-put-Radius VLA-Circle rad)
(vla-put-center VLA-Circle p1)
)
)
)
(princ)
(http://www.theswamp.org/screens/leemac/ObjectReactorExample.gif)
Type 'test' to start and stop the reactors.
-
Should be something here:
That's cool, Thanks for the legwork Alan
-
You're welcome.
More here http://www.theswamp.org/index.php?topic=24700.msg359343#msg359343
I need to update the list though.
-
I cant get whats :vlr-modified for?
(defun c:reac () (vl-load-com)
(setq [color=blue]ent1VL[/color] (vlax-ename->vla-object (car (entsel)))) ; select a block
(setq [color=brown]ent2VL[/color] (vlax-ename->vla-object (car (entsel)))) ; select a block
(setq *gv-reactor-circle->text (vlr-object-reactor
(list [color=blue]ent1VL[/color])
[color=brown]ent2VL[/color]
'((:vlr-modified . xxx))
)
)
)
The relation is the block ent2VL moves refering to block ent1VL.
Please be bear with silly
-
:vlr-modified is an event that will trigger the evaluation of the reactor call-back function associated with that event - in your code: 'xxx'.
Take a look at the documentation for the vlr-object-reactor function:
(vlr-object-reactor owners data callbacks)
Arguments
owners
An AutoLISP list of VLA-objects identifying the drawing objects to be watched.
data
Any AutoLISP data to be associated with the reactor object; otherwise nil if no data.
callbacks
A list of pairs of the following form:
(event-name . callback_function)
where event-name is one of the symbols listed in the "Object Events" table and callback_function is a symbol representing a function to be called when the event fires. Each callback function accepts three arguments:
owner The owner of the VLA-object the event applies to.
reactor_object The VLR object that called the callback function.
list A list of extra data elements associated with the particular event.
Object events
... <snip> ...
:vlr-modified
The object has been modified. If the modification was canceled, also :vlr-cancelled and :vlr-modifyUndone will be fired.
... <snip> ...
-
Another more simple example, linking two blocks at their insertion points:
(defun c:test ( / _select block1 block2 ) (vl-load-com)
;;----------------------------------------;;
;; Example by Lee Mac - www.lee-mac.com ;;
;;----------------------------------------;;
(defun _select ( message predicate / selection ) (setq predicate (eval predicate))
(while
(progn (setvar 'ERRNO 0) (setq selection (car (entsel message)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\n--> Missed, Try Again.")
)
( (and (eq 'ENAME (type selection)) (not (predicate selection)))
(princ "\n--> Invalid Object Selected.")
)
)
)
)
selection
)
(if (or *object-reactor-block1 *object-reactor-block2)
(progn
(foreach reactor '(*object-reactor-block1 *object-reactor-block2)
(if (boundp reactor) (vlr-remove (eval reactor)))
(set reactor nil)
)
(princ "\n--> Reactors Disabled.")
)
(if
(and
(setq block1 (_select "\nSelect Block 1: " '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget x)))))))
(setq block2 (_select "\nSelect Block 2: " '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget x)))))))
)
(setq block1 (vlax-ename->vla-object block1)
block2 (vlax-ename->vla-object block2)
*object-reactor-block1 (vlr-object-reactor (list block1) block2 '((:vlr-modified . update-block)))
*object-reactor-block2 (vlr-object-reactor (list block2) block1 '((:vlr-modified . update-block)))
)
)
)
(princ)
)
(defun update-block ( block1 reactor params / block2 ) (setq block2 (vlr-data reactor))
(if
(and
(vlax-read-enabled-p block1)
(vlax-write-enabled-p block2)
(not (or (vlax-erased-p block1) (vlax-erased-p block2)))
)
(foreach property '(insertionpoint rotation xscalefactor yscalefactor zscalefactor)
(vlax-put-property block2 property (vlax-get-property block1 property))
)
)
(princ)
)
(princ)
(http://www.theswamp.org/screens/leemac/ObjectReactorBlock.gif)
-
Another more simple example, linking two blocks at their insertion points:
....
Thanks for great example.
-
Another more simple example, linking two blocks at their insertion points:
....
Thanks for great example.
Just noticed I could combine the callback functions - updated above.
-
Definitely great work Lee .
Thanks a lot .
-
Thanks guys, and thanks Kerry for a great example also.
-
Thanks guys, and thanks Kerry for a great example also.
If I was to rework my example I'd change the VLA-variable variable names to something like ax-variable ( ax for ActiveX)
The use I made of the VLA- prefix can be visually confused with the vl- and vla- function names built into Visual Lisp.
... just an afterthought with hindsight.
-
A fair point, although with syntax highlighting functions are easy to distinguish :-)
-
Another more simple example, linking two blocks at their insertion points:
([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] _select block1 block2 ) ([color=BLUE]vl-load-com[/color])
[color=GREEN];;----------------------------------------;;[/color]
[color=GREEN];; Example by Lee Mac - www.lee-mac.com ;;[/color]
[color=GREEN];;----------------------------------------;;[/color]
([color=BLUE]defun[/color] _select ( message predicate [color=BLUE]/[/color] selection ) ([color=BLUE]setq[/color] predicate ([color=BLUE]eval[/color] predicate))
([color=BLUE]while[/color]
([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'ERRNO 0) ([color=BLUE]setq[/color] selection ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] message)))
([color=BLUE]cond[/color]
( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'ERRNO))
([color=BLUE]princ[/color] [color=MAROON]"\n--> Missed, Try Again."[/color])
)
( ([color=BLUE]and[/color] ([color=BLUE]eq[/color] 'ENAME ([color=BLUE]type[/color] selection)) ([color=BLUE]not[/color] (predicate selection)))
([color=BLUE]princ[/color] [color=MAROON]"\n--> Invalid Object Selected."[/color])
)
)
)
)
selection
)
([color=BLUE]if[/color] ([color=BLUE]or[/color] *object-reactor-block1 *object-reactor-block2)
([color=BLUE]progn[/color]
([color=BLUE]foreach[/color] reactor '(*object-reactor-block1 *object-reactor-block2)
([color=BLUE]if[/color] ([color=BLUE]boundp[/color] reactor) ([color=BLUE]vlr-remove[/color] ([color=BLUE]eval[/color] reactor)))
([color=BLUE]set[/color] reactor [color=BLUE]nil[/color])
)
([color=BLUE]princ[/color] [color=MAROON]"\n--> Reactors Disabled."[/color])
)
([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] block1 (_select [color=MAROON]"\nSelect Block 1: "[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]eq[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] x)))))))
([color=BLUE]setq[/color] block2 (_select [color=MAROON]"\nSelect Block 2: "[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]eq[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] x)))))))
)
([color=BLUE]setq[/color] block1 ([color=BLUE]vlax-ename->vla-object[/color] block1)
block2 ([color=BLUE]vlax-ename->vla-object[/color] block2)
*object-reactor-block1 ([color=BLUE]vlr-object-reactor[/color] ([color=BLUE]list[/color] block1) block2 '(([color=BLUE]:vlr-modified[/color] . update-block)))
*object-reactor-block2 ([color=BLUE]vlr-object-reactor[/color] ([color=BLUE]list[/color] block2) block1 '(([color=BLUE]:vlr-modified[/color] . update-block)))
)
)
)
([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] update-block ( block1 reactor params [color=BLUE]/[/color] block2 ) ([color=BLUE]setq[/color] block2 ([color=BLUE]vlr-data[/color] reactor))
([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]vlax-read-enabled-p[/color] block1)
([color=BLUE]vlax-write-enabled-p[/color] block2)
([color=BLUE]not[/color] ([color=BLUE]or[/color] ([color=BLUE]vlax-erased-p[/color] block1) ([color=BLUE]vlax-erased-p[/color] block2)))
)
([color=BLUE]foreach[/color] property '(insertionpoint rotation xscalefactor yscalefactor zscalefactor)
([color=BLUE]vlax-put-property[/color] block2 property ([color=BLUE]vlax-get-property[/color] block1 property))
)
)
([color=BLUE]princ[/color])
)
([color=BLUE]princ[/color])
(http://www.theswamp.org/screens/leemac/ObjectReactorBlock.gif)
Now this is a nice code!
Too bad it don't work for me: it puts one block on the other when moving one. The insertionpoints are layed upon each other and also the rotation of both blocks are matched.
If I knew a program to create those animated gifs I'd show you!
-
Thanks Marco.
Note that the code will merely match the insertion points/rotation/scale. In my example, I use two different blocks with different insertion points:
(http://www.theswamp.org/screens/leemac/ObjectReactorDiagram.png)