明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 3657|回复: 23

[【风之影】] [源码]VLISP之有道词典

  [复制链接]
发表于 2017-8-27 11:10 | 显示全部楼层 |阅读模式
由于明经前一段时间服务中断,恢复后有几篇帖子看不到了,所以从晓东网站上搬一个回家。

利用正则表达式和XMLHTTP,从有道词典网站取得翻译后的内容。
使用如下:
  1. (translate "风之影");;;返回"The shadow of wind"
  2. (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. (defun Translate (word / RegEx str)
  10.   (setq RegEx (vlax-create-object "VBScript.RegExp"))
  11.   (vlax-put-property RegEx "Global" 1)
  12.   (setq str (GetXML (strcat "http://fanyi.youdao.com/translate?&i=" word "&doctype=xml&version")))
  13.   (vlax-put-property RegEx "Pattern" "^(.|\n)*<translation>(.|\n)*?<![\[]CDATA[\[]")
  14.   (setq str (vlax-invoke-method regex "Replace" str ""))
  15.   (vlax-put-property RegEx "Pattern" "[\]]{2}>(.|\n)*<\/translation>(.|\n)*$")
  16.   (setq str (vlax-invoke-method regex "Replace" str ""))
  17.   (vlax-release-object RegEx)
  18.   str
  19. )

  20. (defun c:TRS(/ msg e dt d id new ss name)
  21.   (defun apperr (msg)
  22.     (command "undo" "e")
  23.     (setq *error* syserr)
  24.     (princ)
  25.   )
  26.   (setq syserr *error* *error* apperr)
  27.   (gc)
  28.   (setvar "cmdecho" 0)
  29.   (command "undo" "be")
  30.   (setq e (nentsel "\nSelect text"))
  31.   (setq dt (entget (car e)))
  32.   (cond
  33.     (
  34.       (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
  35.       (setq new (Translate (cdr (assoc 1 dt))))
  36.     )
  37.     (
  38.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "TEXT"))
  39.       (setq new (Translate (cdr (assoc 1 dt))))
  40.     )
  41.     (
  42.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "MTEXT"))
  43.       (setq new (Translate (cdr (assoc 1 dt))))
  44.     )
  45.     (
  46.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTRIB"))
  47.       (setq new (Translate (cdr (assoc 1 dt))))
  48.     )
  49.     (
  50.       (and (= (length e) 2)(= (cdr (assoc 0 (entget (car e)))) "ATTDEF"))
  51.       (setq new (Translate (cdr (assoc 2 dt))))
  52.     )
  53.   )
  54.   (if (= (cdr (assoc 0 (entget (car e)))) "ATTDEF")
  55.     (setq dt (subst (cons 2 new) (assoc 2 dt) dt))
  56.     (setq dt (subst (cons 1 new) (assoc 1 dt) dt))
  57.   )
  58.   (entmod dt)
  59.   (if (and (> (length e) 2)(= (cdr (assoc 0 (entget (car (last e))))) "INSERT"))
  60.     (progn
  61.       (setq name (cdr (assoc 2 (entget (car (last e))))))
  62.       (setq ss (ssget "x" '((0 . "insert"))) n 0)
  63.       (repeat (sslength ss)
  64.       (setq e (ssname ss n) n (1+ n))
  65.       (if (= (cdr (assoc 2 (entget e))) name)(entupd e))
  66.     )
  67.   )
  68.   (entupd (car e))
  69.   )
  70.   (apperr)
  71.   (princ)
  72. )

评分

参与人数 4明经币 +5 金钱 +30 收起 理由
LPACMQ + 1 神马都是浮云
669423907 + 1 很给力!
头大无恼 + 1 不是一般的牛
highflybird + 2 + 30 很给力!

查看全部评分

发表于 2017-8-28 07:55 | 显示全部楼层
非常感谢大师分享程序
发表于 2017-8-28 08:18 | 显示全部楼层
牛啊,佩服大师杰作!!!!!!!!!!
发表于 2017-8-28 09:12 | 显示全部楼层
学习学习,谢谢分享。
发表于 2017-8-28 18:03 | 显示全部楼层

非常感谢大师分享程序
发表于 2017-8-28 21:04 | 显示全部楼层
有创意,谢谢分享!
发表于 2017-8-29 08:27 | 显示全部楼层
这个不错,很有用。谢谢分享!
发表于 2017-8-29 09:09 | 显示全部楼层
太强大了,其实princ到命令行也不错呢。
发表于 2017-8-29 12:38 | 显示全部楼层
这个挺方便的!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2019-12-12 19:08 , Processed in 0.170207 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表