[源码]VLISP之有道词典

cabinsummer

由于明经前一段时间服务中断，恢复后有几篇帖子看不到了，所以从晓东网站上搬一个回家。

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

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

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

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

1. (defun GetXML (url / XML http)
   
2.   (setq http (vlax-create-object "Microsoft.XMLHTTP"))
   
3.   (vlax-invoke-method http "open" "GET" url 0)
   
4.   (vlax-invoke-method http "send")
   
5.   (setq XML (vlax-get-property http "responseText"))
   
6.   (vlax-release-object http)
   
7.   XML
   
8. )
   
9. 
   
10. (defun Translate (word / RegEx str)
    
11.   (setq RegEx (vlax-create-object "VBScript.RegExp"))
    
12.   (vlax-put-property RegEx "Global" 1)
    
13.   (setq str (GetXML (strcat "http://fanyi.youdao.com/translate?&i=" word "&doctype=xml&version")))
    
14.   (vlax-put-property RegEx "Pattern" "^(.|\n)*<translation>(.|\n)*?<![\[]CDATA[\[]")
    
15.   (setq str (vlax-invoke-method regex "Replace" str ""))
    
16.   (vlax-put-property RegEx "Pattern" "[\]]{2}>(.|\n)*<\/translation>(.|\n)*$")
    
17.   (setq str (vlax-invoke-method regex "Replace" str ""))
    
18.   (vlax-release-object RegEx)
    
19.   str
    
20. )
    
21. 
    
22. (defun c:TRS(/ msg e dt d id new ss name)
    
23.   (defun apperr (msg)
    
24.     (command "undo" "e")
    
25.     (setq *error* syserr)
    
26.     (princ)
    
27.   )
    
28.   (setq syserr *error* *error* apperr)
    
29.   (gc)
    
30.   (setvar "cmdecho" 0)
    
31.   (command "undo" "be")
    
32.   (setq e (nentsel "\nSelect text"))
    
33.   (setq dt (entget (car e)))
    
34.   (cond
    
35.     (
    
36.       (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
    
37.       (setq new (Translate (cdr (assoc 1 dt))))
    
38.     )
    
39.     (
    
40.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "TEXT"))
    
41.       (setq new (Translate (cdr (assoc 1 dt))))
    
42.     )
    
43.     (
    
44.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "MTEXT"))
    
45.       (setq new (Translate (cdr (assoc 1 dt))))
    
46.     )
    
47.     (
    
48.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTRIB"))
    
49.       (setq new (Translate (cdr (assoc 1 dt))))
    
50.     )
    
51.     (
    
52.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTDEF"))
    
53.       (setq new (Translate (cdr (assoc 2 dt))))
    
54.     )
    
55.   )
    
56.   (if (= (cdr (assoc 0 (entget (car e)))) "ATTDEF")
    
57.     (setq dt (subst (cons 2 new) (assoc 2 dt) dt))
    
58.     (setq dt (subst (cons 1 new) (assoc 1 dt) dt))
    
59.   )
    
60.   (entmod dt)
    
61.   (if (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
    
62.     (progn
    
63.       (setq name (cdr (assoc 2 (entget (car (last e))))))
    
64.       (setq ss (ssget "x" '((0 . "insert"))) n 0)
    
65.       (repeat (sslength ss)
    
66.       (setq e (ssname ss n) n (1+ n))
    
67.       (if (= (cdr (assoc 2 (entget e))) name)(entupd e))
    
68.     )
    
69.   )
    
70.   (entupd (car e))
    
71.   )
    
72.   (apperr)
    
73.   (princ)
    
74. )

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

eii

是，我的也不能用了，出现下面的提示文字
<!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就能办到，但我不知道怎么用。

clh521

非常有用。但有个问题，多行文字如果带有格式的，翻译后，格式符出一起显示出来了。好像G版有个去除格式的函数，我找找看。

lrd1861

USER2128

非常感谢大师分享程序

kexiya123

牛啊，佩服大师杰作！！！！！！！！！！

cadyeah

学习学习，谢谢分享。

sowin

非常感谢大师分享程序

yshf

有创意，谢谢分享！

原地踏步

这个不错，很有用。谢谢分享！

jun353835273

太强大了，其实princ到命令行也不错呢。

434939575

这个挺方便的！