【越飞越高讲堂2】CAD的API编程指南(上)--DynamicWrapperX
本帖最后由 highflybir 于 2011-11-20 09:46 编辑越飞越高讲堂（2）
CAD中如何利用API 编程呢？
对于arx来说，这点根本就不是问题，直接用api函数，因为它已经成了C++的内部函数了。对于VBA来说，也不太成问题。利用VBIDE中插入模块，申明API函数，就可以用了。对于VLISP来说，就需要借助其他工具了，譬如调用编译好的dll, 或者调用其他的例如EXCEL的VBA,或者调用CAD的VBA，都需要用读写文件的方式或者暂时写入VBIDE的方式，这方面的研究nonsmall和aroom等都发表了帖子，研究得很详细了。下面我要用另外一种方式来实现它。
（上部）DynWrapX和VLISP中的API
首先申明：此文属于首创，如需转载请说明来源和作者！
不用OpenDCL,不用VB和VBA，不用ARX,下面的一些你能做到吗？
你想使得你的对话框(我这里特指DCL)添加菜单吗？你想在你的DCL中添加真彩色图片或者做成各种特效，譬如渐变的背景？你想运用各种API函数为你的程序锦上添花吗？甚至完成以前不敢想象的事情？你想函数对参数传址使用么？你想得到比grread还强大的效果吗？你想创建一个非模态的DCL吗？甚至你想在LISP中嵌入汇编语言吗？等等。
如果你有了DynamicWrapperX这个插件，你什么都可以做了。
DynamicWrapperX 是一个ActiveX部件，它允许调用DLL库里面的函数，特别是API 的函数。可用于 Jscript和VBscript。它由汇编语言写成。短小精悍，才 13Kb，压缩后才5kb，比OpenDCL.arx甚至自己做的.dll文件都小很多，你甚至可以将它打包到vlx文件中。虽然它很小，但是很给力。
它可以极大程度地扩展LISP的编程范围，赋予DCL和VLISP更多功能。它可以适应不同的CAD版本，兼容windows98~windows 7。
首先给出这个插件的英文帮助和下载地址：
http://www.script-coding.com/dynwrapx_eng.html
我这里另贴上：
DynWrapX.dll 文件这个是DynamicWrapperX 插件
Win32API.txt文件这个不是必需的，是api 函数的查看文件，api viewer用的WIN32API.TXT -- Win32 API Declarations for Visual Basic
如何在系统中注册：
在windows下有两种方法：
1.运行 regsvr32.exe插件路径\dynwrapx.dll， 注册给所有用户；
2.运行 regsvr32.exe/i插件路径\dynwrapx.dll， 注册给当前用户；
如果你把它拷贝到system32目录下，直接运行 regsvr32.exedynwrapx.dll就可了。
反注册用 regsvr32.exe /u插件路径\dynwrapx.dll和 regsvr32.exe /u /i 插件路径\dynwrapx.dll。
在windows 7 下，读者应该注意这点：需要以管理员身份注册运行。建议拷贝到其他目录注册运行。
http://support.microsoft.com/kb/827659
内部函数简介：
1. Register( DllName, FuncName [, i=ParamTypes] [, r=RetValType] )
注册一个DLL中的函数，dllName,dll文件名，funcName，dll里面的函数名，i参数类型，r返回值类型。
2. RegisterCallback( FuncRef [, i=ParamTypes] [, r=RetValType] )
注册一个回调函数，FuncRef按址引用的函数名，i参数类型，r返回值类型。
3. NumGet( Address [, Offset] [, Type] )
得到某个指针的内容，Address指针地址，Offset偏移值，Type数值类型。
4. NumPut( Var, Address [, Offset] [, Type] )
改变某个指针的内容，Var，要赋值的变量，Address指针地址，Offset偏移值，Type数值类型。
5. StrPtr( Var [, Type] )
得到一个字符串的指针（实际也是创见一个指针的方法）,var 字符串，type是类型
6. StrGet( Address [, Type] )
读取某个指针的值，Address地址，type类型。
7. Space( Count [, Char] )
创建指定长度和指定字符的字符串。Count,字符串长度，char指定的字符
创建、释放和注册函数：
创建：(setq wrap (vlax-create-object "DynamicWrapperX"))
释放：(vlax-release-objectwrap)
注册函数： (vlax-invokewrap'Register"user32.dll""MessageBoxW""i=hwwu" "r=l")
可以看出，这个甚至比VB中API函数的引用更简单。
;; 关于MessgeBox函数参见 http://baike.baidu.com/view/927800.htm
先创建几个下面用得着的对象
(setq *APP (vlax-get-acad-object))
(setq *DOC (vla-get-ActiveDocument *APP))
(setq hCAD (vla-get-hwnd *APP))
(setq hDOC (vla-get-hwnd *DOC))
(setq wrap (vlax-create-object "DynamicWrapperX"))
几个简单的例子：
;; 例如一个简单的消息框
(vlax-invoke wrap 'Register "user32.dll" "MessageBoxW" "i=hwwu" "r=l")
;; 'Register 注册;
;; "User32.dll"，可以省略为"USER32",也可以是自己的dll，例如"MyLib.dll";
;; "MessageBoxW" ,API函数名字，功能是弹出一个消息框;
;; "i=hwwu"，是参数列表,见函数原型：
;; int MessageBox(HWND hWnd,LPCTSTR lpText,LPCTSTR lpCaption,UINT UType);
;; h,父窗口句柄，w,宽字符，消息内容，w宽字符，标题文字，u,无符号整数,指的是消息框的类型
;; "r=l"代表返回数值是整数。
(vlax-invoke wrap 'MessageBoxW hCAD "Hello,DynWrap" "Test for API" 2)
;; 返回值代表如下：
;; IDOK 1 按下"OK"
;; IDCANCEL 2 按下"取消"
;; IDABORT 3 按下"放弃"
;; IDRETRY 4 按下"重试"
;; IDIGNORE 5 按下"忽略"
;; IDYES 6 按下"是"
;; IDNO 7 按下"否"
;; IDCLOSE 8 按下"关闭"
;; IDHELP 9 按下"帮助"
;; 获得当前进程的命令行
(vlax-invoke wrap 'Register "kernel32" "GetCommandLine" "r=s")
;; 这个函数没有参数，故而没有"i="
(vlax-invoke wrap 'GetCommandLine)
;; 譬如返回:"C:\\Program Files\\AutoCAD 2006\\acad.exe\" 这样，我们就知道程序的所在目录和名称。
;; 发出蜂鸣声
(vlax-invoke wrap 'Register "kernel32" "Beep" "i=uu") ;蜂鸣声有返回值但可以不需要.
(vlax-invoke wrap 'Beep 800 1000) ;通过喇叭发出声音.
参数符号代表的类型：
l -32位整数 - LONG, INT, LPARAM, LRESULT, etc, 范围: -2147483648 ... 2147483647;
u - 无符号32位整数 - ULONG, UINT, DWORD, WPARAM, ... , 范围: 0 ... 4294967295;
注意，在lisp中，无符号的整数如果超出2147483647 会溢出，例如(+ 2147483647 1)
返回-2147483648
h - 句柄 - HANDLE, HWND, HMODULE, HINSTANCE, HICON, ... , 范围: -2147483648 ... 4294967295;
p - 指针; 就是一个数值，对象或者字符串的地址。
n - 16位整数- 短整数, 范围: -32768 ... 32767;
t - 无符号16位整数- USHORT, WORD, WCHAR, OLECHAR, ... , 范围: 0 ... 65535;
c - 8位整数- CHAR, 范围: -128 ... 127;
b - 无符号8位整数- UCHAR, BYTE, ... , 范围: 0 ... 255;
f – 浮点数 - FLOAT;
d – 双精度数 - DOUBLE;
w - Unicode 字符串 - BSTR, LPWSTR, LPOLESTR, OLECHAR *, WCHAR *, ...;
s - ANSI/Windows 字符 (默认代码页) - LPSTR, LPCSTR, CHAR *, ...;
z - OEM/DOS字符(默认代码页) - LPSTR, LPCSTR, CHAR *, ...
返回值也是如此。但是我们在lisp中用到最多的是l数值型，可以代表指针，也可以代表长整数，短整数，甚至布尔值等等。
关于字符串的宽字符和ASCII字符，请读者自行参考相关资料。
RegisterCallBack方法：
鉴于LISP对于函数的地址取得的方式和对参数的保护模式，所以这个函数对LISP意义不大，略去。
其他方法：
NumGet( Address [, Offset] [, Type] )
从一个地址中获取数值。Address,基址，Offset偏移量，能用于循环读写一系列的数值。Type,数值类型，默认”l”,即长整数，只能小写字母。返回值就是这个地址中的内容。
NumPut( Var, Address [, Offset] [, Type] )
写入数值到内存中。Var，要写入的变量，剩下的几个参数跟NumGet相同。返回值是写入的字节数。
上面两个函数，允许你在基址占用的内存中存取数据(结构，数组等)。
StrPtr( Var [, Type] )
创建一个字符串指针，然后你可以在这个字符串占用的内存中存取数据(结构，数组等)。Var,是字符串变量或者常量，type是字符串类型，可以是”w”(默认方式),”s”,”z”。返回一个指针（即一个长整数）。
StrGet( Address [, Type] )
从指定地址中，读取字符串，并返回其拷贝。Address可以是数值变量的地址，也可以是字符串的首址，type 同StrPtr。
Space( Count [, Char] )
创建指定长度指定字符的字符串。Count，数量，Char，指定字符，如果没这个参数，指定字符就是空格。
下面是其用法例子：
;; 取得某个地址的内容，例如读取字符串的ASCII代码
;; 其实就是(vl-string->list "Hello, world! It's me.")
;l 举这个例子仅仅是说明其用法。
(setq str "Hello, world! It's me.")
(setq sLen (strlen str))
(setq codes "")
(setq i 0)
(repeat sLen
(setq code (vlax-invoke wrap 'NumGet Str (* i 2) "t")) ;乘以2是因为偏移必须是两个字节"t"
(setq codes (strcat codes (itoa code) " "))
(setq i (1+ i))
)
(alert codes)
;; 读取并写入内存，例如反转字符串.
;; 这个例子就是反转字符串。
;; 对中文字符串要复杂些
(setq buf (vlax-invoke wrap 'Space sLen))
(setq pBuf (vlax-invoke wrap 'StrPtr Buf "s")) ;获得缓冲区地址，用来读写
(setq i 0)
(setq j (1- sLen)) ;最后一个下标要字符串长度减1
(repeat sLen
(setq code (vlax-invoke wrap 'NumGet Str (* i 2) "t")) ;从左到右读
(vlax-invoke wrap 'NumPut code pBuf (* j 2) "t") ;从右到左写入缓冲区
(setq j (1- j)) ;偏移地址增加
(setq i (1+ i)) ;偏移地址减少
)
(alert (vlax-invoke wrap 'StrGet pBuf)) ;最后读取缓冲区内容
运用上面方法也可以用来通过改变地址内容改变变量值，即对函数参数的传址使用。
更精彩的在后面：
具体运用和实例剖析：
请见下面的完整的例子:其中已经有注释，包含了详细的解释。
在此特别感谢nonsmall，在编写这个程序过程中得到了他的很多帮助及其建议。
另外一些关于用LISP调用API的链接：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72145&highlight=API
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=74063&highlight=API
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60155&highlight=API
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60884&highlight=API
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=84651&highlight=API
提醒：因为用到了API，可能会对内存有读写，所以编程前应保存工程。注意对内存的释放和存取可操作性。
多谢Caiqs的建议，"如果你有了DynamicWrapperX这个插件，你什么都可以做了。"这句话我夸大其词了，具体有哪些不能做的，请参考70楼。
本帖最后由 highflybird 于 2011-9-2 21:46 编辑
caiqs 发表于 2011-9-2 07:39 http://bbs.mjtd.com/static/image/common/back.gif
你甚至可以将它打包到vlx文件中，，乎悠，接着乎悠
不用OpenDCL,不用VB和VBA，不用ARX，
呵呵，忽悠，你言重了。所有关于这个插件的说明，我已经在帖子中说明了。
我并非要比较OpenDCL ,VB,VBA,和这个DynamicWrapperX 它们之间究竟谁强谁弱。
他们各有优劣，取长补短，才是编程的正确做法。
说实在话，这个控件是汇编加VC++,所以才显得功能强大而精悍。楼上可以看看它的源代码。但VBA,OpenDCL ,哪一个又不是由VC++编译形成的软件呢？
LISP如果不用ActiveX组件，不知道要少了多少功能。我极力赞成LISP中融汇其他语言，这样能极大程度地扩展LISP语言的功能。
有一点可能我说的夸张了：我说它什么都能做了。其实也不对。
它不能引用Arx或者C++的其他的类，不能设置ARX那样的回调函数，只能通过脚本来设置，而且有一定限制和不健壮。
它可以操作内存，但是不是所有的函数安全的。存在一定的风险。
它不能实现真正的多线程。
它的灵活性也欠缺，另外，效率不可能像C++或者VB 那样。因为它是通过ActiveX来引用的。
它不支持64位系统。
它必须要以管理员身份注册。等等这些都是它的缺点。
欢迎 Caiqs多提建议!
本帖最后由 highflybird 于 2011-9-3 00:10 编辑
xshrimp 发表于 2011-9-2 23:59 http://bbs.mjtd.com/static/image/common/back.gif
其实把文件转换为二进制文本,用lsp打包 。问题早就讨论过了啊
我记得我最早是在nonsmall 托盘气泡提示程 ...
嗯，这个方法我也跟nonsmall讨论过，有一定局限性，特别对于cad2010-2012来说，支持得不是很好有兴趣的不妨实验一下：
如果各位非得要深究我的那个vlx 究竟怎么打包的，请看我下面的附件：
这种方法速度更快，文件可以更大，支持得更广。
highflybird 发表于 2011-9-3 00:03
嗯，这个方法我也跟nonsmall讨论过，有一定局限性，特别对于cad2010-2012来说，支持得不是很好有兴趣的 ...
win7 64 下 无法创建"ScriptControl"
(setq wsObj (vlax-create-object "ScriptControl"))
这一句返回的是nil 高手又来了！支持! 本帖最后由 highflybir 于 2011-3-13 00:32 编辑
颜色拾取对话框
例如,创建一个颜色拾取对话框，并得到返回值.
(setq str (vlax-invoke wrap 'space 36))
(setq pBuf (vlax-invoke wrap 'StrPtr str))
(vlax-invoke wrap 'Register "comdlg32.dll" "ChooseColorA" "i=p" "r=l")
;注册函数
(setq str (vlax-invoke wrap 'space 64))
(setq pColor (vlax-invoke wrap 'StrPtr str)) ;创建一个初始化颜色簇指针
(setq i 0)
(repeat 16
(vlax-invoke wrap 'NumPut 16777215 pColor i)
(setq i (+ i 4))
)
(vlax-invoke wrap 'NumPut 36 pBuf) ;lStructSize
(vlax-invoke wrap 'NumPut hCADpBuf 4) ;hwndOwner
(vlax-invoke wrap 'NumPut 0pBuf 8) ;hInstance
(vlax-invoke wrap 'NumPut 0pBuf 12) ;rgbResult 默认黑色
(vlax-invoke wrap 'NumPut pColorpBuf 16) ;*lpCustColors 全部初始化为白色
(vlax-invoke wrap 'NumPut 387 pBuf 20) ;Flags;
(vlax-invoke wrap 'ChooseColorA pBuf) ;打开颜色拾取对话框
(setq colorNum (vlax-invoke wrap 'NumGet pBuf 12));得到颜色号
(setq colorRGB (number->rgb colorIndex)) ;转换成RGB
;;;RGB函数跟CAD的rgb是相反的
(defun RGB (R G B)
(+ (lsh B 16) (lsh G 8) R)
)
(defun Number->RGB (C)
(list (lsh (lsh C 24) -24)
(lsh (lsh C 16) -24)
(lsh C -16)
)
)
播放音乐
;;播放mp3音乐
;;这个是引用winmm.dll的例子，用来播放mp3音乐相当简单
(vlax-invoke wrap 'Register "winmm.dll" "mciSendString" "i=ssll" "r=l")
(vlax-invoke wrap 'mciSendString "close temp_alias" "" 0 0)
(vlax-invoke wrap 'mciSendString "open C:\\TEMP\\Test.mp3 alias temp_alias" "" 0 0)
(vlax-invoke wrap 'mciSendString "play temp_alias" "" 0 0)
获取系统信息
;;获取系统信息，比脚本更简单
(setq str (vlax-invoke wrap 'space 36))
(setq pBuf (vlax-invoke wrap 'StrPtr str))
(vlax-invoke wrap 'Register "kernel32" "GetSystemInfo" "i=l")
(vlax-invoke wrap 'GetSystemInfo pBuf)
(vlax-invoke wrap 'NumGet pBuf 20) ;获取CPU个数
(vlax-invoke wrap 'NumGet pBuf 24) ;获取CPU型号
网页有关 ;;下载网页或者图片
;;有了这个函数，使得下载变得很简单
(vlax-invoke wrap 'Register "urlmon" "URLDownloadToFile" "i=lssll" "r=l")
(setq nUrl http://bbs.mjtd.com)
(setq fName "c:\\2.html") ;下载网页
(vlax-invoke wrap 'URLDownloadToFile 0 nUrl fName 0 0)
(setq nUrl http://www.baidu.com/img/baidu_logo.gif)
(setq fName "c:\\1.gif") ;下载图片
(vlax-invoke wrap 'URLDownloadToFile 0 nUrl fName 0 0)
取得对话框或者窗口尺寸
(vl-load-com)
(defun c:ttt (/ WRAP)
(setq wrap (vlax-create-object "DynamicWrapperX")) ;Create a DynamicWrapperX object instance
;;Register API functions
(vlax-invoke wrap 'Register "USER32" "FindWindowW" "i=ww" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindow" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindowRect" "i=lp" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetClientRect" "i=lp" "r=l")
;;Load the DCL
(vl-catch-all-apply 'DCL_Load (list wrap))
(vlax-release-object wrap)
(princ)
)
;;;Main procedure
(defun DCL_Load (wrap / DCL_FILE DCL_ID DIALOG_RETURN HWND BWND)
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl)))) ;Load dialogue
(vl-file-delete Dcl_File) ;then delete the temporary .dcl
(setq Dialog_Return 2)
(while (> Dialog_Return 1) ;if it is not ended
(new_dialog "DCL" dcl_id) ;then create a new dialogue by DCL_ID
(setq hwnd
(vlax-invoke wrap
'FindWindowW "adesk_dlg0000" "DynWrapX 对话框"));the handle of dialogue
(setq bwnd (vlax-invoke wrap 'GetWindow hwnd 5)) ;the handle of button
(action_tile "A" "(GetWindowSize 'GetWindowRect bwnd wrap))") ;action of "GetButtonSize" button
(action_tile "B" "(GetWindowSize 'GetWindowRect hwnd wrap))") ;action of "GetWindowSize" button
(action_tile "C" "(GetWindowSize 'GetClientRect hwnd wrap))") ;action of "GetClientSize" button
(setq Dialog_Return (start_dialog)) ;show dialog
(princ)
)
(unload_dialog dcl_id) ;unload dialog
(princ) ;silent quit
)
;;;get the size of window
(defun GetWindowSize (symbol hwnd wrap / str ptr Ret left top right bottom)
(setq str (vlax-invoke wrap 'Space 16))
(setq ptr (vlax-invoke wrap 'StrPtr str))
(setq ret (vlax-invoke wrap symbol hwnd ptr))
(setq left (vlax-invoke wrap 'NumGet ptr))
(setq top (vlax-invoke wrap 'NumGet Ptr 4))
(setq Right(vlax-invoke wrap 'NumGet Ptr 8))
(setq bottom (vlax-invoke wrap 'NumGet Ptr 12))
(alert (vl-princ-to-string (list (- right left) (- bottom top))))
)
;;;make a .DCL file,and get its name
(defun Write_Dcl (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "W"))
(foreach str '("DCL:dialog"
"{"
" label = \"DynWrapX 对话框\";"
" spacer_1;"
" :button"
" {"
" key = \"A\" ;"
" label = \"取得此按钮尺寸\" ;"
" }"
" :button"
" {"
" key = \"B\" ;"
" label = \"取得对话框尺寸\" ;"
" }"
" :button"
" {"
" key = \"C\" ;"
" label = \"取得客户区尺寸\" ;"
" }"
" width = 30;"
" height = 10;"
" spacer_1;"
" ok_cancel_help;"
" spacer_1;"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
要储备一些VB知识 大哥，偶太佩服你了...如黄河之水啊...
真的是人品水平双百分，
向你高超的水平更向你博大的胸怀致敬！ 每次都是石破天惊之作 Highflybird兄，真佩服你~ 楼主真让我们长知识了！THKS！ 果然是highflybir出马，一个顶两 如果稳定的话，那真是VisualDCL了