[庆祝元旦] lisp 混合编程示例
先看个动态效果：lisp 源码如下：
注意：需要 OpenDCL 库支持； 系统 DWX 注册支持
;;lisp 胶水一, by: yxp 2018-12-26
;;语言: lisp/OpenDCL/html/js/dwx
;;系统: windows10,AutoCAD 64 位
;;环境: 需要 OpenDCL 库支持； 系统 DWX 注册
;;文件: html.lspautoCAD 加载的主要 lisp 文件
;; html.odcl 对话框主文件
;; html.html 对话框加载的网页文件
;; html.js 网页 JavaScript 脚本文件
;; html.css网页 css 样式文件
(defun c:html()
(setq objCAD (vlax-get-acad-object) ;;当前打开的 CAD 对象
*dwg* (vla-get-ActiveDocument objCAD) ;;当前激活的 dwg 文档对象
hCAD (vla-get-hwnd objCAD) ;;顶层 CAD 对象句柄
hdwg (vla-get-hwnd *dwg*) ;;当前 dwg 对象句柄
DWX (vlax-create-object "DynamicWrapperX"))
;;=================================================
;;取消 IE7.0 的 active 提示
(setq regPath "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings\\Zones\\0"
regValue (vl-registry-read regPath "1201"))
(if (or (null regValue)(/= regValue 0))(vl-registry-write regPath "1201" 0))
;;=================================================
(dcl-Project-Load "d:/caddcl/test/html.odcl" t nil) ;;加载对话框
(dcl-Form-Show html/Form1) ;;显示 opendcl
(setq data (vlax-invoke DWX 'strget dataAddress)) ;;读取对话框传来的内存数据
(princ data) ;;显示 html 控件内容
(princ)
)
;;odcl 初始化
(defun c:html/Form1#OnInitialize (/ w h)
(dcl-Html-Navigate html/Form1/Html1 (findfile "home.html"))
(setq w (dcl-Control-GetWidth html/Form1) h (dcl-Control-GetHeight html/Form1))
(dcl-Control-SetPos html/Form1/Html1 0 0 w h)
)
;;退出时提取内存地址，采用对话框标题行转运数据，也可用注册表
(defun c:html/Form1#OnCancel (/ ss pStr hWin)
(vlax-invoke DWX 'Register "user32" "GetWindowTextW" "i=hpm" "r=m")
(setq pStr (vlax-invoke dwx 'MemAlloc 20 1)) ;;分配内存，用来存放数据的内存地址
(setq hWin (dcl-Control-GetHWND html/Form1)) ;;获取 openDcl 对话框的句柄
(vlax-invoke DWX 'GetWindowTextW hWin pStr 16) ;;读取对话框的标题行（内存地址传递）
(setq dataAddress (atoi (vlax-invoke DWX 'strget pStr))) ;;将内存地址给 lisp 变量
)
;;OpenDCL 环境自动载入
(vl-load-com)
(setq ODCLREG (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)
"\\Applications\\OpenDCL"))
(or dcl_getversionex;;判断 OPEDCL 环境是否加载
(if (setq Phd (vl-registry-read ODCLREG "Loader")) ;;ODCL 是否安装
(progn
(arxload Phd)
(setq ODCLREG nil Phd nil)
;;(princ "\n测试 ODCL 环境从 C 盘加载")
)
(progn;;如果 OPENDCL 没有安装则搜索 arx 文件是否存在
(defun Load_OdclRuntime (/ vers arxname darx *error*)
(defun *error* (msg);;错误中断提示
(princ (strcat "\n程序加载失败，文件 " arxname " 缺失"))
(princ)
)
(setq vers (substr (getvar "acadver") 1 2))
(setq arxname (strcat "OpenDCL."
(if (= (getenv "PROCESSOR_ARCHITECTURE") "AMD64")
"x64." "") vers ".arx"));;区分 CAD 位
(if (setq darx (findfile arxname))
(if (null (member arxname (arx)))(arxload darx))
(exit) ;;支持路径未搜到 arx，调用错误中断
)
)
(Load_OdclRuntime) ;;运行加载函数
(setq Load_OdclRuntime nil) ;;释放加载函数
)
)
);;THE END of LOAD ODCL
(princ)
其他文件打包下载，添加到支持路径即可加载运行。
本帖最后由 yxp 于 2018-12-26 20:19 编辑
啥，还能编辑。 蜜蜂大神666。
自从老汉你不玩推车改玩技术了，技术突飞猛进啊
蜜蜂大神元旦快乐~ 没看明白，这个效果用 lisp+ODcl 就可以实现呀！ 厉害啦 谢谢楼主分享 蜜蜂大神，来点实用的 向高手学习！
帮楼主顶一下
页:
[1]