Editor reactor

I have an editor reactor loaded into my drawing. I also have a lisp routine
that I am using in insert a block. Basically what I am trying to do is
toggle CAPS LOCK on each time the insert command is used. The first time a
certain block is loaded, everything runs perfectly after that CAPS does not
get turned on. If use an alert to tell me when the insert command has been
called CAPS lock is turned on every time. Any ideas?

Thanks,

Jerry Freeman

(vl-load-com)
;;; Command Reactor
(vlr-editor-reactor
NIL
'(vlr-commandwillstart . GHA:STARTCOMMAND))
) ;_ end of vlr-editor-reactor
(vlr-editor-reactor
NIL
'(vlr-commandended . GHA:ENDCOMMAND))
) ;_ end of vlr-editor-reactor
(vlr-editor-reactor
NIL
'(vlr-commandcancelled . GHA:CANCELCOMMAND))
) ;_ end of vlr-editor-reactor

(defun GHA:STARTCOMMAND (CALL CALLBACK / THECOMMANDSTARTED)
(cond ((wcmatch (strcase (car CALLBACK)) "*TEXT")
(dos_capslock T)
)
((wcmatch (strcase (car CALLBACK)) "*EDIT")
(dos_capslock T)
)
((wcmatch (strcase (car CALLBACK)) "*INSERT")
;(alert "INSERT command started!")
(dos_capslock T)
)
) ;_ end of cond
(cond ((wcmatch (strcase (car CALLBACK)) "*QUIT*")
(vlr-remove-all :vlr-editor-reactor)
)
) ;_ end of cond
) ;_ end of defun

(defun GHA:ENDCOMMAND (CALL CALLBACK / THECOMMANDENDED)
(cond ((wcmatch (strcase (car CALLBACK)) "*TEXT")
(dos_capslock)
)
((wcmatch (strcase (car CALLBACK)) "*EDIT")
(dos_capslock)
)
((wcmatch (strcase (car CALLBACK)) "*INSERT")
;(alert "INSERT command ended!")
(dos_capslock)
)
) ;_ end of cond
(cond ((wcmatch (strcase (car CALLBACK)) "*DIST*")
(princ (strcat "\nDistance = "
(rtos (getvar "Distance") 4)
" or "
(rtos (getvar "Distance") 2)
) ;_ end of strcat
) ;_ end of princ
)
) ;_ end of cond
) ;_ end of defun

(defun GHA:CANCELCOMMAND (CALL CALLBACK / THECOMMANDCANCELLED)
(cond ((wcmatch (strcase (car CALLBACK)) "*TEXT")
(dos_capslock)
)
((wcmatch (strcase (car CALLBACK)) "*EDIT")
(dos_capslock)
)
((wcmatch (strcase (car CALLBACK)) "*INSERT")
;(alert "INSERT command cancelled!")
(dos_capslock)
)
) ;_ end of cond
) ;_ end of defun
;;;
;;;(princ "GHA Command Reactors loaded.")
;;;(dos_capslock)

