Hello
I have create this lisp which makes it possible by a right click on a block to rename it by the reactors
My concern, it's when i give a new name or answered an error message, the function click right continuous
I.e. that if the right click = enter, it takes again the last command or if not, it's the contextual menu
How to make so that an reactors stop definitively, and thus without autocad continuing in its logic
Thanks in advance
@+
(defun Clic_Droit_Renommer(Rea Pt / Bk Bks Nom Sel Txt)
(defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
)
(defun InputBox (Titre Message Defaut / *acad* users1 valeur)
(setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
(acad-push-dbmod)
(vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
(setq valeur (getvar "users1"))
(setvar "users1" users1)
(acad-pop-dbmod)
valeur
)
(if (setq Sel (ssget (car Pt)))
(progn
(setq Sel (vlax-ename->vla-object (ssname Sel 0)))
(if (eq (vla-get-ObjectName Sel) "AcDbBlockReference")
(progn
(if (vlax-property-available-p Sel 'EffectiveName)
(setq nom (vla-get-EffectiveName Sel))
(setq nom (vla-get-Name Sel))
)
(if (setq Txt (InputBox "Rename Block" "Please give a new name to the block" Nom))
(if (not (eq (strcase Txt) (strcase Nom)))
(if (not (eq Txt ""))
(progn
(setq Bks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(if (vla-item Bks Txt)
(MsgBox "Rename Block" 16 "Block Name already existing. Nothing of changed")
(progn
(setq Bk (vla-item Bks Nom))
(vla-put-name Bk Txt)
)
)
)
)
(MsgBox "Rename Block" 48 "Identical name. Nothing of changed")
)
)
)
)
)
)
(princ)
)
(defun creation_reacteur_renommer (/ i j n)
(vl-load-com)
(if (vlr-reactors :vlr-mouse-reactor)
(progn
(setq n 1)
(while (setq i (nth n (car (vlr-reactors :vlr-mouse-reactor))))
(if (eq (cdr (car (vlr-reactions i))) 'CLIC_DROIT_RENOMMER)
(setq j i)
)
(setq n (1+ n))
)
(if j
(vlr-remove j)
)
)
)
(setq mrea_ren (vlr-mouse-reactor nil '((:vlr-beginRightClick . Clic_Droit_Renommer))))
(princ "\nRight click to rename the blocks ENABLE")
(princ)
)
(if (not mrea_ren)
(creation_reacteur_renommer)
)
(princ)