As part of expanding my lisp skills, I'm starting to play with the reactors. Because the reactors require a little more attention than the "usual" routines, please review following code. Lisp in the future is meant to serve "my" blocks. The idea is that after double-clicking on the block for which I will have a defined function, autocad will start this function instead of default one.
Lisp to check:
(if (null *Check_Block-reactor*)
(setq *Check_Block-reactor*
(vlr-mouse-reactor "Check_Block" '((:vlr-beginDoubleClick . pz:checkblock)))
)
)
(defun pz:checkblock (@Reactor @Point / _objectPoint _ACadDoc _ssets _flag _newsset _obj _ss _tmp)
(setq _objectPoint (car @Point))
(setq _ACadDoc (vla-get-activedocument(vlax-get-acad-object)))
(setq _ssets (vla-get-selectionsets _ACadDoc))
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-item (list _ssets "$Set")
)
)
(setq _newsset (vla-add _ssets "$Set"))
(progn
(vla-delete (vla-item _ssets "$Set"))
(setq _newsset (vla-add _ssets "$Set"))
)
)
(vla-selectAtPoint _newsset (vlax-3D-point _objectPoint))
(if (/= (vla-get-count _newsset) 0)
(progn
(vlax-for %obj _newsset
(setq _tmp (cons %obj _tmp))
)
(setq _tmp
(vl-member-if
'(lambda (%)
(and
(= (vla-get-ObjectName %) "AcDbBlockReference")
(= "EXAMPLE"
(strcase
(vlax-get-property %
(if (vlax-property-available-p % 'effectivename)
'effectivename
'name
)
)
)
)
)
)
_tmp
)
)
(if _tmp
(progn
(setq *escape-EATTEDIT* t)
(alert "Do my stuff...")
(vla-delete (vla-item _ssets "$Set"))
)
(progn
(setq _ss (ssget "_p"))
(sssetfirst nil _ss)
)
)
)
)
(princ)
)
;based on:
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/cancel-command-with-visual-lisp-reactor/m-p/3239430#M300536
(if (null *command-reactor*)
(setq *command-reactor*
(vlr-command-reactor nil '((:vlr-commandwillstart . commandreactorcallback)))
)
)
(if (null *editor-reactor*)
(setq *editor-reactor*
(vlr-editor-reactor nil '((:vlr-beginclose . editorreactorcallback)))
)
)
(defun commandreactorcallback ( reactor params )
(if (and
*escape-EATTEDIT*
(or
(eq (strcase (car params)) "EATTEDIT")
(eq (strcase (car params)) "QUICKPROPERTIES")
(eq (strcase (car params)) "RATRRED")
(eq (strcase (car params)) "WŁAŚCIWOŚCI")
)
)
(progn
(if (setq *wsh* (cond (*wsh*) ((vlax-create-object "WScript.Shell"))))
(vl-catch-all-apply 'vlax-invoke (list *wsh* 'sendkeys "{ESC}"))
)
(setq *escape-EATTEDIT* nil)
)
)
(princ)
)
(defun editorreactorcallback ( reactor params )
(if (and *wsh* (eq 'VLA-OBJECT (type *wsh*)) (not (vlax-object-released-p *wsh*)))
(vl-catch-all-apply 'vlax-release-object (list *wsh*))
)
(if (and *command-reactor* (eq 'VLA-OBJECT (type *command-reactor*)))
(vlr-remove *command-reactor*)
)
(vlr-remove reactor)
(princ)
)