(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)
)
Glad to see you solved this one, ziele_o2k !
I couldn't figure this out on my own, so I had to revise your code.
Personally I try to avoid global variables, if I can... aswell too many reactors - because I don't like efficient versions that turn the routine into a spaghetti code.
So heres my interpretation of it -Code - Auto/Visual Lisp: [Select]
; trying to interpretate from ; http://www.theswamp.org/index.php?topic=54441.0 ; Callback functions: (and (cond (and ); and ) ); cond ); if ); and ); defun (and *CheckBlock:EscEATTEDIT* (SendEsc) ); and ); defun Cmd:CB ; Include our reactors: ( (foreach rtr (cdar (vlr-reactors :VLR-Mouse-reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) ) (foreach rtr (cdar (vlr-reactors :VLR-Command-Reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) ) (if flg ); progn ); if ); lambda "Check_Block" flg ) ); defun CheckBlock (C:CheckBlockOn) ; Subfunctions: (and ) t ); defun SendEsc
Turns out you don't have to access to the SelectionSets collection, and create a named SS.
If you want to learn more about reactors just check some of my threads with questions about 'reactors' (where Lee answered),
but IMO you seem pretty good at them - especially when you managed to pull off this one.
Thanks again for sharing!
(defun Mouse:CB ( rtr args / o )
(and
(setq o (nentselp (car args)))
(cond
( (= 2 (length o)) (setq o (vlax-ename->vla-object (car o)))
(and
(eq (vlax-get-property o 'ObjectName) "AcDbAttribute")
(setq o (vla-ObjectIDToObject (vla-get-ActiveDocument (vlax-get-acad-object)) (vla-get-OwnerID o)))
); and
)
( (setq o (vlax-ename->vla-object (last (last o)))) )
); cond
(eq (vlax-get-property o 'ObjectName) "AcDbBlockReference")
(if (setq *CheckBlock:EscEATTEDIT* (= "LAMBERTI_TITLEBLOCK" (strcase (vla-get-EffectiveName o)))) ;put here the block name
;(alert "\nDo my stuff...") originally
(vl-vbarun "TitleBlockForm.dvb!Modulo1.TitleBlock") ;my action
(sssetfirst nil (ssget "_P"))
); if
); and
); defun
what i miss?; Callback functions:
(defun Mouse:CB ( rtr args / o )
(and
(setq o (nentselp (car args)))
(cond
( (= 2 (length o)) (setq o (vlax-ename->vla-object (car o)))
(and
(eq (vlax-get-property o 'ObjectName) "AcDbAttribute")
(setq o (vla-ObjectIDToObject (vla-get-ActiveDocument (vlax-get-acad-object)) (vla-get-OwnerID o)))
); and
)
( (setq o (vlax-ename->vla-object (last (last o)))) )
); cond
(eq (vlax-get-property o 'ObjectName) "AcDbBlockReference")
(if (setq *CheckBlock:EscEATTEDIT* (= "LAMBERTI_TITLEBLOCK" (strcase (vla-get-EffectiveName o)))) ;put here the block name
(progn
(setq acadObj (vlax-get-acad-object))
;; Load a sample VBA project DVB file
(vla-LoadDVB acadObj "C://dati//Lamberti_std//compilazione cartiglio VBA//TitleBlockForm.dvb")
;; Run the drawline sample macro
(vla-RunMacro acadObj "TitleBlockForm.dvb!Modulo1.TitleBlock")
)
(sssetfirst nil (ssget "_P"))
); if
); and
); defun