明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2074|回复: 9

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

[复制链接]
发表于 2018-12-26 15:53 | 显示全部楼层 |阅读模式
先看个动态效果:

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. (defun c:html()

  11. (setq objCAD (vlax-get-acad-object)      ;;当前打开的 CAD 对象
  12.   *dwg* (vla-get-ActiveDocument objCAD) ;;当前激活的 dwg 文档对象
  13.   hCAD (vla-get-hwnd objCAD)            ;;顶层 CAD 对象句柄
  14.   hdwg (vla-get-hwnd *dwg*)             ;;当前 dwg 对象句柄
  15.   DWX (vlax-create-object "DynamicWrapperX"))

  16. ;;=================================================
  17. ;;取消 IE7.0 的 active 提示
  18. (setq regPath "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings\\Zones\\0"
  19.   regValue (vl-registry-read regPath "1201"))
  20. (if (or (null regValue)(/= regValue 0))(vl-registry-write regPath "1201" 0))
  21. ;;=================================================

  22. (dcl-Project-Load "d:/caddcl/test/html.odcl" t nil) ;;加载对话框
  23. (dcl-Form-Show html/Form1) ;;显示 opendcl

  24. (setq data (vlax-invoke DWX 'strget dataAddress)) ;;读取对话框传来的内存数据
  25. (princ data) ;;显示 html 控件内容
  26. (princ)
  27. )

  28. ;;odcl 初始化
  29. (defun c:html/Form1#OnInitialize (/ w h)
  30.   (dcl-Html-Navigate html/Form1/Html1 (findfile "home.html"))
  31.   (setq w (dcl-Control-GetWidth html/Form1) h (dcl-Control-GetHeight html/Form1))
  32.   (dcl-Control-SetPos html/Form1/Html1 0 0 w h)
  33. )

  34. ;;退出时提取内存地址,采用对话框标题行转运数据,也可用注册表
  35. (defun c:html/Form1#OnCancel (/ ss pStr hWin)
  36.   (vlax-invoke DWX 'Register "user32" "GetWindowTextW" "i=hpm" "r=m")
  37.   (setq pStr (vlax-invoke dwx 'MemAlloc 20 1)) ;;分配内存,用来存放数据的内存地址
  38.   (setq hWin (dcl-Control-GetHWND html/Form1)) ;;获取 openDcl 对话框的句柄
  39.   (vlax-invoke DWX 'GetWindowTextW hWin pStr 16) ;;读取对话框的标题行(内存地址传递)
  40.   (setq dataAddress (atoi (vlax-invoke DWX 'strget pStr))) ;;将内存地址给 lisp 变量
  41. )


  42. ;;OpenDCL 环境自动载入
  43. (vl-load-com)
  44. (setq ODCLREG (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)
  45.      "\\Applications\\OpenDCL"))
  46. (or dcl_getversionex  ;;判断 OPEDCL 环境是否加载
  47. (if (setq Phd (vl-registry-read ODCLREG "Loader")) ;;ODCL 是否安装
  48.     (progn
  49.         (arxload Phd)
  50.         (setq ODCLREG nil Phd nil)
  51.         ;;(princ "\n测试 ODCL 环境从 C 盘加载")
  52.     )
  53.     (progn  ;;如果 OPENDCL 没有安装则搜索 arx 文件是否存在
  54.       (defun Load_OdclRuntime (/ vers arxname darx *error*)
  55.         (defun *error* (msg)  ;;错误中断提示
  56.             (princ (strcat "\n程序加载失败,文件 " arxname " 缺失"))
  57.             (princ)
  58.         )
  59.         (setq vers (substr (getvar "acadver") 1 2))
  60.         (setq arxname (strcat "OpenDCL."
  61.             (if (= (getenv "PROCESSOR_ARCHITECTURE") "AMD64")
  62.                 "x64." "") vers ".arx"))  ;;区分 CAD 位
  63.         (if (setq darx (findfile arxname))
  64.             (if (null (member arxname (arx)))(arxload darx))
  65.             (exit) ;;支持路径未搜到 arx,调用错误中断
  66.         )
  67.       )
  68.         (Load_OdclRuntime) ;;运行加载函数
  69.         (setq Load_OdclRuntime nil) ;;释放加载函数
  70.     )
  71. )
  72. );;THE END of LOAD ODCL

  73. (princ)

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +1 金钱 +30 收起 理由
e2002 + 1 + 30 很好的样例!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2018-12-26 16:11 | 显示全部楼层
本帖最后由 yxp 于 2018-12-26 20:19 编辑

啥,还能编辑。
发表于 2018-12-26 20:15 | 显示全部楼层
蜜蜂大神666。

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

发表于 2018-12-26 20:16 | 显示全部楼层
蜜蜂大神元旦快乐~
发表于 2018-12-27 08:11 | 显示全部楼层
没看明白,这个效果用 lisp+ODcl 就可以实现呀!
发表于 2018-12-27 16:04 | 显示全部楼层
谢谢楼主分享
发表于 2018-12-27 16:11 来自手机 | 显示全部楼层
蜜蜂大神,来点实用的
发表于 2018-12-30 09:30 | 显示全部楼层
向高手学习!
发表于 2018-12-30 13:22 | 显示全部楼层
帮楼主顶一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 06:32 , Processed in 0.196272 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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