Author Topic: Reactor question  (Read 33875 times)

0 Members and 1 Guest are viewing this topic.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #45 on: February 15, 2006, 07:21:20 PM »
I just tested my routine with out the unerase reactor, and it worked fine.  When I had it in, the way I did it, it was associate a new reactor with each undo, or oops after I erased.  So if I oops 4 times on the same object, it would have 5 reactors attached to it, but when I took it out, it only had one.  But I just ran into a new problem, which I would consider a big one.  With the code now, you can only undo once.  Say you stretch the object twice, the first undo will work, but the second one says "Nothing to undo".  And ideas why?
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Re: Reactor question
« Reply #46 on: February 15, 2006, 07:26:49 PM »

Nice routine guys. Can this be made to work with an attributed block?
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

LE

  • Guest
Re: Reactor question
« Reply #47 on: February 15, 2006, 07:30:32 PM »
Say you stretch the object twice, the first undo will work, but the second one says "Nothing to undo".  And ideas why?

What code are you using ?

Also, any reason why you have this:

Code: [Select]
(if (not GlbReactorCommandEnd)
(setq GlbReactorCommandEnd (vlr-command-reactor nil '((:vlr-commandEnded . AdjustTextObj))))
)

Inside of MakeCmdEndReactor ?

Why not simple place that out side ?

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #48 on: February 15, 2006, 07:37:19 PM »
What code are you using ?
My latest, here.
Code: [Select]
(defun c:AreaReact (/ Sel EntData PolyObj TextObj ReactList Pos)

;|  Adds a presistant reactor to a polyline object that
    updates a selected text object to the polylines area
    in square feet.  You will have to have the subs loaded
    in everydrawing for it to work, so that it know what
    to do with the reactor, because it is saved with the
    drawing.  Saves the association between the text
    and the polyline in the extension dictionary of the
    polyline.
    Thanks to Luis Esquivel for his help and guidance.
|;

(if
 (and
  (setq Sel (entsel "\n Select polyline to get area of: "))
  (setq EntData (entget (car Sel)))
  (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
  (setq PolyObj (vlax-ename->vla-object (car Sel)))
  (setq Sel (entsel "\n Select text of hold area value: "))
  (setq EntData (entget (car Sel)))
  (vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT"))
  (setq TextObj (vlax-ename->vla-object (car Sel)))
 )
 (progn
  (PutArea PolyObj TextObj)
  (if
   (and
    (setq ReactList (AssociatedReactors PolyObj))
    (setq Pos (vl-position "MyAreaReactorModified" (mapcar 'vlr-data ReactList)))
   )
   (vlr-remove (nth Pos ReactList))
  )
  (vlr-pers
   (vlr-object-reactor
    (list PolyObj)
    "MyAreaReactorModified"
    '(
     (:vlr-modified . MakeCmdEndReactor)
     (:vlr-erased . ObjectEraseReactor)
;     (:vlr-unerased . ObjectUnErasedReactor)
    )
   )
  )
 )
)
(princ)
)
;---------------------------------------------------------------------------------------------------------------
(defun PutArea (PolyObj TextObj / Dict xRec SqFt)

(setq Dict (vla-GetExtensionDictionary PolyObj))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor"))))
 (setq xRec (vla-AddXRecord Dict "MyAreaReactor"))
)
(MySetXrec xRec '(40 1) (list (vlax-get PolyObj 'Area) (vlax-get TextObj 'Handle)))
(setq SqFt (/ (vla-get-Area PolyObj) 144.0))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) " SQ.FT."))
xRec
)
;----------------------------------------------------------------------------------------------------------------
(defun MakeCmdEndReactor (Obj React NotSure)

(if GlbVarAreaObject
 (setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
 (setq GlbVarAreaObject (list Obj))
)
(if (not GlbReactorCommandEnd)
 (setq GlbReactorCommandEnd (vlr-command-reactor "tempAreaCommandReactor" '((:vlr-commandEnded . AdjustTextObj))))
)
(princ)
)
;------------------------------------------------------------------------------------------------------------------
(defun ObjectEraseReactor (Obj React NotSure)

(vlr-pers-release React)
(vlr-remove React)
)
;-----------------------------------------------------------------------------------------------------------------
(defun ObjectUnErasedReactor (Obj React NotSure)

(vlr-pers
 (vlr-object-reactor
  (list Obj)
  "MyAreaReactorModified"
  '(
   (:vlr-modified . MakeCmdEndReactor)
   (:vlr-erased . ObjectEraseReactor)
   (:vlr-unerased . ObjectUnErasedReactor)
  )
 )
)
)
;-----------------------------------------------------------------------------------------------------------------
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
 (if (not (vlax-erased-p Obj))
  (progn
   (setq Dict (vla-GetExtensionDictionary Obj))
   (if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor")))))
    (progn
     (setq xRecList (MyGetXRec xRec))
     (if
      (and
       (setq TextObj (vlax-ename->vla-object (setq tmpEnt (handent (cdr (assoc 1 xRecList))))))
       (not (vlax-erased-p TextObj))
      )
      (PutArea Obj TextObj)
     )
    )
   )
  )
 )
)
(setq GlbVarAreaObject nil)
(vlr-remove GlbReactorCommandEnd)
(setq GlbReactorCommandEnd nil)
)
;---------------------------------------------------------------------------
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
 )
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
 )
)
)
;-----------------------------------------------------------------------------
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
 Obj
 'CodeType
 'DataType
)
(if (and CodeType DataType)
 (mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
 )
)
)
;-------------------------------------------------------------------------------------
(defun AssociatedReactors (Obj / ReactList)
; Return a list of reactors (object type) associated with an object.
; Use like (AssociatedReactors (vlax-ename->vla-object (car (entsel))))

(foreach i (cdar (vlr-reactors :vlr-object-reactor))
 (if (vl-position Obj (vlr-owners i))
  (setq ReactList (cons i ReactList))
 )
)
ReactList
)
;---------------------------------------------------------------------------
(defun RemovePersReact ()
; Remove persistant reactors that don't have an owner.

(foreach i (vlr-pers-list)
 (if (not (vlr-owners i))
  (progn
   (vlr-pers-release i)
   (vlr-remove i)
  )
 )
)
)
Also, any reason why you have this:

