[风之影]VLISP之有道词典

cabinsummer · 发表于 2016-12-27 08:01:45

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

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

×

本帖最后由 cabinsummer 于 2017-1-2 22:13 编辑

利用正则表达式和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) 
)

yjch · 发表于 2016-12-27 08:08:43

好好学习天天向上

/db_自贡黄明儒_ · 发表于 2016-12-27 09:15:08

这是明经、晓东两大主力上第一个网抓贴,建议为精华

Lisphk · 发表于 2016-12-27 10:51:08

/db_自贡黄明儒_ 发表于 2016-12-27 09:15

黄总，难道就我一个人看楼主的帖子都是火星文吗，黄总给翻译下呗。

cabinsummer · 发表于 2016-12-27 11:09:13

手机编辑后就是这样了，明经和晓东都是这样，可以看另一个帖子

/db_自贡黄明儒_ · 发表于 2016-12-27 13:18:50

Lisphk 发表于 2016-12-27 10:51

刚才好好的，可能是风版编辑一下出问题了。

shenfjliu · 发表于 2016-12-27 22:16:23

？？看不了，是乱码啊

cabinsummer · 发表于 2016-12-28 14:37:43

手机上能看到时网页是UNICODE编码，改成中文简体后就是乱码了。估计手机编辑帖子的字符集和显示的不一致

cq_qg68 · 发表于 2016-12-29 08:42:03

都是乱码，看不懂

sunshinejwt · 发表于 2016-12-29 16:03:18

这个真的不知道是什么，乱码啊

sicky111 · 发表于 2017-1-1 22:16:07

看不懂是什么

xvjiex · 发表于 2021-11-26 07:41:28

感谢分享[风之影]VLISP之有道词典

guosheyang2 · 发表于 2021-11-26 12:00:20

非常好的帖子感谢共享！

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

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

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