Modified Object Reactor

[bweir]

I'm trying to create a Lisp that will change the properties of a dynamic block automatically for the user when they've preformed some action to the block. I'm using the following code to create the reactor.

(setq ObjectAppendedReactor (VLR-AcDb-Reactor nil '((:vlr-objectAppended . ObjectChanged))))
(setq ObjectChagnedReactor (VLR-AcDb-Reactor nil '((:vlr-objectModified . ObjectChanged))))

I'm running into a problem where I get the following error quite often and not sure how to fix this. Sometimes AutoCAD will crash.
; error: Exception occurred: 0xC0000005 (Access Violation)
I understand that you can not modify and object that is locked by another operation. Should I use a different reactor to change the block properties?

[dgorsman]

If I get you right, you have the reactor set up to modify the block that the reactor is watching?

[peter]

I would suggest you create a command ended reactor.

The object modified reactor would set a flag to trigger the command ended reactor to make the change. Make sure you create a boolean flag to prevent the object reactor from triggering when the command reactor changes the object.

Flow chart list.

Monitor object (dynamic block) for change

When change occurs to block add block vla-object to a list of changed blocks.

When command ends the commandend reactor fires.

Set a boolean flag to prevent the object modified reactor from running while the command ended reactor makes the changes.

Make change to each item in the list of changed objects

set the boolean flag back ready for an object modified reaction.

I have successfully done this (with dynamic blocks) in the past so I know it is possible.

Peter Jamtgaard

[bweir]

Thank you, excellent suggestion.

[bweir]

I'm still having difficulty. The program will work for a little bit but then goes screwy and I get the Access Violation stuff again. Here's my code, can you see if I missed something? The attached file has the block I'm working with.

(vl-load-com)
(vl-load-reactors)
(setq CautionBoxChangedList nil)
(setq ModifyingCautionBoxes nil)

; This function is used as the Object Modified Reactor Callback.
(defun ObjectChanged
  (Reactor ObjectList
   / Object		ObjectName	DynProps
     LineAngle	TextAngle		Index
     DynPropName	Db		Status)

  ; Check that the object is not being modified from the command reactor.
  (if ModifyingCautionBoxes (VL-EXIT-WITH-VALUE ""))
  
  ; Check that the drawing is not closed.
  (setq Status (VL-CATCH-ALL-APPLY 'vla-get-active (list (vlr-document Reactor))))
  (if (= (type Status) 'VL-CATCH-ALL-APPLY-ERROR) (VL-EXIT-WITH-VALUE ""))
  
  (setq Db (nth 0 ObjectList))
  ; Check that the object is not erased.
  (if (null (entget (nth 1 ObjectList))) (VL-EXIT-WITH-VALUE ""))
  (setq Object (vlax-ename->vla-object (nth 1 ObjectList)))
  (setq ObjectName (VL-CATCH-ALL-APPLY 'vla-get-objectname (list Object)))

  ; Check that the modified item is a block reference.
  (if (= ObjectName "AcDbBlockReference")
    (progn
      ; Check that it was a dynamic block.
      (if (and (= (vla-get-effectivename Object) "abc") (vla-get-IsDynamicBlock Object))
	(progn
	  ; Find the required dynamic properties.
	  (setq DynProps (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties Object))))
	  (setq Index 0)
	  (while (< Index (length DynProps))
	    (setq DynPropName (vla-get-PropertyName (nth Index DynProps)))
	    (cond
	      ((= DynPropName "Angle")
	       (setq LineAngle (nth Index DynProps))
	      )
	      ((= DynPropName "TextAngle")
		(setq TextAngle (nth Index DynProps))
	      )
	    )
	    (setq Index (1+ Index))
	  )

	  ; Check that the required properties where found.
	  (if (not (and (null LineAngle) (null TextAngle)))
	    ; Retain the modified block for post processing.
	    (setq CautionBoxChangedList (append CautionBoxChangedList (list Object)))
	  )
	)
      )
    )
  )
)

; This function is used as the Command Ended Reactor Callback.
(defun CommandEnded
       (Reactor ObjectList
	/ Index		Block		DynProps
	  DynPropIndex	DynPropName	LineAngle
	  TextAngle	dLineAngle	dTextAngle)
  
  (if (not (null CautionBoxChangedList))
    (progn
      ; Keep the Object Modified Reactor from firing.
      (setq ModifyingCautionBoxes T)
      
      (setq Index 0)
      (while (< Index (length CautionBoxChangedList))
	(setq Block (nth Index CautionBoxChangedList))
	; Find the requried properties.
	(setq DynProps (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties Block))))
	(setq DynPropIndex 0)
	(while (< DynPropIndex (length DynProps))
	  (setq DynPropName (vla-get-PropertyName (nth DynPropIndex DynProps)))
	  (cond
	    ((= DynPropName "Angle")
	     (setq LineAngle (nth DynPropIndex DynProps))
	    )
	    ((= DynPropName "TextAngle")
	     (setq TextAngle (nth DynPropIndex DynProps))
	    )
	  )
	  (setq DynPropIndex (1+ DynPropIndex))
	)

	; Check that the block had the required properties.
	(if (not (and (null LineAngle) (null TextAngle)))
	  ; Process the block.
	  (progn
	    (setq dLineAngle (vlax-variant-value (vla-get-value LineAngle)))
	    (setq dTextAngle (vlax-variant-value (vla-get-value TextAngle)))
	    ; Debug - (alert (strcat "Line: " (rtos dLineAngle) "nText: " (rtos dTextAngle)))
	    
	    ; Change the values of the block.
	    (cond
	      ((and (> dLineAngle (/ Pi 2)) (<= dLineAngle (* Pi 1.5)))
	       (vla-put-value TextAngle (variant Pi))
	      )
	      (T
	       (vla-put-value TextAngle (variant (* Pi 2)))
	      )
	    )
	  )
	)
	(setq Index (1+ Index))
      )

      ; Clear the values for the next time objects are modified.
      (setq ModifyingCautionBoxes nil)
      (setq CautionBoxChangedList nil)
    )
  )
)

; Create reactors.
(if (/= (type ObjectAppendedReactor) 'VLR-AcDb-Reactor)
  ; This reactor is used to catch blocks that have changed.
  (setq ObjectAppendedReactor (VLR-AcDb-Reactor nil '((:VLR-objectAppended . ObjectChanged))))
)
(if (/= (type ObjectChagnedReactor) 'VLR-AcDb-Reactor)
  ; This reactor is used to catch blocks that have changed.
  (setq ObjectChagnedReactor (VLR-AcDb-Reactor nil '((:VLR-objectModified . ObjectChanged))))
)
(if (/= (type CommandEndedReactor) 'VLR-Command-Reactor)
  ; this reactor is used to change the blocks after the user is finished their edits.
  (setq CommandEndedReactor (VLR-Command-Reactor nil '((:VLR-commandEnded . CommandEnded))))
)

[flammis746092]

Is not necessary two reactor, but only one:

(vl-load-com)
(vl-load-reactors)

(if (/= (type CommandEndedReactor) 'VLR-Command-Reactor)
  ; this reactor is used to change the blocks after the user is finished their edits.
 (setq CommandEndedReactor (VLR-Command-Reactor nil '((:VLR-commandEnded . CommandEnded))))
)

; This function is used as the Command Ended Reactor Callback.
(defun CommandEnded
       (Reactor ObjectList
	/ ssets newsset Block		DynProps
	  DynPropIndex	DynPropName	LineAngle
	  TextAngle	dLineAngle	dTextAngle)
  
  (if (= (car objectlist) "GRIP_STRETCH")
    (progn
     (setq ssets (vla-get-selectionsets (vla-get-activedocument (vlax-get-acad-object))))

     (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list ssets "Selezione1")))
      (setq newsset (vla-add ssets "Selezione1"))
      (progn
       (vla-delete (vla-item ssets "Selezione1"))
       (setq newsset (vla-add ssets "Selezione1"))
      )
     )
     (vla-SelectOnScreen newsset)
     ;;;(vla-select newsset acSelectionSetPrevious)
     (setq Block (vla-item newsset 0))
	; Find the required properties.
	(setq DynProps (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties Block))))
	(setq DynPropIndex 0)
	(while (< DynPropIndex (length DynProps))
	  (setq DynPropName (vla-get-PropertyName (nth DynPropIndex DynProps)))
	  (cond
	    ((= DynPropName "Angle")
	     (setq LineAngle (nth DynPropIndex DynProps))
	    )
	    ((= DynPropName "TextAngle")
	     (setq TextAngle (nth DynPropIndex DynProps))
	    )
	  )
	  (setq DynPropIndex (1+ DynPropIndex))
	)

	; Check that the block had the required properties.
	(if (not (and (null LineAngle) (null TextAngle)))
	  ; Process the block.
	  (progn
	    (setq dLineAngle (vlax-variant-value (vla-get-value LineAngle)))
	    (setq dTextAngle (vlax-variant-value (vla-get-value TextAngle)))
	    ; Debug - (alert (strcat "Line: " (rtos dLineAngle) "nText: " (rtos dTextAngle)))
	    
	    ; Change the values of the block.
	    (cond
	      ((and (> dLineAngle (/ Pi 2)) (<= dLineAngle (* Pi 1.5)))
	       (vla-put-value TextAngle (variant Pi))
	      )
	      (T
	       (vla-put-value TextAngle (variant (* Pi 2)))
	      )
	    )
	  )
	)
      )

   )
)