[庆祝元旦] lisp 混合编程示例

yxp

先看个动态效果：

lisp 源码如下：
注意：需要 OpenDCL 库支持； 系统 DWX 注册支持

1. ;;lisp 胶水一, by: yxp        2018-12-26
   
2. ;;语言: lisp/OpenDCL/html/js/dwx
   
3. ;;系统: windows10,  AutoCAD 64 位
   
4. ;;环境: 需要 OpenDCL 库支持； 系统 DWX 注册
   
5. ;;文件: html.lsp  autoCAD 加载的主要 lisp 文件
   
6. ;;     html.odcl 对话框主文件
   
7. ;;     html.html 对话框加载的网页文件
   
8. ;;     html.js   网页 JavaScript 脚本文件
   
9. ;;     html.css  网页 css 样式文件
   
10. 
    
11. (defun c:html()
    
12. 
    
13. (setq objCAD (vlax-get-acad-object)      ;;当前打开的 CAD 对象
    
14.   *dwg* (vla-get-ActiveDocument objCAD) ;;当前激活的 dwg 文档对象
    
15.   hCAD (vla-get-hwnd objCAD)            ;;顶层 CAD 对象句柄
    
16.   hdwg (vla-get-hwnd *dwg*)             ;;当前 dwg 对象句柄
    
17.   DWX (vlax-create-object "DynamicWrapperX"))
    
18. 
    
19. ;;=================================================
    
20. ;;取消 IE7.0 的 active 提示
    
21. (setq regPath "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings\\Zones\\0"
    
22.   regValue (vl-registry-read regPath "1201"))
    
23. (if (or (null regValue)(/= regValue 0))(vl-registry-write regPath "1201" 0))
    
24. ;;=================================================
    
25. 
    
26. (dcl-Project-Load "d:/caddcl/test/html.odcl" t nil) ;;加载对话框
    
27. (dcl-Form-Show html/Form1) ;;显示 opendcl
    
28. 
    
29. (setq data (vlax-invoke DWX 'strget dataAddress)) ;;读取对话框传来的内存数据
    
30. (princ data) ;;显示 html 控件内容
    
31. (princ)
    
32. )
    
33. 
    
34. ;;odcl 初始化
    
35. (defun c:html/Form1#OnInitialize (/ w h)
    
36.   (dcl-Html-Navigate html/Form1/Html1 (findfile "home.html"))
    
37.   (setq w (dcl-Control-GetWidth html/Form1) h (dcl-Control-GetHeight html/Form1))
    
38.   (dcl-Control-SetPos html/Form1/Html1 0 0 w h)
    
39. )
    
40. 
    
41. ;;退出时提取内存地址，采用对话框标题行转运数据，也可用注册表
    
42. (defun c:html/Form1#OnCancel (/ ss pStr hWin)
    
43.   (vlax-invoke DWX 'Register "user32" "GetWindowTextW" "i=hpm" "r=m")
    
44.   (setq pStr (vlax-invoke dwx 'MemAlloc 20 1)) ;;分配内存，用来存放数据的内存地址
    
45.   (setq hWin (dcl-Control-GetHWND html/Form1)) ;;获取 openDcl 对话框的句柄
    
46.   (vlax-invoke DWX 'GetWindowTextW hWin pStr 16) ;;读取对话框的标题行（内存地址传递）
    
47.   (setq dataAddress (atoi (vlax-invoke DWX 'strget pStr))) ;;将内存地址给 lisp 变量
    
48. )
    
49. 
    
50. 
    
51. ;;OpenDCL 环境自动载入
    
52. (vl-load-com)
    
53. (setq ODCLREG (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)
    
54.      "\\Applications\\OpenDCL"))
    
55. (or dcl_getversionex  ;;判断 OPEDCL 环境是否加载
    
56. (if (setq Phd (vl-registry-read ODCLREG "Loader")) ;;ODCL 是否安装
    
57.     (progn
    
58.         (arxload Phd)
    
59.         (setq ODCLREG nil Phd nil)
    
60.         ;;(princ "\n测试 ODCL 环境从 C 盘加载")
    
61.     )
    
62.     (progn  ;;如果 OPENDCL 没有安装则搜索 arx 文件是否存在
    
63.       (defun Load_OdclRuntime (/ vers arxname darx *error*)
    
64.         (defun *error* (msg)  ;;错误中断提示
    
65.             (princ (strcat "\n程序加载失败，文件 " arxname " 缺失"))
    
66.             (princ)
    
67.         )
    
68.         (setq vers (substr (getvar "acadver") 1 2))
    
69.         (setq arxname (strcat "OpenDCL."
    
70.             (if (= (getenv "PROCESSOR_ARCHITECTURE") "AMD64")
    
71.                 "x64." "") vers ".arx"))  ;;区分 CAD 位
    
72.         (if (setq darx (findfile arxname))
    
73.             (if (null (member arxname (arx)))(arxload darx))
    
74.             (exit) ;;支持路径未搜到 arx，调用错误中断
    
75.         )
    
76.       )
    
77.         (Load_OdclRuntime) ;;运行加载函数
    
78.         (setq Load_OdclRuntime nil) ;;释放加载函数
    
79.     )
    
80. )
    
81. );;THE END of LOAD ODCL
    
82. 
    
83. (princ)
    

;;lisp 胶水一, by: yxp        2018-12-26<br /> ;;语言: lisp/OpenDCL/html/js/dwx<br /> ;;系统: windows10,  <a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a> 64 位<br /> ;;环境: 需要 OpenDCL 库支持； 系统 DWX 注册<br /> ;;文件: html.lsp  autoCAD 加载的主要 lisp 文件<br /> ;;     html.odcl 对话框主文件<br /> ;;     html.html 对话框加载的网页文件<br /> ;;     html.js   网页 JavaScript 脚本文件<br /> ;;     html.css  网页 css 样式文件<br /> <br /> (defun c:html()<br /> <br /> (setq objCAD (vlax-get-acad-object)      ;;当前打开的 CAD 对象<br />   *dwg* (vla-get-ActiveDocument objCAD) ;;当前激活的 dwg 文档对象<br />   hCAD (vla-get-hwnd objCAD)            ;;顶层 CAD 对象句柄<br />   hdwg (vla-get-hwnd *dwg*)             ;;当前 dwg 对象句柄<br />   DWX (vlax-create-object "DynamicWrapperX"))<br /> <br /> ;;=================================================<br /> ;;取消 IE7.0 的 active 提示<br /> (setq regPath "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings\\Zones\\0"<br />   regValue (vl-registry-read regPath "1201"))<br /> (if (or (null regValue)(/= regValue 0))(vl-registry-write regPath "1201" 0))<br /> ;;=================================================<br /> <br /> (dcl-Project-Load "d:/caddcl/test/html.odcl" t nil) ;;加载对话框<br /> (dcl-Form-Show html/Form1) ;;显示 opendcl<br /> <br /> (setq data (vlax-invoke DWX 'strget dataAddress)) ;;读取对话框传来的内存数据<br /> (princ data) ;;显示 html 控件内容<br /> (princ)<br /> )<br /> <br /> ;;odcl 初始化<br /> (defun c:html/Form1#OnInitialize (/ w h)<br />   (dcl-Html-Navigate html/Form1/Html1 (findfile "home.html"))<br />   (setq w (dcl-Control-GetWidth html/Form1) h (dcl-Control-GetHeight html/Form1))<br />   (dcl-Control-SetPos html/Form1/Html1 0 0 w h)<br /> )<br /> <br /> ;;退出时提取内存地址，采用对话框标题行转运数据，也可用注册表<br /> (defun c:html/Form1#OnCancel (/ ss pStr hWin)<br />   (vlax-invoke DWX 'Register "user32" "GetWindowTextW" "i=hpm" "r=m")<br />   (setq pStr (vlax-invoke dwx 'MemAlloc 20 1)) ;;分配内存，用来存放数据的内存地址<br />   (setq hWin (dcl-Control-GetHWND html/Form1)) ;;获取 openDcl 对话框的句柄<br />   (vlax-invoke DWX 'GetWindowTextW hWin pStr 16) ;;读取对话框的标题行（内存地址传递）<br />   (setq dataAddress (atoi (vlax-invoke DWX 'strget pStr))) ;;将内存地址给 lisp 变量<br /> )<br /> <br /> <br /> ;;OpenDCL 环境自动载入<br /> (vl-load-com)<br /> (setq ODCLREG (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)<br />      "\\Applications\\OpenDCL"))<br /> (or dcl_getversionex  ;;判断 OPEDCL 环境是否加载<br /> (if (setq Phd (vl-registry-read ODCLREG "Loader")) ;;ODCL 是否安装<br />     (progn<br />         (arxload Phd)<br />         (setq ODCLREG nil Phd nil)<br />         ;;(princ "\n测试 ODCL 环境从 C 盘加载")<br />     )<br />     (progn  ;;如果 OPENDCL 没有安装则搜索 arx 文件是否存在<br />       (defun Load_OdclRuntime (/ vers arxname darx *error*)<br />         (defun *error* (msg)  ;;错误中断提示<br />             (princ (strcat "\n程序加载失败，文件 " arxname " 缺失"))<br />             (princ)<br />         )<br />         (setq vers (substr (getvar "acadver") 1 2))<br />         (setq arxname (strcat "OpenDCL."<br />             (if (= (getenv "PROCESSOR_ARCHITECTURE") "AMD64")<br />                 "x64." "") vers ".arx"))  ;;区分 CAD 位<br />         (if (setq darx (findfile arxname))<br />             (if (null (member arxname (arx)))(arxload darx))<br />             (exit) ;;支持路径未搜到 arx，调用错误中断<br />         )<br />       )<br />         (Load_OdclRuntime) ;;运行加载函数<br />         (setq Load_OdclRuntime nil) ;;释放加载函数<br />     )<br /> )<br /> );;THE END of LOAD ODCL<br /> <br /> (princ)<br />

其他文件打包下载，添加到支持路径即可加载运行。

ynhh

啥，还能编辑。

zixuan203344

蜜蜂大神666。

自从老汉你不玩推车改玩技术了，技术突飞猛进啊

zixuan203344

蜜蜂大神元旦快乐~

pengfei2010

没看明白，这个效果用 lisp+ODcl 就可以实现呀！

lllllja

厉害啦

JHX948954875

谢谢楼主分享

纵横八方

蜜蜂大神，来点实用的

mokson

向高手学习！

zzyong00

帮楼主顶一下