autoLisp 显示及控制 IE 浏览器的一种方法

yxp · 发表于 2020-7-15 18:56

本帖最后由 yxp 于 2020-7-15 19:11 编辑

用 autolisp 显示一个浏览器窗口，并展示来自程序或网络的内容。通常情况，可以创建一个 activex 对象进行操作。IE 文档对象的方法、事件、属性可参考 MSDN 网站，但是在 win10 x64 环境中不可行，具体如下。

在 CAD 命令行中运行以下代码:
(setq ie (vlax-create-object “InternetExplorer.Application”))
(vlax-property-available-p ie 'Document) ;;返回 nil
(vlax-method-applicable-p ie 'Navigate) ;;返回nil
(vlax-dump-object xx t) ;;返回对象不支持 ITypeInfo 接口

这种方法在 win10 x64 环境中行不通，经过本人测试，在 AutoCAD 中除了 openDCL 第三方插件，还可以用 Windows 的 hta 技术来创建并控制一个网页。如果需要浏览器向 CAD 发出数据通讯，则需要借助 IE 的 activex 对象，通过 COM 接口向 CAD 输入数据。
将以下代码保存到磁盘并在 CAD 中加载后，在命令窗口依次输入：
(lsp2html) 创建一个 ie 对象
(add-dot) 向浏览器添加文档节点

;; lisp 创建及控制 ie 对象示例
(defun lsp2html (/ runStr)
(setq obj_ws (vlax-get-or-create-object "WScript.Shell")
runStr (strcat (getenv "Windir") ;;showintaskbar=no 任务栏不显示图标
"\\syswow64\\mshta.exe about:\"<head><hta:application><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('AutocadDemo',document.parentWindow);</script></head>\""
)
)
(vlax-invoke obj_ws 'run runStr 0 0) ;; 最后一个 0 是异步执行
(vlax-release-object obj_ws)
)
;; 获取 ie 窗口的控制句柄
;; 由于 ie 窗口异步创建，如果运行 (lsp2html) 后立即执行本函数，将无法获取窗口控制，需要一定的延迟时间
(defun get-windows (/ n counts)
(setq obj_app (vlax-get-or-create-object "Shell.Application")
win (vlax-invoke obj_app 'Windows)
counts (vlax-get-property win 'count)
n 0
)
(while
(progn
(setq f (vlax-invoke win 'item n)
n (1+ n)
)
(setq *html* (if f (vlax-invoke f 'GetProperty "AutocadDemo")))
(and (<= n counts) (null *html*))
)
)
(vlax-release-object obj_app)
)
;; 向浏览器窗口输出网页文字
;; 右键页面刷新后，仍将显示 write 的输出内容
(defun doc-write ()
(if (null *html*) (get-windows))
(setq *doc* (vlax-get-property *html* 'document)) ;; 获取浏览器的 document 对象
(vlax-put-property *doc* 'title "AutoLisp调用浏览器展示")
(vlax-invoke *doc*
'write
"<html><head></head><body><h1>LISP生成的网页</h1><div id='divA'>使用 AutoLisp 控制浏览器对象，展示新的内容</div></body></html>"
)
)
;; document 对象节点控制
(defun add-dot ()
(if (null *doc*) (doc-write))
(setq divA (vlax-invoke *doc* 'getElementById "divA")) ;; 获取 id 节点元素对象
(if divA
(progn
(setq oldhtml (vlax-get-property divA 'innerHTML)
newhtml (strcat oldhtml
"<br><font color='red'>采用 Windows HTA 技术，</font><b>将网页整合</b>为文件"
"<br><button οnclick='runAlert()'>修改标题</button><button οnclick='reWinSize()'>浏览器尺寸</button>"
"<br><button οnclick='window.print()'>页面打印</button><button οnclick='winClose()'>窗口关闭</button>"
"<br><img class='picture' src='http://bbs.mjtd.com/static/image/common/logo.png'>"
)
)
(vlax-put-property divA 'innerHTML newhtml) ;; 修改 id 节点内容
)
)
)
;; 页面添加 css 样式文件
(defun add-css ()
;; 创建一个 css 样式组件 link 对象
(setq css (vlax-invoke *doc* 'createElement "link"))
(vlax-put-property css 'rel "stylesheet")
(vlax-put-property css 'href "d:\\cad\\test\\demo.css")
(setq heads (vlax-invoke *doc* 'getElementsByTagName "head")
head (vlax-invoke heads 'item 0)
)
(vlax-invoke head 'appendChild css) ;; 在 head 后添加
)
;; 页面导入 JavaScript 文件引用
(defun add-js ()
;; 创建一个 script 元素对象
(setq js (vlax-invoke *doc* 'createElement "script"))
(vlax-put-property js 'type "text/javascript")
(vlax-put-property js 'src "d:\\cad\\test\\demo.js") ;; 文件引用式添加
(setq heads (vlax-invoke *doc* 'getElementsByTagName "head")
head (vlax-invoke heads 'item 0)
)
(vlax-invoke head 'appendChild js) ;; 在 head 后添加
)

;; lisp 创建及控制 ie 对象示例<br />
(defun lsp2html (/ runStr) <br />
  (setq obj_ws (vlax-get-or-create-object "WScript.Shell")<br />
        runStr (strcat (getenv "Windir")  ;;showintaskbar=no 任务栏不显示图标<br />
                       "\\syswow64\\mshta.exe about:\"<head><hta:application><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('AutocadDemo',document.parentWindow);</script></head>\""<br />
               )<br />
  )<br />
  (vlax-invoke obj_ws 'run runStr 0 0) ;; 最后一个 0 是异步执行<br />
  (vlax-release-object obj_ws)<br />
)<br />
<br />
;; 获取 ie 窗口的控制句柄<br />
;; 由于 ie 窗口异步创建，如果运行 (lsp2html) 后立即执行本函数，将无法获取窗口控制，需要一定的延迟时间<br />
(defun get-windows (/ n counts) <br />
  (setq obj_app (vlax-get-or-create-object "Shell.Application")<br />
        win     (vlax-invoke obj_app 'Windows)<br />
        counts  (vlax-get-property win 'count)<br />
        n       0<br />
  )<br />
  (while <br />
    (progn <br />
      (setq f (vlax-invoke win 'item n)<br />
            n (1+ n)<br />
      )<br />
      (setq *html* (if f (vlax-invoke f 'GetProperty "AutocadDemo")))<br />
      (and (<= n counts) (null *html*))<br />
    )<br />
  )<br />
  (vlax-release-object obj_app)<br />
)<br />
<br />
;; 向浏览器窗口输出网页文字<br />
;; 右键页面刷新后，仍将显示 write 的输出内容<br />
(defun doc-write () <br />
  (if (null *html*) (get-windows))<br />
  (setq *doc* (vlax-get-property *html* 'document)) ;; 获取浏览器的 document 对象<br />
  (vlax-put-property *doc* 'title "AutoLisp调用浏览器展示")<br />
  (vlax-invoke *doc* <br />
               'write<br />
               "<html><head></head><body><h1>LISP生成的网页</h1><div id='divA'>使用 AutoLisp 控制浏览器对象，展示新的内容</div></body></html>"<br />
  )<br />
)<br />
<br />
;; document 对象节点控制<br />
(defun add-dot ()<br />
  (if (null *doc*) (doc-write))<br />
  (setq divA (vlax-invoke *doc* 'getElementById "divA")) ;; 获取 id 节点元素对象<br />
  (if divA <br />
    (progn <br />
      (setq oldhtml (vlax-get-property divA 'innerHTML)<br />
            newhtml (strcat oldhtml <br />
                            "<br><font color='red'>采用 Windows HTA 技术，</font><b>将网页整合</b>为文件" <br />
                            "<br><button οnclick='runAlert()'>修改标题</button><button οnclick='reWinSize()'>浏览器尺寸</button>" <br />
                            "<br><button οnclick='window.print()'>页面打印</button><button οnclick='winClose()'>窗口关闭</button>"<br />
                            "<br><img class='picture' src='http://bbs.mjtd.com/static/image/common/logo.png'>"<br />
                    ) <br />
      )<br />
      (vlax-put-property divA 'innerHTML newhtml) ;; 修改 id 节点内容<br />
    )<br />
  )<br />
)<br />
<br />
;; 页面添加 css 样式文件<br />
(defun add-css () <br />
  ;; 创建一个 css 样式组件 link 对象<br />
  (setq css (vlax-invoke *doc* 'createElement "link"))<br />
  (vlax-put-property css 'rel "stylesheet")<br />
  (vlax-put-property css 'href "d:\\cad\\test\\demo.css")<br />
  (setq heads (vlax-invoke *doc* 'getElementsByTagName "head")<br />
        head  (vlax-invoke heads 'item 0)<br />
  )<br />
  (vlax-invoke head 'appendChild css) ;; 在 head 后添加<br />
)<br />
<br />
;; 页面导入 JavaScript 文件引用<br />
(defun add-js () <br />
  ;; 创建一个 script 元素对象<br />
  (setq js (vlax-invoke *doc* 'createElement "script"))<br />
  (vlax-put-property js 'type "text/javascript")<br />
  (vlax-put-property js 'src "d:\\cad\\test\\demo.js") ;; 文件引用式添加<br />
  (setq heads (vlax-invoke *doc* 'getElementsByTagName "head")<br />
        head  (vlax-invoke heads 'item 0)<br />
  )<br />
  (vlax-invoke head 'appendChild js) ;; 在 head 后添加<br />
)<br />

将以下 js 代码保存 d:\cad\test\demo.js 文件中，并在 CAD 中运行 (add-js) ，即可向页面导入 javascript 文件

// 修改窗口标题
function runAlert() {
document.title = "CAD控制浏览器示例";
alert('窗口标题已修改');
}
// 页面移动及尺寸
function reWinSize() {
window.moveTo(20, 20); // 窗口移动
window.resizeTo(600, 350); // 窗口大小
}
// 页面关闭
function winClose() {
window.opener = null;
window.open('', '_self');
window.close();
}

将以下 css 样式文件保存在 d:\cad\test\demo.css 中，并在 CAD 命令行中运行 (add-css) 向页面添加 css 样式文件

* {
padding: 0;
margin: 0;
}
body {
background-color: burlywood;
overflow-y: hidden;
margin: 0 auto;
}
#divA {
padding: 10px;
background-color: #ebd7a1;
line-height: 20px;
text-align: center;
border-radius: 10px;
}
button {
margin: 3px 0;
}
.picture {
margin: 10px;
}

源码打包下载：

845245015 · 发表于 2020-7-15 22:12

膜拜大神，啥时候搞个AI+autolisp+AutoCAD出来

lxl217114 · 发表于 2020-7-16 09:53

为Y版的钻研点赞

itoboy · 发表于 2020-7-16 14:54

支持高手的作品

baitang36 · 发表于 2020-7-17 20:34

很牛叉的操作

菜卷鱼 · 发表于 2020-7-18 16:11

哇塞，好东西，
这样是不是可以用览器做表格？dcl做表格太low了，
接下来的问题是，假如用html做了表格，选中了表格的一行数据，能否把选中的数据传回CAD中

mokson · 发表于 2020-7-18 20:23

牛人真多。想问一下，lisp可以不可以新建或删除文件？

zark · 发表于 2020-7-18 21:14

可以做一个用LISP版的微信支付

77077 · 发表于 2020-9-7 16:32

膜拜中，请问HTML如何与CAD互通？这样就可以抛弃DCL了。:D

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

[源码] autoLisp 显示及控制 IE 浏览器的一种方法

本帖子中包含更多资源

评分

点评