(defun C:INEK (/
COSMODE ;;Current Osnap Mode
CLA ;;Curent Layer
PT1 ;;Point Selected by User
B1 ;;Entity list for temporary inek block
ANG ;;Angle of block insertion
DEG45 ;;45 degrees in radians
DEG90 ;;90 degrees in radians
DEG180 ;;180 degrees in radians
DEG270 ;;270 degrees in radians
AN ;;Layer to insert block on
BLK ;;Block to insert
SF ;;Scale Factor
A ;;First layer in drawing
B ;;Second layer in drawing
ALLIST ;;Sorted list of all layers in drawing
LNAME ;;Layer name
LLIST) ;;List of all layers in drawing
(princ "- Insert Elevation Key -")
(terpri)
(initget "FP-Notes N M")
(setvar "CMDECHO" 0)
(setq AN (getkword "\nInsert on Layer FP-Notes or [N/M]? Type 'M' for more
layer options.")) ;; ask user to choose a layer to insert the block.
(if AN ;; the layer the block is inserted on depends on if
(= NIL) ;; the drawing being worked on is a floor plan or
(setq AN "FP-Notes") ;; some other drawing. refer to graphics manual
) ;_ end of if ;; for layer standards
(cond
((= AN "FP-Notes")
(if (equal (tblsearch "layer" "FP-Notes") NIL) ;; check to see if layer
FP-Notes exists, if not create it
(command "layer" "n" "FP-Notes" "")
) ;_ end of if
)
((= AN "N")
(if (equal (tblsearch "layer" "N") NIL) ;; check to see if layer N
exist, if not create it
(command "layer" "n" "N" "")
) ;_ end of if
)
((= AN "M")
(setq A (tblnext "layer" t))
(setq LNAME (list (cdr (assoc 2 A))))
(setq B (tblnext "layer"))
(setq LLIST (append LLIST LNAME))
(setq LNAME (list (cdr (assoc 2 B))))
(setq LLIST (append LLIST LNAME))
(while (/= B NIL)
(setq B (tblnext "layer"))
(setq LNAME (list (cdr (assoc 2 B))))
(if (/= B NIL)
(setq LLIST (append LLIST LNAME))
(setq ALLIST (acad_strlsort LLIST))
) ;_ end of if
) ;_ end of while
(setq AN (dos_listbox "Insert block on layer" "Choose a layer:" ALLIST))
)
) ;_ end of cond
(if (equal (tblsearch "BLOCK" "Notes") NIL) ;; check to see if block
Notes exists, if not insert is definition into drawing.
(command "-INSERT" "Notes" ^C^C)
) ;_ end of IF
(setq COSMODE (getvar "osmode")
CLA (getvar "clayer")
CLT (getvar "celtype")
SF (getvar "dimscale")
SF (/ SF 48)
) ;_ end of setq(setvar "clayer" AN)
(setvar "clayer" AN)
(setvar "osmode" 128)
(setvar "dragmode" 2)
(setvar "celtype" "continuous")
(command "-INSERT" ;; insert a temporary block for dragging.
"inek"
(setq PT1 (getpoint "\nSelect insertion point: "))
SF
SF
PAUSE
) ;_ end of command
(setq B1 (entget (entlast))
ANG (cdr (assoc 50 B1))
DEG45 (/ pi 4)
DEG90 (/ pi 2)
DEG180 pi
DEG270 (* 3 (/ pi 2))
) ; end setq globals
(entdel (entlast))
(initdia)
(cond ;; determines which elevation key block to insert based on
the angle supplied by the user.
((= ANG DEG90)
(setq BLK "elev-key1")
(command "-INSERT" BLK PT1 SF SF "")
)
((= ANG 0)
(setq BLK "elev-key4")
(command "-INSERT" BLK PT1 SF SF "")
)
((= ANG DEG180)
(setq BLK "elev-key2")
(command "-INSERT" BLK PT1 SF SF "")
)
((= ANG DEG270)
(setq BLK "elev-key3")
(command "-INSERT" BLK PT1 SF SF "")
)
((and (> ANG 0) (< ANG DEG180))
(setq ANG (RTD ANG)
ANG (- ANG 90)
) ;_ end of setq
(setq BLK "elev-key1")
(command "-INSERT" BLK PT1 SF SF ANG)
)
((and (> ANG DEG180) (< ANG 360))
(setq ANG (RTD ANG)
ANG (+ ANG 90)
) ;_ end of setq
(setq BLK "elev-key3")
(command "-INSERT" BLK PT1 SF SF ANG)
)
) ;_ end of cond
(setq BLK (strcase BLK))
(princ (strcat "\n" BLK " inserted on layer " AN"."))
(princ)
(setvar "osmode" COSMODE)
(setvar "clayer" CLA)
(setvar "celtype" CLT)
(setvar "CMDECHO" 1)
(princ)
)

 

I forgot to add I am using A2k4.