【飞鸟集】LISP.net?在LISP中调用C++,ARX函数以及汇编语言

highflybird

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

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

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

2. 
   
3. ;;; ******************************
   
4. ;;; Call some C functions in VLISP
   
5. ;;; ******************************
   
6. (defun C:CFun (/ DWX i L LocalTime pTime sTime str t1 t2)
   
7.   ;; Create a DynamicWrapperX instance
   
8.   (setq DWX (vlax-create-object "DynamicWrapperX"))
   
9.   (if (null DWX)
   
10.     (progn
    
11.       (alert "Error: DynamicWrapperX is not registered!")
    
12.       (exit)
    
13.     )
    
14.   )
    
15.   
    
16.   ;; Register some C functions
    
17.   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
    
18.   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
    
19.   (vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")
    
20.   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")
    
21.   (vlax-invoke DWX 'Register "MSVCRT" "srand" "i=l")
    
22.   (vlax-invoke DWX 'Register "MSVCRT" "time" "i=l" "r=l")
    
23.   (vlax-invoke DWX 'Register "MSVCRT" "rand" "r=l")
    
24.   (vlax-invoke DWX 'Register "MSVCRT" "clock" "r=l")
    
25.   (vlax-invoke DWX 'Register "MSVCRT" "ctime" "i=p" "r=s")
    
26.   ;;Get Local time
    
27.   (setq LocalTime (vlax-invoke DWX 'time 0))  ;Get the current time
    
28.   (setq pTime (vlax-invoke DWX 'calloc 1 4))  ;allocate memory
    
29.   (vlax-invoke DWX 'NumPut LocalTime pTime)
    
30.   (setq sTime (vlax-invoke DWX 'ctime pTime))
    
31.   (alert sTime)
    
32.   (vlax-invoke DWX 'free pTime)    ;free memory
    
33.   
    
34.   ;; Random numbers and clock
    
35.   (vlax-invoke DWX 'srand LocalTime)     ;Get the seed
    
36.   (setq t1 (vlax-invoke DWX 'clock))   ;Start Timer
    
37.   (setq i 0)
    
38.   (setq l nil)
    
39.   (repeat 10000
    
40.     (setq l (cons (vlax-invoke DWX 'rand) l))  ;Call Rand()
    
41.     (setq i (1+ i))
    
42.   )
    
43.   (setq t2 (vlax-invoke DWX 'clock))                    ;End Timer
    
44.   (setq str (rtos (/ (- t2 t1) 1000.)))  
    
45.   (alert (strcat "\nIt takes : " str " seconds.")) ;Display time cost
    
46.   (setq str "These random numbers are:\n")  ;print random numbers
    
47.   (foreach n (reverse l)
    
48.     (setq str (strcat str (itoa n) "\n"))
    
49.   )
    
50.   (princ str)
    
51.   
    
52.   ;; Release object
    
53.   (vlax-release-object DWX)
    
54.   (princ)
    
55. )
    

<br /> ;;; ******************************<br /> ;;; Call some C functions in VLISP<br /> ;;; ******************************<br /> (defun C:CFun (/ DWX i L LocalTime pTime sTime str t1 t2)<br />   ;; Create a DynamicWrapperX instance<br />   (setq DWX (vlax-create-object "DynamicWrapperX"))<br />   (if (null DWX)<br />     (progn<br />       (alert "Error: DynamicWrapperX is not registered!")<br />       (exit)<br />     )<br />   )<br />   <br />   ;; Register some C functions<br />   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")<br />   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")<br />   (vlax-invoke DWX 'Register "MSVCRT" "realloc" "i=pl" "r=p")<br />   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")<br />   (vlax-invoke DWX 'Register "MSVCRT" "srand" "i=l")<br />   (vlax-invoke DWX 'Register "MSVCRT" "time" "i=l" "r=l")<br />   (vlax-invoke DWX 'Register "MSVCRT" "rand" "r=l")<br />   (vlax-invoke DWX 'Register "MSVCRT" "clock" "r=l")<br />   (vlax-invoke DWX 'Register "MSVCRT" "ctime" "i=p" "r=s")<br />   ;;Get Local time<br />   (setq LocalTime (vlax-invoke DWX 'time 0))  ;Get the current time<br />   (setq pTime (vlax-invoke DWX 'calloc 1 4))  ;allocate memory<br />   (vlax-invoke DWX 'NumPut LocalTime pTime)<br />   (setq sTime (vlax-invoke DWX 'ctime pTime))<br />   (alert sTime)<br />   (vlax-invoke DWX 'free pTime)    ;free memory<br />   <br />   ;; Random numbers and clock<br />   (vlax-invoke DWX 'srand LocalTime)     ;Get the seed<br />   (setq t1 (vlax-invoke DWX 'clock))   ;Start Timer<br />   (setq i 0)<br />   (setq l nil)<br />   (repeat 10000<br />     (setq l (cons (vlax-invoke DWX 'rand) l))  ;Call Rand()<br />     (setq i (1+ i))<br />   )<br />   (setq t2 (vlax-invoke DWX 'clock))                    ;End Timer<br />   (setq str (rtos (/ (- t2 t1) 1000.)))  <br />   (alert (strcat "\nIt takes : " str " seconds.")) ;Display time cost<br />   (setq str "These random numbers are:\n")  ;print random numbers<br />   (foreach n (reverse l)<br />     (setq str (strcat str (itoa n) "\n"))<br />   )<br />   (princ str)<br />   <br />   ;; Release object<br />   (vlax-release-object DWX)<br />   (princ)<br /> )<br />

2.调用 汇编语言

2. 
   
3. ;;; ******************************
   
4. ;;; Add Assembly code in VLISP   
   
5. ;;; ******************************
   
6. (defun C:asm ( / i DWX lcode pCode pName ret str)
   
7.   ;; Create a DynamicWrapperX instance
   
8.   (setq DWX (vlax-create-object "DynamicWrapperX"))
   
9.   (if (null DWX)
   
10.     (progn
    
11.       (alert "Error: DynamicWrapperX is not registered!")
    
12.       (exit)
    
13.     )
    
14.   )
    
15.   ;; This code is from Lee Mac's
    
16.   (defun Hex2Dec ( str / foo ) ;; Lee Mac
    
17.     (defun foo ( l )   
    
18.       (if l (+ (* 16 (foo (cdr l)))
    
19.                (- (car l) (if (< (car l) 58) 48 55))) 0))
    
20.     (foo (reverse (vl-string->list (strcase str)))))
    
21.   ;; Register some API functions
    
22.   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
    
23.   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
    
24.   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")
    
25.   (vlax-invoke DWX 'Register "USER32" "CallWindowProcA" "i=lllll" "r=l")
    
26.   ;; allocate memory and construct a Machine code list
    
27.   (setq pCode (vlax-invoke DWX 'calloc 36 1))  ;allocate memory for assembly code
    
28.   (setq pName (vlax-invoke DWX 'calloc 64 1))  ;allocate memory for CPU Name
    
29.   (setq lCode (list "55"      ;push   ebp
    
30.       "8B"      ;move   ebp,esp
    
31.       "EC"
    
32.       "57"      ;push   edi
    
33.       "52"      ;push   edx
    
34.       "51"      ;push   ecx
    
35.       "53"      ;push   ebx
    
36.       "8B"      ;move   eax,dword   ptr   [ebp+8]
    
37.       "45"
    
38.       "08"
    
39.       "0F"      ;cpuid
    
40.       "A2"
    
41.       "8B"      ;mov    edi,dword   ptr   [ebp+12]
    
42.       "7D"
    
43.       "0C"
    
44.       "89"    ;move   dword   ptr   [edi],ebx
    
45.       "1F"
    
46.       "8B"    ;mov    edi,dword   ptr   [ebp+16]
    
47.       "7D"
    
48.       "10"
    
49.       "89"    ;move   dword   ptr   [edi],ecx
    
50.       "0F"
    
51.       "8B"    ;mov    edi,dword   ptr   [ebp+20]
    
52.       "7D"
    
53.       "14"
    
54.       "89"    ;move   dword   ptr   [edi],edx
    
55.       "17"
    
56.       "58"    ;pop   ebx
    
57.       "59"    ;pop    ecx
    
58.       "5A"    ;pop    edx
    
59.       "55"    ;pop    edi
    
60.       "C9"    ;leave
    
61.       "C2"    ;ret    16
    
62.       "10"
    
63.       "00"
    
64.        )
    
65.   )
    
66.   ;; Put this code into a function pointer.
    
67.   (setq i 0)
    
68.   (foreach code lcode
    
69.     (vlax-invoke DWX 'NumPut (Hex2Dec code) pCode i "b")
    
70.     (setq i (1+ i))
    
71.   )
    
72.   ;; Pass message information to the specified window procedure
    
73.   (setq ret (vlax-invoke DWX 'CallWindowProcA pCode 0 pName (+ pName 8) (+ pName 5)))
    
74.   (setq str (strcat (vlax-invoke DWX 'StrGet pName "s")
    
75.       (vlax-invoke DWX 'StrGet (+ pName 5) "s")
    
76.             )
    
77.   )
    
78.   (alert (strcat "CPU type is :\n" str))  ;message a box
    
79.   (vlax-invoke DWX 'free pCode)    ;free memory
    
80.   (vlax-invoke DWX 'free pName)    ;free memory
    
81.   (vlax-release-object DWX)
    
82.   (princ)
    
83. )
    

<br /> ;;; ******************************<br /> ;;; Add Assembly code in VLISP    <br /> ;;; ******************************<br /> (defun C:asm ( / i DWX lcode pCode pName ret str)<br />   ;; Create a DynamicWrapperX instance<br />   (setq DWX (vlax-create-object "DynamicWrapperX"))<br />   (if (null DWX)<br />     (progn<br />       (alert "Error: DynamicWrapperX is not registered!")<br />       (exit)<br />     )<br />   )<br />   ;; This code is from Lee Mac's<br />   (defun Hex2Dec ( str / foo ) ;; Lee Mac<br />     (defun foo ( l )   <br />       (if l (+ (* 16 (foo (cdr l)))<br />                (- (car l) (if (< (car l) 58) 48 55))) 0))<br />     (foo (reverse (vl-string->list (strcase str)))))<br />   ;; Register some API functions<br />   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")<br />   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")<br />   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=l")<br />   (vlax-invoke DWX 'Register "USER32" "CallWindowProcA" "i=lllll" "r=l")<br />   ;; allocate memory and construct a Machine code list<br />   (setq pCode (vlax-invoke DWX 'calloc 36 1))  ;allocate memory for assembly code<br />   (setq pName (vlax-invoke DWX 'calloc 64 1))  ;allocate memory for CPU Name<br />   (setq lCode (list "55"      ;push   ebp <br />       "8B"      ;move   ebp,esp<br />       "EC"<br />       "57"      ;push   edi <br />       "52"      ;push   edx <br />       "51"      ;push   ecx <br />       "53"      ;push   ebx <br />       "8B"      ;move   eax,dword   ptr   [ebp+8] <br />       "45"<br />       "08"<br />       "0F"      ;cpuid<br />       "A2"<br />       "8B"      ;mov    edi,dword   ptr   [ebp+12]<br />       "7D"<br />       "0C"<br />       "89"    ;move   dword   ptr   [edi],ebx <br />       "1F"<br />       "8B"    ;mov    edi,dword   ptr   [ebp+16]<br />       "7D"<br />       "10"<br />       "89"    ;move   dword   ptr   [edi],ecx <br />       "0F"<br />       "8B"    ;mov    edi,dword   ptr   [ebp+20] <br />       "7D" <br />       "14"<br />       "89"    ;move   dword   ptr   [edi],edx <br />       "17"<br />       "58"    ;pop   ebx <br />       "59"    ;pop    ecx <br />       "5A"    ;pop    edx <br />       "55"    ;pop    edi <br />       "C9"    ;leave<br />       "C2"    ;ret    16<br />       "10"<br />       "00"<br />        )<br />   )<br />   ;; Put this code into a function pointer.<br />   (setq i 0)<br />   (foreach code lcode<br />     (vlax-invoke DWX 'NumPut (Hex2Dec code) pCode i "b")<br />     (setq i (1+ i))<br />   )<br />   ;; Pass message information to the specified window procedure<br />   (setq ret (vlax-invoke DWX 'CallWindowProcA pCode 0 pName (+ pName 8) (+ pName 5)))<br />   (setq str (strcat (vlax-invoke DWX 'StrGet pName "s")<br />       (vlax-invoke DWX 'StrGet (+ pName 5) "s")<br />             )<br />   ) <br />   (alert (strcat "CPU type is :\n" str))  ;message a box<br />   (vlax-invoke DWX 'free pCode)    ;free memory<br />   (vlax-invoke DWX 'free pName)    ;free memory<br />   (vlax-release-object DWX)<br />   (princ)<br /> )<br />

3.调用arx函数

2. 
   
3. ;;; ******************************
   
4. ;;; Call some ARX functions      
   
5. ;;; ******************************
   
6. (defun C:CallArx (/ *APP DWX PATH PFUN pINS pLEN pPNT pSEL pSTR RET SCRIPT STR X Y Z)
   
7.   ;; Create a DynamicWrapperX instance
   
8.   (setq DWX (vlax-create-object "DynamicWrapperX"))
   
9.   (if (null DWX)
   
10.     (progn
    
11.       (alert "Error: DynamicWrapperX is not registered!")
    
12.       (exit)
    
13.     )
    
14.   )
    
15.   (setq *APP (vlax-get-acad-object))
    
16.   (setq path (vla-get-fullname *APP))
    
17.   ;; Register some functions about memory
    
18.   (vlax-invoke DWX 'Register "msvcrt" "malloc" "i=l" "r=p")
    
19.   (vlax-invoke DWX 'Register "msvcrt" "calloc" "i=ll" "r=p")
    
20.   (vlax-invoke DWX 'Register "msvcrt" "free" "i=l")
    
21.   ;; Register some ARX functions
    
22.   (vlax-invoke DWX 'Register path "acedSSGet" "i=ppppp" "r=l")
    
23.   (vlax-invoke DWX 'Register path "acedSSLength" "i=pp" "r=l")
    
24.   (vlax-invoke DWX 'Register path "acedSSFree" "i=p" "r=l")
    
25.   (vlax-invoke DWX 'Register path "acedGetPoint" "i=psp" "r=l")
    
26.   (vlax-invoke DWX 'Register path "acedDragGen" "i=pplpp" "r=l")
    
27.   
    
28.   ;; then call some ARX functions
    
29.   (setq pLen (vlax-invoke DWX 'calloc 1 4))  ; a pointer to length of the select set
    
30.   (setq pSel (vlax-invoke DWX 'calloc 2 4))  ; a pointer to select set
    
31.   (setq pPnt (vlax-invoke DWX 'calloc 3 8))  ; a pointer to coordinate
    
32.   (setq str  "\nPlease specify the point:")  
    
33.   (setq pStr (vlax-invoke DWX 'StrPtr str "s"))         ; a pointer to the prompt
    
34.   (setq ret  (vlax-invoke DWX 'acedSSGet 0 0 0 0 pSel)) ; should return 5100  = (ssget)
    
35.   (setq ret  (vlax-invoke DWX 'acedGetPoint 0 str pPnt)); should return 5100  = (getpoint)
    
36.   (setq X    (vlax-invoke DWX 'NumGet pPnt  0 "d"))
    
37.   (setq Y    (vlax-invoke DWX 'NumGet pPnt  8 "d"))
    
38.   (setq Z    (vlax-invoke DWX 'NumGet pPnt 16 "d"))
    
39.   (setq str  (VL-PRINC-TO-STRING (list X Y Z)))
    
40.   (alert (strcat "The coordinate is: " str))
    
41.   (vlax-invoke DWX 'acedSSLength pSel pLen)  ; get the length of selectset = (sslength)
    
42.   (setq str (itoa (vlax-invoke DWX 'NumGet pLen)))
    
43.   (alert (strcat "The count of selected: " str))
    
44.   ;; Callback function
    
45.   (defun CallbackFunc (ads_point ads_matrix)
    
46.     5000
    
47.   )
    
48.   (setq pFun  (vlax-invoke DWX 'RegisterCallback 'CallbackFunc "i=pp" "r=l"))
    
49.   (setq pIns  (vlax-invoke DWX 'calloc 3 8))
    
50.   ;;(setq ret   (vlax-invoke DWX 'acedDragGen pSel pStr 0 pFun pIns))  ;don't do this,or your CAD will be ruined
    
51.   (setq ret   (vlax-invoke DWX 'acedSSFree pSel)) ; free the select set , no equation
    
52.   ;; free memory and release object.
    
53.   (vlax-invoke DWX 'free pLen)
    
54.   (vlax-invoke DWX 'free pSel)
    
55.   (vlax-invoke DWX 'free pPnt)
    
56.   (vlax-invoke DWX 'free pStr)
    
57.   (vlax-invoke DWX 'free pIns)
    
58.   (vlax-release-object script)
    
59.   (vlax-release-object DWX)
    
60.   (princ)
    
61. )
    

<br /> ;;; ******************************<br /> ;;; Call some ARX functions       <br /> ;;; ******************************<br /> (defun C:CallArx (/ *APP DWX PATH PFUN pINS pLEN pPNT pSEL pSTR RET SCRIPT STR X Y Z)<br />   ;; Create a DynamicWrapperX instance<br />   (setq DWX (vlax-create-object "DynamicWrapperX"))<br />   (if (null DWX)<br />     (progn<br />       (alert "Error: DynamicWrapperX is not registered!")<br />       (exit)<br />     )<br />   )<br />   (setq *APP (vlax-get-acad-object))<br />   (setq path (vla-get-fullname *APP))<br />   ;; Register some functions about memory<br />   (vlax-invoke DWX 'Register "msvcrt" "malloc" "i=l" "r=p")<br />   (vlax-invoke DWX 'Register "msvcrt" "calloc" "i=ll" "r=p")<br />   (vlax-invoke DWX 'Register "msvcrt" "free" "i=l")<br />   ;; Register some ARX functions<br />   (vlax-invoke DWX 'Register path "acedSSGet" "i=ppppp" "r=l")<br />   (vlax-invoke DWX 'Register path "acedSSLength" "i=pp" "r=l")<br />   (vlax-invoke DWX 'Register path "acedSSFree" "i=p" "r=l")<br />   (vlax-invoke DWX 'Register path "acedGetPoint" "i=psp" "r=l")<br />   (vlax-invoke DWX 'Register path "acedDragGen" "i=pplpp" "r=l")<br />   <br />   ;; then call some ARX functions<br />   (setq pLen (vlax-invoke DWX 'calloc 1 4))  ; a pointer to length of the select set<br />   (setq pSel (vlax-invoke DWX 'calloc 2 4))  ; a pointer to select set<br />   (setq pPnt (vlax-invoke DWX 'calloc 3 8))  ; a pointer to coordinate<br />   (setq str  "\nPlease specify the point:")  <br />   (setq pStr (vlax-invoke DWX 'StrPtr str "s"))         ; a pointer to the prompt<br />   (setq ret  (vlax-invoke DWX 'acedSSGet 0 0 0 0 pSel)) ; should return 5100  = (ssget)<br />   (setq ret  (vlax-invoke DWX 'acedGetPoint 0 str pPnt)); should return 5100  = (getpoint)<br />   (setq X    (vlax-invoke DWX 'NumGet pPnt  0 "d"))<br />   (setq Y    (vlax-invoke DWX 'NumGet pPnt  8 "d"))<br />   (setq Z    (vlax-invoke DWX 'NumGet pPnt 16 "d"))<br />   (setq str  (VL-PRINC-TO-STRING (list X Y Z)))<br />   (alert (strcat "The coordinate is: " str))<br />   (vlax-invoke DWX 'acedSSLength pSel pLen)  ; get the length of selectset = (sslength)<br />   (setq str (itoa (vlax-invoke DWX 'NumGet pLen))) <br />   (alert (strcat "The count of selected: " str))<br />   ;; Callback function<br />   (defun CallbackFunc (ads_point ads_matrix)<br />     5000<br />   )<br />   (setq pFun  (vlax-invoke DWX 'RegisterCallback 'CallbackFunc "i=pp" "r=l"))<br />   (setq pIns  (vlax-invoke DWX 'calloc 3 8))<br />   ;;(setq ret   (vlax-invoke DWX 'acedDragGen pSel pStr 0 pFun pIns))  ;don't do this,or your CAD will be ruined<br />   (setq ret   (vlax-invoke DWX 'acedSSFree pSel)) ; free the select set , no equation<br />   ;; free memory and release object.<br />   (vlax-invoke DWX 'free pLen)<br />   (vlax-invoke DWX 'free pSel)<br />   (vlax-invoke DWX 'free pPnt)<br />   (vlax-invoke DWX 'free pStr)<br />   (vlax-invoke DWX 'free pIns)<br />   (vlax-release-object script)<br />   (vlax-release-object DWX)<br />   (princ)<br /> )<br />

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

liu_kunlun

不得不佩服！！

logoin

目前还不懂。。。但是要顶一下

chlh_jd

期待调用ARX函数...
对于像我这样，只想学VLISP又想用到ARX中的免费高效函数的，可能帮助很大
顺便请教下，怎么知道ARX中可供VLISP调用的函数呢，比如ACAD自带的geocal.arx？

chlh_jd

期待调用ARX函数...
对于像我这样，只想学VLISP又想用到ARX中的免费高效函数的，可能帮助很大
顺便请教下，怎么知道ARX中可供VLISP调用的函数呢，比如ACAD自带的geocal.arx？

highflybird

chlh_jd 发表于 2011-3-29 14:50
期待调用ARX函数...
对于像我这样，只想学VLISP又想用到ARX中的免费高效函数的，可能帮助很大 ...

可以用exeScope这个软件(或者oleView,dllexport）查看有哪些输出的函数，然后在
objectarx的帮助文件找就可以了。

yyszpp

楼主啊楼主 我不的不所你很伟大，，，

chpmould

highflybird 发表于 2011-3-23 15:22
在LISP中调用C++,ARX函数以及汇编语言
我不知道这个主题对大家是否有什么帮助，拿到这里，集思广益希望能 ...

建议直接调用ARX封装类，个人为这样方便一些...

先进者

大哥,如何用lisp自定义arx快捷键？能不能给个格式或例子

highflybird

先进者 发表于 2011-7-26 13:30
大哥,如何用lisp自定义arx快捷键？能不能给个格式或例子

并不需要arx函数，就可以自定义快捷键啊。