[风之影]VLISP之有道词典

cabinsummer · 发表于 2016-12-27 10:24:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

利用正则表达式和XMLHTTP，从有道词典网站取得翻译后的内容。

使用如下：

(translate "风之影");;;返回"The shadow of wind"
(translate "The shadow of wind");;;返回"风的影子"

也可在命令行键入TRS后，选取单行文本、多行文本、块中文字、块属性、属性定义。点击后直接翻译。

下面是函数源码：

(defun GetXML (url / XML http)
(setq http (vlax-create-object "Microsoft.XMLHTTP"))
(vlax-invoke-method http "open" "GET" url 0)
(vlax-invoke-method http "send")
(setq XML (vlax-get-property http "responseText"))
(vlax-release-object http)
XML
)
(defun Translate (word / RegEx str)
(setq RegEx (vlax-create-object "VBScript.RegExp"))
(vlax-put-property RegEx "Global" 1)
(setq str (GetXML (strcat "http://fanyi.youdao.com/translate?&i=" word "&doctype=xml&version")))
(vlax-put-property RegEx "Pattern" "^(.|\n)*<translation>(.|\n)*?<![\[]CDATA[\[]")
(setq str (vlax-invoke-method regex "Replace" str ""))
(vlax-put-property RegEx "Pattern" "[\]]{2}>(.|\n)*<\/translation>(.|\n)*$")
(setq str (vlax-invoke-method regex "Replace" str ""))
(vlax-release-object RegEx)
str
)
(defun c:TRS(/ msg e dt d id new ss name)
(defun apperr (msg)
(command "undo" "e")
(setq *error* syserr)
(princ)
)
(setq syserr *error* *error* apperr)
(gc)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq e (nentsel "\nSelect text"))
(setq dt (entget (car e)))
(cond
(
(and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
(setq new (Translate (cdr (assoc 1 dt))))
)
(
(and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "TEXT"))
(setq new (Translate (cdr (assoc 1 dt))))
)
(
(and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "MTEXT"))
(setq new (Translate (cdr (assoc 1 dt))))
)
(
(and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTRIB"))
(setq new (Translate (cdr (assoc 1 dt))))
)
(
(and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTDEF"))
(setq new (Translate (cdr (assoc 2 dt))))
)
)
(if (= (cdr (assoc 0 (entget (car e)))) "ATTDEF")
(setq dt (subst (cons 2 new) (assoc 2 dt) dt))
(setq dt (subst (cons 1 new) (assoc 1 dt) dt))
)
(entmod dt)
(if (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
(progn
(setq name (cdr (assoc 2 (entget (car (last e))))))
(setq ss (ssget "x" '((0 . "insert"))) n 0)
(repeat (sslength ss)
(setq e (ssname ss n) n (1+ n))
(if (= (cdr (assoc 2 (entget e))) name)(entupd e))
)
)
(entupd (car e))
)
(apperr)
(princ)
)

(defun GetXML (url / XML http) 
(setq http (vlax-create-object "Microsoft.XMLHTTP")) 
(vlax-invoke-method http "open" "GET" url 0) 
(vlax-invoke-method http "send") 
(setq XML (vlax-get-property http "responseText")) 
(vlax-release-object http) 
XML 
) 
 
(defun Translate (word / RegEx str) 
(setq RegEx (vlax-create-object "VBScript.RegExp")) 
(vlax-put-property RegEx "Global" 1) 
(setq str (GetXML (strcat "http://fanyi.youdao.com/translate?&i=" word "&doctype=xml&version"))) 
(vlax-put-property RegEx "Pattern" "^(.|\n)*<translation>(.|\n)*?<![\[]CDATA[\[]") 
(setq str (vlax-invoke-method regex "Replace" str "")) 
(vlax-put-property RegEx "Pattern" "[\]]{2}>(.|\n)*<\/translation>(.|\n)*$") 
(setq str (vlax-invoke-method regex "Replace" str "")) 
(vlax-release-object RegEx) 
str 
) 
 
(defun c:TRS(/ msg e dt d id new ss name) 
(defun apperr (msg) 
    (command "undo" "e") 
  (setq *error* syserr) 
  (princ) 
) 
(setq syserr *error* *error* apperr) 
(gc) 
(setvar "cmdecho" 0) 
(command "undo" "be") 
(setq e (nentsel "\nSelect text")) 
(setq dt (entget (car e))) 
(cond 
  ( 
 (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT")) 
 (setq new (Translate (cdr (assoc 1 dt)))) 
  ) 
  ( 
 (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "TEXT")) 
 (setq new (Translate (cdr (assoc 1 dt)))) 
  ) 
  ( 
 (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "MTEXT")) 
 (setq new (Translate (cdr (assoc 1 dt)))) 
  ) 
  ( 
 (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTRIB")) 
 (setq new (Translate (cdr (assoc 1 dt)))) 
  ) 
  ( 
 (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTDEF")) 
 (setq new (Translate (cdr (assoc 2 dt)))) 
  ) 
) 
 
(if (= (cdr (assoc 0 (entget (car e)))) "ATTDEF") 
  (setq dt (subst (cons 2 new) (assoc 2 dt) dt)) 
  (setq dt (subst (cons 1 new) (assoc 1 dt) dt)) 
) 
(entmod dt) 
(if (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT")) 
  (progn 
  (setq name (cdr (assoc 2 (entget (car (last e)))))) 
  (setq ss (ssget "x" '((0 . "insert"))) n 0) 
  (repeat (sslength ss) 
  (setq e (ssname ss n) n (1+ n)) 
  (if (= (cdr (assoc 2 (entget e))) name)(entupd e)) 
  ) 
  ) 
  (entupd (car e)) 
) 
(apperr) 
(princ) 
)

cabinsummer · 发表于 2016-12-27 10:26:53

如果装有EXCEL2013，可以调用EXCEL的网络函数WebService和FilterXML从有道网站抓取翻译的结果。

cabinsummer · 发表于 2016-12-27 10:39:11

(defun youdao (word / func trs)
  (setq        func (vlax-get-property
               (vlax-get-or-create-object "Excel.Application")
               "WorkSheetFunction"
             ) ;_ end of vlax-get-property
  ) ;_ end of setq
  (setq        trs (vlax-variant-value
              (vlax-invoke-method
                func
                "filterxml"
                (vlax-invoke-method
                  func
                  "webservice"
                  (strcat "http://fanyi.youdao.com/translate?&i="
                          word
                          "&doctype=xml&version"
                  ) ;_ end of strcat
                ) ;_ end of vlax-invoke-method
                "//translate"
              ) ;_ end of vlax-invoke-method
            ) ;_ end of vlax-variant-value
  ) ;_ end of setq
  (vlax-release-object func)
  trs
) ;_ end of defun

Lisphk · 发表于 2016-12-27 10:48:14

cabinsummer 发表于 2016-12-27 10:39

楼主，低于2013的EXCEL能用吗？

cabinsummer · 发表于 2016-12-27 10:52:40

一楼的程序不用Excel，可以在任何情况下用，建议用这个。板凳楼层的程序只能在EXCEL2013及其以上的版本使用，而且还极不稳定，点快了容易出错。

Lisphk · 发表于 2016-12-27 11:01:15

cabinsummer 发表于 2016-12-27 10:52

楼主，我机器是2016版本的EXCEL，运行出错

命令: (youdao "建筑")
错误: Automation 错误。类 WorksheetFunction 的 FilterXML 方法无效

yufeng37 · 发表于 2016-12-28 09:32:46

正需要，支持楼主大人了！

zhangq_cai1 · 发表于 2016-12-28 12:09:56

确实是难得好帖啊，顶先

sicky111 · 发表于 2017-1-2 17:46:57

难得好帖。

账号		自动登录	找回密码
密码			立即注册

[每日一码] [风之影]VLISP之有道词典

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分