LISP.net?Call C++,ARX function and assembly code in LISP
I don't know this kind of topic is useful for us or not .
I wrote it here,just for seeking after some technology.At the same time,I will ask some questions,I wish someone can help me find the answer.
If you can give me some advice or help me after you read this article,I really appreciate it.
At the first,you must appload RegisterDynWrapX.VLX ,then you can execute the code below.
We know,a lot of limitations in LISP,We can't get a pointer,can't control memory,can't create a referencable variable,variable parameters can't
be changable,DCL is too simple,etc. But It also has many advantages. It's easy,concise,compatible,interactive,beautiful,I do like it.
So I was wondering: if we can use some C++,arx functions, even assembly code ,it must be very interesting,and it will add LISP many new
features.
At last ,I found a way.That's if we use a "DynamicWrapperX" plugin,we can finish most of unimaginable things.
To make a long story short ,let's see how to call C++ ,arx,and assembly code.
1.Call C Functions
;;; ******************************
;;; 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)
)
2.Add Assembly code
;;; ******************************
;;; 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)
)
3.Call some ARX functions
;;; ******************************
;;; 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)
)
Now is my question:
1.Can we get a real callback function (not a reactor callback)? How?
2.Can we get a class instance (e.g. AcGePoint3d)? How?