Code: [Select]
(if (not GlbReactorCommandEnd)
(setq GlbReactorCommandEnd (vlr-command-reactor nil '((:vlr-commandEnded . AdjustTextObj))))
)

Inside of MakeCmdEndReactor ?

Why not simple place that out side ?
I was thinking that having it there, then it will only work when one of the objects that are defined by the command is modified.  I didn't want to have the reactor just floating out there for anything to fire it.  I thought this was a safer (more secure) way to handle the reactor.

Nice routine guys. Can this be made to work with an attributed block?

Thanks.  I don't think it would be hard to do at all.  That is also on the assumption that attribute handles don't change when opening and closing a drawing.  In the first portion of the code, where it ask to select a text object, change "entsel" to "nentsel", and it should work for nested objects.  Also you will need to change this line
(vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT"))
to
(vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT" "ATTRIB"))
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Reactor question
« Reply #49 on: February 15, 2006, 07:41:21 PM »
Change this:

Code: [Select]
(defun MakeCmdEndReactor  (Obj React NotSure)
  (if (not (wcmatch
     (getvar "cmdnames")
     "U,UNDO,REDO,OOPS"))
    (progn
     
      (if GlbVarAreaObject
(setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
(setq GlbVarAreaObject (list Obj)))
      (if (not GlbReactorCommandEnd)
(setq GlbReactorCommandEnd
       (vlr-command-reactor
nil
'((:vlr-commandEnded . AdjustTextObj))))) ))
  (princ))

I see that you did not tested your code with the changes I did previously....

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #50 on: February 15, 2006, 07:56:42 PM »
I can't test now because I"m at home, but I didn't think I had to do that.  I want the reactor to fire if an undo is done that affected the polyline object, won't what you put not allow that?  I will test this in the morning when I get to work.

It looks like the wording of your other post, that there is no other way to do it than that way.  I hope it works for my routine.  Thanks again.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Reactor question
« Reply #51 on: February 16, 2006, 09:28:26 AM »
that there is no other way to do it than that way.

What I simple been trying to do here, is to provide a work of years of research, that does not means that is right/wrong/or the only way.... it is just something that works.

Please, use what I have posted as just another example...  :-)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #52 on: February 16, 2006, 10:17:04 AM »
What I simple been trying to do here, is to provide a work of years of research, that does not means that is right/wrong/or the only way.... it is just something that works.

Please, use what I have posted as just another example...  :-)
That works sweet!!!  Thanks Luis!!!  I thought it wouldn't work right because it wouldn't fire with an undo, but it does, and it updates the polyline. THANKS A WHOLE LOT LUIS, for staying with me, and sharing your knowledge!!

I will continue to check it to see if there is anything else I need to do to it, but right now I think it works that way it should.  The only think I changed is what Luis posted, but here is my version, which is the same, just in my style.
Code: [Select]
(defun MakeCmdEndReactor (Obj React NotSure)

(if (not (wcmatch (getvar "cmdnames") "U,UNDO,REDO,OOPS"))
 (progn
  (if GlbVarAreaObject
   (setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
   (setq GlbVarAreaObject (list Obj))
  )
  (if (not GlbReactorCommandEnd)
   (setq GlbReactorCommandEnd (vlr-command-reactor "tempAreaCommandReactor" '((:vlr-commandEnded . AdjustTextObj))))
  )
 )
)
(princ)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #53 on: February 16, 2006, 10:29:45 AM »
Here is the latest version that I am happy with.  Have fun, and let me know if it doesn't work correctly.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LE

  • Guest
Re: Reactor question
« Reply #54 on: February 16, 2006, 01:32:10 PM »

LUCAS

  • Newt
  • Posts: 32
Re: Reactor question
« Reply #55 on: February 17, 2006, 07:08:27 PM »
Here is the latest version that I am happy with.  Have fun, and let me know if it doesn't work correctly.

;;make sure the textobj can write
(vlax-write-enabled-p textobj)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #56 on: February 17, 2006, 07:12:01 PM »
Here is the latest version that I am happy with.  Have fun, and let me know if it doesn't work correctly.

;;make sure the textobj can write
(vlax-write-enabled-p textobj)
Thanks for the tip, I never thought of that.  I don't think I have ever seen that.  Is that only controlled by code?
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

LUCAS

  • Newt
  • Posts: 32
Re: Reactor question
« Reply #57 on: February 17, 2006, 11:50:24 PM »
The most important thing is objectdbx is not support to open a persistent reactors dwg.

LUCAS

  • Newt
  • Posts: 32
Re: Reactor question
« Reply #58 on: February 19, 2006, 07:02:17 PM »
Here is the latest version that I am happy with.  Have fun, and let me know if it doesn't work correctly.

1.only del the textobj then do several modify-----like modify the ployline, then undo back the textobj, reactor fail
2.only del the textobj then save, reopen then dwg, reactor fail

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Reactor question
« Reply #59 on: February 21, 2006, 11:49:04 AM »
1.only del the textobj then do several modify-----like modify the ployline, then undo back the textobj, reactor fail
I wanted it to work this way that is why I put a prompt telling them that the reactor was erased.
Quote from: Acad command line
Command: areareact

 Select polyline to get area of:
 Select text of hold area value:
Command:
Command: e ERASE
Select objects: Specify opposite corner: 1 found

Select objects:
Command: Specify opposite corner:
Command:

** STRETCH **
Specify stretch point or [Base point/Copy/Undo/eXit]:
 Reactor has be removed because the text object has been erased.

2.only del the textobj then save, reopen then dwg, reactor fail
This one I don't like.  When I did this, it was a bad error, and I didn't like seeing that, so here is the fix.  Replace the function in the lisp file with this one.
Code: [Select]
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
 (if (not (vlax-erased-p Obj))
  (progn
   (setq Dict (vla-GetExtensionDictionary Obj))
   (if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor")))))
    (progn
     (setq xRecList (MyGetXRec xRec))
     (if
      (and
       (setq tmpEnt (handent (cdr (assoc 1 xRecList))))
       (setq TextObj (vlax-ename->vla-object tmpEnt))
       (not (vlax-erased-p TextObj))
      )
      (PutArea Obj TextObj)
      (progn
       (foreach i (AssociatedReactors Obj)
        (if (= (vlr-data i) "MyAreaReactorModified")
         (progn
          (vlr-pers-release i)
          (vlr-remove i)
         )
        )
       )
       (prompt "\n Reactor has be removed because the text object has been erased.")
      )
     )
    )
   )
  )
 )
)
(setq GlbVarAreaObject nil)
(vlr-remove GlbReactorCommandEnd)
(setq GlbReactorCommandEnd nil)
)

Thanks for testing and posting back about the code Lucas.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.