Author Topic: Please test and review this doubleclick reactor  (Read 2532 times)

0 Members and 1 Guest are viewing this topic.

ziele_o2k

  • Newt
  • Posts: 49
Please test and review this doubleclick reactor
« on: August 25, 2018, 06:58:39 AM »
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:
Code: [Select]
(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)
)

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Please test and review this doubleclick reactor
« Reply #1 on: August 26, 2018, 02:37:26 AM »
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]
  1. ; trying to interpretate from
  2. ; http://www.theswamp.org/index.php?topic=54441.0
  3.  
  4. ; Callback functions:
  5.  
  6. (defun Mouse:CB ( rtr args / o )
  7.   (and
  8.     (setq o (nentselp (car args)))
  9.     (cond
  10.       ( (= 2 (length o)) (setq o (vlax-ename->vla-object (car o)))
  11.         (and
  12.           (eq (vlax-get-property o 'ObjectName) "AcDbAttribute")
  13.         ); and
  14.       )
  15.       ( (setq o (vlax-ename->vla-object (last (last o)))) )
  16.     ); cond
  17.     (eq (vlax-get-property o 'ObjectName) "AcDbBlockReference")
  18.     (if (setq *CheckBlock:EscEATTEDIT* (= "EXAMPLE" (strcase (vla-get-EffectiveName o))))
  19.       (alert "\nDo my stuff...")
  20.       (sssetfirst nil (ssget "_P"))
  21.     ); if
  22.   ); and
  23.  
  24. ); defun
  25.  
  26.  
  27. (defun Cmd:CB ( rtr args )
  28.   (and
  29.     *CheckBlock:EscEATTEDIT*
  30.     (member (strcase (car args)) '("EATTEDIT" "QUICKPROPERTIES" "RATRRED" "WLASCIWOSCI"))
  31.     (SendEsc)
  32.   ); and
  33.   (setq *CheckBlock:EscEATTEDIT* nil)
  34. ); defun Cmd:CB
  35.  
  36.  
  37. ; Include our reactors:
  38.  
  39. (defun CheckBlock ( flg ) ; subfoo that accepts boolean, to be used for on/off switching
  40.   (
  41.     (lambda ( rtrnm flg ) (vl-load-com)
  42.       (foreach rtr (cdar (vlr-reactors :VLR-Mouse-reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) )
  43.       (foreach rtr (cdar (vlr-reactors :VLR-Command-Reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) )
  44.       (if flg
  45.         (progn
  46.           (alert "\nCheck block reactor is ON")
  47.           (vlr-Mouse-Reactor rtrnm '((:VLR-BeginDoubleClick . Mouse:CB)))
  48.           (vlr-Command-Reactor rtrnm '((:VLR-commandWillStart . Cmd:CB)))
  49.         ); progn
  50.         (alert "\nCheck block reactor is OFF")
  51.       ); if
  52.      
  53.       (princ)
  54.     ); lambda
  55.     "Check_Block" flg
  56.   )
  57. ); defun CheckBlock
  58.  
  59. (defun C:CheckBlockOn nil (CheckBlock t) (princ))
  60. (defun C:CheckBlockOff nil (CheckBlock nil) (princ))
  61.  
  62. (C:CheckBlockOn)
  63.  
  64.  
  65. ; Subfunctions:
  66.  
  67. (defun SendEsc ( / wsh )
  68.   (and
  69.     (setq wsh (vlax-get-or-create-object "WScript.Shell"))
  70.     (vl-catch-all-apply (function (lambda nil (vlax-invoke-method wsh 'SendKeys "{ESC}"))))
  71.   )
  72.   (vl-catch-all-apply 'vlax-release-object (list wsh))
  73.   t
  74. ); 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!
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

gp.triple

  • Mosquito
  • Posts: 14
Re: Please test and review this doubleclick reactor
« Reply #2 on: November 15, 2021, 11:02:56 AM »
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]
  1. ; trying to interpretate from
  2. ; http://www.theswamp.org/index.php?topic=54441.0
  3.  
  4. ; Callback functions:
  5.  
  6. (defun Mouse:CB ( rtr args / o )
  7.   (and
  8.     (setq o (nentselp (car args)))
  9.     (cond
  10.       ( (= 2 (length o)) (setq o (vlax-ename->vla-object (car o)))
  11.         (and
  12.           (eq (vlax-get-property o 'ObjectName) "AcDbAttribute")
  13.         ); and
  14.       )
  15.       ( (setq o (vlax-ename->vla-object (last (last o)))) )
  16.     ); cond
  17.     (eq (vlax-get-property o 'ObjectName) "AcDbBlockReference")
  18.     (if (setq *CheckBlock:EscEATTEDIT* (= "EXAMPLE" (strcase (vla-get-EffectiveName o))))
  19.       (alert "\nDo my stuff...")
  20.       (sssetfirst nil (ssget "_P"))
  21.     ); if
  22.   ); and
  23.  
  24. ); defun
  25.  
  26.  
  27. (defun Cmd:CB ( rtr args )
  28.   (and
  29.     *CheckBlock:EscEATTEDIT*
  30.     (member (strcase (car args)) '("EATTEDIT" "QUICKPROPERTIES" "RATRRED" "WLASCIWOSCI"))
  31.     (SendEsc)
  32.   ); and
  33.   (setq *CheckBlock:EscEATTEDIT* nil)
  34. ); defun Cmd:CB
  35.  
  36.  
  37. ; Include our reactors:
  38.  
  39. (defun CheckBlock ( flg ) ; subfoo that accepts boolean, to be used for on/off switching
  40.   (
  41.     (lambda ( rtrnm flg ) (vl-load-com)
  42.       (foreach rtr (cdar (vlr-reactors :VLR-Mouse-reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) )
  43.       (foreach rtr (cdar (vlr-reactors :VLR-Command-Reactor)) (if (= rtrnm (vlr-data rtr)) (vlr-remove rtr)) )
  44.       (if flg
  45.         (progn
  46.           (alert "\nCheck block reactor is ON")
  47.           (vlr-Mouse-Reactor rtrnm '((:VLR-BeginDoubleClick . Mouse:CB)))
  48.           (vlr-Command-Reactor rtrnm '((:VLR-commandWillStart . Cmd:CB)))
  49.         ); progn
  50.         (alert "\nCheck block reactor is OFF")
  51.       ); if
  52.      
  53.       (princ)
  54.     ); lambda
  55.     "Check_Block" flg
  56.   )
  57. ); defun CheckBlock
  58.  
  59. (defun C:CheckBlockOn nil (CheckBlock t) (princ))
  60. (defun C:CheckBlockOff nil (CheckBlock nil) (princ))
  61.  
  62. (C:CheckBlockOn)
  63.  
  64.  
  65. ; Subfunctions:
  66.  
  67. (defun SendEsc ( / wsh )
  68.   (and
  69.     (setq wsh (vlax-get-or-create-object "WScript.Shell"))
  70.     (vl-catch-all-apply (function (lambda nil (vlax-invoke-method wsh 'SendKeys "{ESC}"))))
  71.   )
  72.   (vl-catch-all-apply 'vlax-release-object (list wsh))
  73.   t
  74. ); 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!

Hi I arrived here searcing a solution for a doubleclick reactor.
i'm tryng to modify your code for run a vba on a duoble click, but i can't find a solution

Code: [Select]
(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?
thanks

gp.triple

  • Mosquito
  • Posts: 14
Re: Please test and review this doubleclick reactor
« Reply #3 on: November 16, 2021, 09:10:36 AM »
Update
I found a solution to run my vba from lisp following this page from official help
https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-638E14CA-798C-42BC-8F2B-5E9D6952C707

here my code

Code: [Select]
; 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