[源码]VLISP之有道词典
由于明经前一段时间服务中断，恢复后有几篇帖子看不到了，所以从晓东网站上搬一个回家。利用正则表达式和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)
)
本帖最后由 eii 于 2023-12-2 23:58 编辑
是，我的也不能用了，出现下面的提示文字
<!doctype html><html lang="en"><head><title>HTTP Status 400 – Bad Request</title><style type="text/css">body {font-family:Tahoma,Arial,sans-serif;} h1, h2, h3, b {color:white;background-color:#525D76;} h1 {font-size:22px;} h2 {font-size:16px;} h3 {font-size:14px;} p {font-size:12px;} a {color:black;} .line {height:1px;background-color:#525D76;border:none;}</style></head><body><h1>HTTP Status 400 – Bad Request</h1></body></html>
pzweng 发表于 2023-9-5 11:21
大师出手折腾一下
以前用VBA网抓过，这次试了一下，我也抓不了了。问了一下zxcad,他说他的DBO.vlx就能办到，但我不知道怎么用。
非常有用。但有个问题，多行文字如果带有格式的，翻译后，格式符出一起显示出来了。好像G版有个去除格式的函数，我找找看。 非常感谢大师分享程序 牛啊，佩服大师杰作！！！！！！！！！！ 学习学习，谢谢分享。
非常感谢大师分享程序 有创意，谢谢分享！ 这个不错，很有用。谢谢分享！ 太强大了，其实princ到命令行也不错呢。 这个挺方便的！