设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 越飞越高讲堂（2）CAD的API编程指南(上)--DynamicWrappe ...
12345678910... 17下一页
返回列表 发新帖
楼主: highflybir

[【高飞鸟】] 越飞越高讲堂（2）CAD的API编程指南(上)--DynamicWrapperX

    [复制链接]
highflybird
发表于 2011-4-24 23:07:42 | 显示全部楼层
本帖最后由 highflybird 于 2011-4-24 23:12 编辑

(vlax-get-or-create-object "DynamicWrapperX")这样也不行吗？

用这个试下看能创建(vlax-get-or-create-object "DynamicWrapper") 么？这个是早期的版本。

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

chlh_jd
发表于 2011-4-24 23:08:30 | 显示全部楼层
但是单独执行
(if  ... (progn1 ... ) (progn2 ...)) 中的progn1 语段就可以了

  3. _1$
  4. ; 出错后重置
  5. _$ (setq wrap (vlax-create-object "DynamicWrapperX"))
  6. #<VLA-OBJECT 001ca940>
  7. _$ (vlax-invoke wrap 'Register "user32.dll" "MessageBoxW" "i=hwwu" "r=l")
  8. 1810872
  9. _$
  10. _$ (vlax-invoke wrap 'MessageBoxW hCAD "Hello,DynWrap" "Test for API" 2)
  11. _1$
  12. ; 出错后重置
  13. _$
  14. _$
  15. _$ (vlax-invoke wrap 'Register "kernel32" "GetCommandLine" "r=s")
  16. 1817424
  17. _$ (vlax-invoke wrap 'GetCommandLine)
  18. ""D:\\Program Files\\AutoCAD 2004\\acad.exe" /nologo /p Tssd2006S"
  19. _$ (vlax-invoke wrap 'Register "kernel32" "Beep" "i=uu")
  20. 1881880
  21. _$ (vlax-invoke wrap 'Beep 800 1000)
  22. nil
  23. _$

回复 支持 反对

使用道具 举报

chlh_jd
发表于 2011-4-24 23:12:19 | 显示全部楼层
本帖最后由 chlh_jd 于 2011-4-24 23:14 编辑

谢谢斑竹的大力帮助！！！
去掉后面X，不能创建.
回复 支持 反对

使用道具 举报

chmenf087
发表于 2011-4-24 23:38:09 | 显示全部楼层
这个有点曲高和寡了，WindowAPI一不小心整个程序都会崩溃
回复 支持 反对

使用道具 举报

大智若禹
发表于 2011-4-25 21:15:16 | 显示全部楼层
葱白一下楼主。。。
回复 支持 反对

使用道具 举报

chlh_jd
发表于 2011-4-25 23:18:42 | 显示全部楼层
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取，VLISP怎么用"user32.dll"获取呢？
搜索了网页：大致获得下列信息
JavaScript(原文网址：http://www.fengfly.com/plus/view-67848-1.html)

  2. <html>
  3. <head>
  4. <title>JavaScript判断鼠标滚轮滚动方向- www.fengfly.com </title>
  5. <script type="text/javascript">
  6. function handle(delta) {
  7.     var s = delta + ": ";
  8.     if (delta <0)
  9.         s += "您在向下滚……";
  10.     else
  11.         s += "您在向上滚……";
  12.     document.getElementById('delta').innerHTML = s;
  13. }//from www.fengfly.com

  15. function wheel(event){
  16.     var delta = 0;
  17.     if (!event) event = window.event;
  18.     if (event.wheelDelta) {
  19.         delta = event.wheelDelta/120;
  20.         if (window.opera) delta = -delta;
  21.     } else if (event.detail) {
  22.         delta = -event.detail/3;
  23.     }
  24.     if (delta)
  25.         handle(delta);
  26. }

  28. /* www.fengfly.com */
  29. if (window.addEventListener)
  30. window.addEventListener('DOMMouseScroll', wheel, false);
  31. window.onmousewheel = document.onmousewheel = wheel;
  32. </script>
  33. </head>
  34. <body>
  35. <div id="delta">滚动中轮试试~请选按着中轮滚动，激活后可以不按，直接滚动。</div>
  36. </body>
  37. </html>
复制代码

MSDN帮助

  2. WM_MOUSEWHEEL
  3. fwKeys = LOWORD(wParam); // key flags
  4. zDelta = (short) HIWORD(wParam); // wheel rotation
  5. xPos = (short) LOWORD(lParam); // horizontal position of pointer
  6. yPos = (short) HIWORD(lParam); // vertical position of pointer
  7. ...
  8. //Zdelta为负向前滚动，为正向后滚动
复制代码

VB6.0写法

  3. Private Type MSLLHOOKSTRUCT     '鼠标HOOK时lParam指针指向的结构
  4.     pt As POINTAPI
  5.     dwMouseData As Long
  6.     dwFlags As Long
  7.     dwTime As Long
  8.     dwExtraInfo As Long
  9. End Type
  10. Private Const WM_MOUSEWHEEL As Long = &H20A

  12. Private Sub objHookLL_MouseHook(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long)
  13.     '鼠标HOOK事件.
  14.     '要吃了当前消息,把lRet = -1即可.
  15.     If Code = HC_ACTION And wParam = WM_MOUSEWHEEL Then
  16.         Dim stMLL As MSLLHOOKSTRUCT        
  17.         Call CopyMemory(ByVal VarPtr(stMLL), ByVal lParam, Len(stMLL))      
  18.         With stMLL
  19.             Debug.Print .dwMouseData / 65536        '输出滚轮状态
  20.             '在这里可以得到鼠标坐标以及其它信息
  21.         End With
  22.     End If
  23.     txtMCode.Text = Code
  24.     txtMwParam.Text = wParam
  25.     txtMlParam.Text = lParam
  26.     Debug.Print "   M = " & Code, wParam, lParam
  27. End Sub
回复 支持 反对

使用道具 举报

highflybird
发表于 2011-4-26 11:11:24 | 显示全部楼层
chlh_jd 发表于 2011-4-25 23:18
提个问题
鼠标滚轮的滚动方向可以用VB或其他语言获取，VLISP怎么用"user32.dll"获取呢？
搜索了网页：大致 ...

如果要在程序中获取滚轮方向，可以用getmessage获取。
如果要做钩子，恐怕不能用vlisp实现，哪怕用API方式去实现。因为lisp函数不能定制自己的回调函数。这个地方我研究了很久，也没成功。
回复 支持 反对

使用道具 举报

chlh_jd
发表于 2011-4-27 13:11:51 | 显示全部楼层
只需要取得滚轮方向就可以了，getmessage怎么写呢
回复 支持 反对

使用道具 举报

highflybird
发表于 2011-4-27 15:57:57 | 显示全部楼层
本帖最后由 highflybird 于 2011-4-27 16:22 编辑
chlh_jd 发表于 2011-4-27 13:11
只需要取得滚轮方向就可以了，getmessage怎么写呢


  1. (vl-load-com)
  2. ;;;*********************************************************************
  3. ;;;启动加载段-----------------------------------------------------------
  4. ;;;装入win32 API 函数---------------------------------------------------
  5. (defun LoadAPI (DWX / dbName)
  6.   ;; Library
  7.   (vlax-invoke DWX 'Register "KERNEL32" "GetLastError" "r=l")               
  8.   ;; Message
  9.   (vlax-invoke DWX 'Register "USER32" "GetMessage" "i=plll" "r=l")
  10.   (vlax-invoke DWX 'Register "USER32" "TranslateMessage" "i=l" "r=l")
  11.   (vlax-invoke DWX 'Register "USER32" "DispatchMessage" "i=l" "r=l")
  12.   (vlax-invoke DWX 'Register "USER32" "SendMessageW" "i=llll" "r=l")
  13.   ;; memory
  14.   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
  15.   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  16.   (vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")
  17.   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
  18.   (vlax-invoke DWX 'Register "MSVCRT" "_msize" "i=p" "r=l")
  19. )

  21. (defun c:test()
  22.   (setq dwx (vlax-create-object "DynamicWrapperX"))
  23.   (loadAPI DWX)
  24.   (vl-catch-all-apply 'MsgProc (list DWX))
  25.   (princ)
  26. )
  27. ;;;处理对话框的各种消息
  28. (defun MsgProc (DWX / ptr whwd pMsg aMsg bMsg ret isExit)
  29.   (setq isExit T)
  30.   (setq ptr (vlax-invoke DWX 'calloc 1 28))
  31.   (while (and
  32.     (/= (setq Ret (vlax-invoke DWX 'GetMessage ptr 0 0 0)) 0)    ;接收各种消息
  33.     isExit       ;是否退出
  34.   )
  35.     (if (= Ret -1)
  36.       (progn
  37. (vlax-invoke DWX 'free ptr)
  38. (exit)
  39.       )
  40.     )
  41.     (setq whwd (vlax-invoke DWX 'numget ptr  0))   ;消息所属的窗口
  42.     (setq pMsg (vlax-invoke DWX 'numget ptr  4))   ;消息的标识符
  43.     (setq aMsg (vlax-invoke DWX 'numget ptr  8))   ;消息的附加信息
  44.     (setq bMsg (vlax-invoke DWX 'numget ptr 12))   ;消息的附加信息
  45.     (vlax-invoke DWX 'TranslateMessage ptr)    ;转换消息
  46.     (vlax-invoke DWX 'DispatchMessage ptr)    ;派送消息
  47.     (if (and (= pMsg 257) (= aMsg 27))
  48.       (setq isExit nil)
  49.     )
  50.     (if (= pMsg  522)
  51.       (progn
  52. (princ "\n你按了鼠标滚轮.")
  53. (if (> aMsg 0)
  54.    (princ "向前滚动!")
  55.    (princ "向后滚动!")
  56. )
  57.       )
  58.     )
  59.   )
  60.   (vlax-invoke DWX 'free ptr)
  61. )


回复 支持 反对

使用道具 举报

chlh_jd
发表于 2011-4-28 14:32:17 | 显示全部楼层
太强了！~可以正确给出滚轮信息，我再学习下，看看能不能把ACAD的缩放反应屏蔽掉、把滚幅求出来！
非常感谢！~
回复 支持 反对

使用道具 举报

12345678910... 17下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-2-23 02:28 , Processed in 0.393730 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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