在LISP中调用C++,ARX函数以及汇编语言

Highflybird

在LISP中调用C++,ARX函数以及汇编语言
我不知道这个主题对大家是否有什么帮助，拿到这里，集思广益希望能与大家讨论。如果你有什么好的想法和建议，非常欢迎。
在运行代码前先要运行下面的 RegisterDynWrapX.VLX .

我们知道，LISP有很多限制，不能控制内存，不能得到指针，不能传址，参数的个数不可动态变化，对话框又太简陋了，等等。但是同时它又有很多优点：容易，上手快，简洁，兼容性好，互动性强，也很漂亮（我很喜欢这点）.
所以我在想，如果能引用C++,arx，或者汇编语言的一些东西，那将会很有趣，也能添加LISP的一些新特性。

后来我发现我找到了一个方法，能实现以前不敢想象的事情。
1.调用 C 语言函数

[pcode=lisp,true]
;;; ******************************
;;; Call some C functions in VLISP
;;; ******************************
(defun C:CFun (/ DWX i L LocalTime pTime sTime str t1 t2)
  ;; Create a DynamicWrapperX instance
  (setq DWX (vlax-create-object "DynamicWrapperX"))
  (if (null DWX)
    (progn
      (alert "Error: DynamicWrapperX is not registered!")
      (exit)
    )
  )

  ;; Register some C functions
  (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")
  (vlax-invoke DWX 'Register "MSVCRT" "srand" "i=l")
  (vlax-invoke DWX 'Register "MSVCRT" "time" "i=l" "r=l")
  (vlax-invoke DWX 'Register "MSVCRT" "rand" "r=l")
  (vlax-invoke DWX 'Register "MSVCRT" "clock" "r=l")
  (vlax-invoke DWX 'Register "MSVCRT" "ctime" "i=p" "r=s")
  ;;Get Local time
  (setq LocalTime (vlax-invoke DWX 'time 0))  ;Get the current time
  (setq pTime (vlax-invoke DWX 'calloc 1 4))  ;allocate memory
  (vlax-invoke DWX 'NumPut LocalTime pTime)
  (setq sTime (vlax-invoke DWX 'ctime pTime))
  (alert sTime)
  (vlax-invoke DWX 'free pTime)    ;free memory

  ;; Random numbers and clock
  (vlax-invoke DWX 'srand LocalTime)     ;Get the seed
  (setq t1 (vlax-invoke DWX 'clock))   ;Start Timer
  (setq i 0)
  (setq l nil)
  (repeat 10000
    (setq l (cons (vlax-invoke DWX 'rand) l))  ;Call Rand()
    (setq i (1+ i))
  )
  (setq t2 (vlax-invoke DWX 'clock))                    ;End Timer
  (setq str (rtos (/ (- t2 t1) 1000.)))  
  (alert (strcat "\nIt takes : " str " seconds.")) ;Display time cost
  (setq str "These random numbers are:\n")  ;print random numbers
  (foreach n (reverse l)
    (setq str (strcat str (itoa n) "\n"))
  )
  (princ str)

  ;; Release object
  (vlax-release-object DWX)
  (princ)
)
[/pcode]
2.调用 汇编语言
[pcode=lisp,true]
;;; ******************************
;;; Add Assembly code in VLISP   
;;; ******************************
(defun C:asm ( / i DWX lcode pCode pName ret str)
  ;; Create a DynamicWrapperX instance
  (setq DWX (vlax-create-object "DynamicWrapperX"))
  (if (null DWX)
    (progn
      (alert "Error: DynamicWrapperX is not registered!")
      (exit)
    )
  )
  ;; This code is from Lee Mac's
  (defun Hex2Dec ( str / foo ) ;; Lee Mac
    (defun foo ( l )   
      (if l (+ (* 16 (foo (cdr l)))
               (- (car l) (if (< (car l) 58) 48 55))) 0))
    (foo (reverse (vl-string->list (strcase str)))))
  ;; Register some API functions
  (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")
  (vlax-invoke DWX 'Register "USER32" "CallWindowProcA" "i=lllll" "r=l")
  ;; allocate memory and construct a Machine code list
  (setq pCode (vlax-invoke DWX 'calloc 36 1))  ;allocate memory for assembly code
  (setq pName (vlax-invoke DWX 'calloc 64 1))  ;allocate memory for CPU Name
  (setq lCode (list "55"      ;push   ebp
      "8B"      ;move   ebp,esp
      "EC"
      "57"      ;push   edi
      "52"      ;push   edx
      "51"      ;push   ecx
      "53"      ;push   ebx
      "8B"      ;move   eax,dword   ptr   [ebp+8]
      "45"
      "08"
      "0F"      ;cpuid
      "A2"
      "8B"      ;mov    edi,dword   ptr   [ebp+12]
      "7D"
      "0C"
      "89"    ;move   dword   ptr   [edi],ebx
      "1F"
      "8B"    ;mov    edi,dword   ptr   [ebp+16]
      "7D"
      "10"
      "89"    ;move   dword   ptr   [edi],ecx
      "0F"
      "8B"    ;mov    edi,dword   ptr   [ebp+20]
      "7D"
      "14"
      "89"    ;move   dword   ptr   [edi],edx
      "17"
      "58"    ;pop   ebx
      "59"    ;pop    ecx
      "5A"    ;pop    edx
      "55"    ;pop    edi
      "C9"    ;leave
      "C2"    ;ret    16
      "10"
      "00"
       )
  )
  ;; Put this code into a function pointer.
  (setq i 0)
  (foreach code lcode
    (vlax-invoke DWX 'NumPut (Hex2Dec code) pCode i "b")
    (setq i (1+ i))
  )
  ;; Pass message information to the specified window procedure
  (setq ret (vlax-invoke DWX 'CallWindowProcA pCode 0 pName (+ pName 8) (+ pName 5)))
  (setq str (strcat (vlax-invoke DWX 'StrGet pName "s")
      (vlax-invoke DWX 'StrGet (+ pName 5) "s")
            )
  )
  (alert (strcat "CPU type is :\n" str))  ;message a box
  (vlax-invoke DWX 'free pCode)    ;free memory
  (vlax-invoke DWX 'free pName)    ;free memory
  (vlax-release-object DWX)
  (princ)
)
[/pcode]
3.调用arx函数
[pcode=lisp,true]
;;; ******************************
;;; Call some ARX functions      
;;; ******************************
(defun C:CallArx (/ *APP DWX PATH PFUN pINS pLEN pPNT pSEL pSTR RET SCRIPT STR X Y Z)
  ;; Create a DynamicWrapperX instance
  (setq DWX (vlax-create-object "DynamicWrapperX"))
  (if (null DWX)
    (progn
      (alert "Error: DynamicWrapperX is not registered!")
      (exit)
    )
  )
  (setq *APP (vlax-get-acad-object))
  (setq path (vla-get-fullname *APP))
  ;; Register some functions about memory
  (vlax-invoke DWX 'Register "msvcrt" "malloc" "i=l" "r=p")
  (vlax-invoke DWX 'Register "msvcrt" "calloc" "i=ll" "r=p")
  (vlax-invoke DWX 'Register "msvcrt" "free" "i=l")
  ;; Register some ARX functions
  (vlax-invoke DWX 'Register path "acedSSGet" "i=ppppp" "r=l")
  (vlax-invoke DWX 'Register path "acedSSLength" "i=pp" "r=l")
  (vlax-invoke DWX 'Register path "acedSSFree" "i=p" "r=l")
  (vlax-invoke DWX 'Register path "acedGetPoint" "i=psp" "r=l")
  (vlax-invoke DWX 'Register path "acedDragGen" "i=pplpp" "r=l")

  ;; then call some ARX functions
  (setq pLen (vlax-invoke DWX 'calloc 1 4))  ; a pointer to length of the select set
  (setq pSel (vlax-invoke DWX 'calloc 2 4))  ; a pointer to select set
  (setq pPnt (vlax-invoke DWX 'calloc 3 8))  ; a pointer to coordinate
  (setq str  "\nPlease specify the point:")  
  (setq pStr (vlax-invoke DWX 'StrPtr str "s"))         ; a pointer to the prompt
  (setq ret  (vlax-invoke DWX 'acedSSGet 0 0 0 0 pSel)) ; should return 5100  = (ssget)
  (setq ret  (vlax-invoke DWX 'acedGetPoint 0 str pPnt)); should return 5100  = (getpoint)
  (setq X    (vlax-invoke DWX 'NumGet pPnt  0 "d"))
  (setq Y    (vlax-invoke DWX 'NumGet pPnt  8 "d"))
  (setq Z    (vlax-invoke DWX 'NumGet pPnt 16 "d"))
  (setq str  (VL-PRINC-TO-STRING (list X Y Z)))
  (alert (strcat "The coordinate is: " str))
  (vlax-invoke DWX 'acedSSLength pSel pLen)  ; get the length of selectset = (sslength)
  (setq str (itoa (vlax-invoke DWX 'NumGet pLen)))
  (alert (strcat "The count of selected: " str))
  ;; Callback function
  (defun CallbackFunc (ads_point ads_matrix)
    5000
  )
  (setq pFun  (vlax-invoke DWX 'RegisterCallback 'CallbackFunc "i=pp" "r=l"))
  (setq pIns  (vlax-invoke DWX 'calloc 3 8))
  ;;(setq ret   (vlax-invoke DWX 'acedDragGen pSel pStr 0 pFun pIns))  ;don't do this,or your CAD will be ruined
  (setq ret   (vlax-invoke DWX 'acedSSFree pSel)) ; free the select set , no equation
  ;; free memory and release object.
  (vlax-invoke DWX 'free pLen)
  (vlax-invoke DWX 'free pSel)
  (vlax-invoke DWX 'free pPnt)
  (vlax-invoke DWX 'free pStr)
  (vlax-invoke DWX 'free pIns)
  (vlax-release-object script)
  (vlax-release-object DWX)
  (princ)
)
[/pcode]


有两个问题，我没有完全解决：
    1.能否得到一个回调函数（非反应器回调）？怎么做？
    2.能否得到一个类？

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:RegisterDynWrapX (1).rar 
下载次数:75  文件大小:9.52 KB 
下载权限: 不限 以上  [免费赚D豆]

Free-Lancer

好东西，还是有几个实用的实例讲解才能发扬光大啊！来自: Android客户端

sicky111

先占个楼，再来慢慢学习。

wowan1314

多搞几个实用的例子！以便模仿！
一直在模仿！从未想超越！谢谢

st788796

这个 acedSSget 和 ARX 的一样吗?

2012淡然之马

好东西，感谢楼主分享

jiangnanemail

楼主实在是高呀！

wj2008wh

多谢版主分享。

xiagood

高手啊。佩服。。。。

莫希德

(setq DWX (vlax-create-object "DynamicWrapperX"))
这个反回是NIL