cad输入法自动切换程序[热键版修改]

guangdonglbq

    原版源码在个贴子：  http://bbs.mjtd.com/thread-176934-1-1.html 及 http://bbs.mjtd.com/thread-183157-1-1.html
    原程序思路很好，本程序主要是根据个人的习惯修改了一下。
    另外，有些二开的程序也会在代码中运行文本编辑相关的命令，这时自动切换输入法功能会造成软件卡钝，因此本程序添加在执行lisp代码前，关闭自动自动切换输入法，并在lisp程序执行结束后重新开启的功能。   根据大家的反馈意见，修改后的源码如下：


;;cad输入法自动切换程序,打开dwg文件时，运行一次即可
;;请在操作系统中设置输入法热键：ctrl+shift+1为英文，ctrl+shift+2为中文
;;修改日期：2021年06月06日
(vl-load-reactors)
(setq Scriptshell (vlax-create-object "WScript.Shell"))

(defun StartEnglishInputMethod(reactor_object listCommand )
        (StartInputMethod (car listCommand) "+^1" )
)

(defun StartChineseInputMethod(reactor_object listCommand )
        (StartInputMethod (car listCommand)  "+^2")
)

(defun StartInputMethod(strCommand strInputMethodKey / listEditCommands)
        (setq strCommand (strcase strCommand T) )
        (setq strCommand (vl-string-subst "" "-" strCommand))
        (setq strCommand (vl-string-subst "" "_" strCommand))
        (setq listEditCommands (list "mtedit" "ddedit" "textedit" "text" "mtext" "leader" "mleader" "tobjedit" "saveas" "tsaveas" "eattedit"))
  (if (member strCommand listEditCommands)
                (vlax-invoke Scriptshell "SendKeys" strInputMethodKey)
  )  
)
;鼠标双击
(defun onMouseDoubleClick (a b / en end entype )
  (if (setq en (nentselp (trans (car b) 0 1)))
    (progn
      (setq end (entget (car en)))
      (setq entype (cdr (assoc 0 end)))
      (if (wcmatch entype "*TEXT")
       (vlax-invoke Scriptshell "SendKeys"  "+^2")
      )
    )
  )
  (princ)
)

(defun startIMEScript(a b)
(vlr-command-reactor nil
        '((:vlr-commandWillStart . StartChineseInputMethod) ;;启动CAD命令时
                 (:vlr-commandEnded . StartEnglishInputMethod) ;;完成CAD命令时
                 (:vlr-commandCancelled . StartEnglishInputMethod) ;;取消CAD命令时
                 (:vlr-commandFailed . StartEnglishInputMethod) ;;无法完成CAD命令时
         )                
)
)

(defun EndIMEScript(a b )
        (vlr-remove-all :vlr-command-reactor)
)

(startIMEScript nil nil)

(vlr-mouse-reactor nil '((:vlr-beginDoubleClick . onMouseDoubleClick)))       ;鼠标反应器-双击事件
(vlr-lisp-reactor nil
        '((:vlr-lispWillStart . EndIMEScript) ;;启动lisp时
                 (:vlr-lispEnded . startIMEScript) ;;完成lisp时
                 (:vlr-lispCancelled . startIMEScript) ;;取消lisp时
         )                
)

(vlax-invoke Scriptshell "SendKeys" "+^1") ;加载时，启用英文输入法
(princ)

疯球

唯一的缺点就是系统设好的输入法快捷键总是变

大尾巴狼

;请在操作系统中设置输入法热键：ctrl+shift+1为英文，ctrl+shift+2为中文

居然找不到设置的地方

guangdonglbq

下面的代码增加了打开dwg时，切换为英文输入法的功能




;;cad输入法自动切换程序,打开dwg文件时，运行一次即可
;;请在操作系统中设置输入法热键：ctrl+shift+1为英文，ctrl+shift+2为中文
(vl-load-reactors)
(setq Scriptshell (vlax-create-object "WScript.Shell"))


(defun StartEnglishInputMethod(reactor_object listCommand )
        (StartInputMethod (car listCommand) "+^1" )
)


(defun StartChineseInputMethod(reactor_object listCommand )
        (StartInputMethod (car listCommand)  "+^2")
)


(defun StartInputMethod(strCommand strInputMethodKey / listEditCommands)
        (setq strCommand (strcase strCommand T) )
        (setq strCommand (vl-string-subst "" "-" strCommand))
        (setq strCommand (vl-string-subst "" "_" strCommand))
        (setq listEditCommands (list "mtedit" "ddedit" "textedit" "text" "mtext" "leader" "mleader" ))
  (if (member strCommand listEditCommands)
                (vlax-invoke Scriptshell "SendKeys" strInputMethodKey)
  )  
)


(defun startIMEScript(a b)
(vlr-command-reactor nil
        '((:vlr-commandWillStart . StartChineseInputMethod) ;;启动CAD命令时
                 (:vlr-commandEnded . StartEnglishInputMethod) ;;完成CAD命令时
                 (:vlr-commandCancelled . StartEnglishInputMethod) ;;取消CAD命令时
                 (:vlr-commandFailed . StartEnglishInputMethod) ;;无法完成CAD命令时
         )                 
)
)

(defun EndIMEScript(a b )
        (vlr-remove-all :vlr-command-reactor)
)

(startIMEScript nil nil)

(vlax-invoke Scriptshell "SendKeys" "+^1") ;加载时，启用英文输入法

(vlr-lisp-reactor nil
        '((:vlr-lispWillStart . EndIMEScript) ;;启动lisp时
                 (:vlr-lispEnded . startIMEScript) ;;完成lisp时
                 (:vlr-lispCancelled . startIMEScript) ;;取消lisp时
         )                 
)
(princ)

zhangcn

不错，解决了原版使用中的两个BUG

（1、ctrl+z 不能连续撤销，2、空白处双击也弹出中文输入法就需要手动设置英文输入法）

yaokui25

谢谢

LIULISHENG

这个最好用了

烟盒迷唇

真的很好用嘛

zhangcn

能不能加一个功能 win10 系统环境，CAD启动后自动切换英文输入法，（比如我的win10系统用“微软五笔”输入法默认是中文输入，CAD打开时就是中文输入法，需要手动切换到英文一次）

xudi1234

作图神器！谢谢

海盗曹

感谢分享，MARK一下

yaokui25

zhangcn 发表于 2021-5-20 09:21
能不能加一个功能 win10 系统环境，CAD启动后自动切换英文输入法，（比如我的win10系统用“微软五笔”输入 ...

这个提议真心不错，希望楼主出手