Topic: LISP.net?Call C++,ARX functions and assembly code in LISP

[highflyingbird]

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

Code: [Select]

;;; ******************************
;;; 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

Code: [Select]

;;; ******************************
;;; 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

Code: [Select]

;;; ******************************
;;; 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?

 

[Kerry]

A lot of people can't get LISP right.
.... and you're asking them to call C++ and ARX and assembler  through a VLX (that is compiled and contents unknown) from lisp, just so they can access memory pointers.

If you can show me some safe use for this functionality for the average customiser ( or professional programmer) I may become interested

[highflyingbird]

A lot of people can't get LISP right.
.... and you're asking them to call C++ and ARX and assembler  through a VLX (that is compiled and contents unknown) from lisp, just so they can access memory pointers.

If you can show me some safe use for this functionality for the average customiser ( or professional programmer) I may become interested

I didn't mean this for all the users,even for the average customiser.To use it,you must have some knowledge about C and pointer.about safety,it's a dll file,from here.
I will show you some safe use later.
Actually, I have introduced some useful functions,look at here

[JohnK]

Very cool highflybird. I dont think "it" will be used a lot but i can see how accessing a string on memory could be HUGE ("access" to non COM apps).

Although, i do see a big problem; i know you said that "knowledge about C, pointers, and SAFETY" is a requirement but for most autolisp'ers this isnt something they are going to be willing to learn (and giving `them' access to "malloc" and "free" is a scary thought at best).

Very interesting.

>link
As far as extending the COM interface goes, thats just scary. *lol* Its not like the COM server/client concept is not messed up enough!? *lol*


Kerry,
How about "grey matter expansion" or even "because"?

[CAB]

This does demonstrate amazing programing flexibility. It could be used to fill in some of the things vLISP can not do.
Unfortunately I have neither the time nor talent to peruse it.

[MP]

Pretty awesome HFB -- keep pushing the envelope. While I understand cautious responses, and that's generally my standard posture, I don't think you should let that curb your incentive or passion to work on this project. It was a lot of potential, much of it at this time unseen. Kudos.

[hermanm]

A lot of people can't get LISP right.
.... and you're asking them to call C++ and ARX and assembler  through a VLX (that is compiled and contents unknown) from lisp, just so they can access memory pointers.

If you can show me some safe use for this functionality for the average customiser ( or professional programmer) I may become interested

Maybe by exposing to LISP newer features of ACAD which have a .NET, but no COM, interface?

[highflyingbird]

ToolTip

Thank you all .
Here is a general function  for create a tooltip.

Usage: (Add&Update  sLable sToolTipText )          sLable -->the lable of a control
                                                                    sToolTipText--> the tip text 
P.S. the "sLable" parameter is case sensitive.
In the next four days , I have several tests. so maybe I can't reply your words.Sorry.
Welcome your advice.

[highflyingbird]

About this plugin, I searched  the old source code, Later, Yuri Popov improved it.  I posted it in here.
According  to the  author saying :

DynamicWrapperX is an ActiveX component (COM server) inspired by DynamicWrapper, which I wrote as an attempt to better implement the idea. It allows to call functions exported by DLL libraries, in particular Windows API functions, from scripts in JScript and VBScript. This component is not a modification of the original DynamicWrapper, it was written from scratch in the GoAsm assembly language. So far I have tested it under Windows XP SP1 and Windows 98 SE.
-------Author: Yuri Popov.

So if somebody  worry about the safety of using this plugin: is it a virus or a dangerous one?
I will tell you:No,it isn't.You needn't.

[highflyingbird]

Printer and its Paper Size
Here is another demonstration.
Get the printer and its paper size.

[highflyingbird]

Mouse State

Get the mouse state (in here,I just get the direcion of mouse wheel)
Question from here

Code: [Select]

(vl-load-com)
(prompt "\nThe command is : test. Press ESC to quit test.")

;;;---------------------------------------------------------------------
;;;A demonstration show how to get mouse state by API                  
;;;highflybird  2011.5.6                                                
;;;---------------------------------------------------------------------
(defun c:test()
  (setq DWX (vlax-create-object "DynamicWrapperX"))
  (LoadAPI DWX)
  (vl-catch-all-apply 'MsgProc (list DWX))
  (vlax-release-object DWX)
  (princ)
)

;;;---------------------------------------------------------------------
;;;Get the message from drawing area and get the mouse state            
;;;---------------------------------------------------------------------
(defun MsgProc (DWX / ptr hWnd pMsg wParam lParam ret isExit hDw)
  (setq isExit T)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq hDw (vlax-invoke dwx 'getWindow (vla-get-hwnd doc) 5)) ;GW_CHILD
  (setq hDw (vlax-invoke dwx 'getWindow hDw 2)) ;GW_HWNDNEXT

  (setq ptr (vlax-invoke DWX 'calloc 1 28)) ;allocate memory
  (while (and
  (/= (setq Ret (vlax-invoke DWX 'GetMessage ptr hDw 0 0)) 0)  ;receive the message just from drawing area
  isExit ;want to quit?
)
    (if (= Ret -1)
      (progn
(vlax-invoke DWX 'free ptr)
(exit)
      )
    )
    (setq hWnd   (vlax-invoke DWX 'numget ptr  0)) ;the handle
    (setq pMsg   (vlax-invoke DWX 'numget ptr  4)) ;Message
    (setq wParam (vlax-invoke DWX 'numget ptr  8)) ;wParam
    (setq lParam (vlax-invoke DWX 'numget ptr 12)) ;lParam
    (vlax-invoke DWX 'TranslateMessage ptr) ;Translate Message
    (vlax-invoke DWX 'DispatchMessage ptr) ;DispatchMessage
    (if (and (= pMsg 257) (= wParam 27)) ;If press the key "ESC"
      (setq isExit nil) ;then exit
    )
    (if (= pMsg  522) ;WM_MOUSEWHEEL
      (progn
(princ "\nYou are pressing the mouse wheel.\n")
(if (> wParam 0) ;Direction
 (princ "Forward!")
 (princ "Backward!")
)
      )
    )
  )
  (vlax-invoke DWX 'free ptr) ;free memory
)

;;;---------------------------------------------------------------------
;;;Register some API functions                                          
;;;---------------------------------------------------------------------
(defun LoadAPI (DWX)
  ;; Window
  (vlax-invoke DWX 'Register "USER32" "FindWindowW" "i=ww" "r=l")
  (vlax-invoke DWX 'Register "USER32" "FindWindowExW" "i=llww" "r=l")
  (vlax-invoke DWX 'Register "USER32" "GetWindow" "i=ll" "r=l")
  (vlax-invoke DWX 'Register "USER32" "GetWindowLong" "i=ll" "r=l")
  (vlax-invoke DWX 'Register "USER32" "DefWindowProc" "i=llll" "r=l")
  (vlax-invoke DWX 'Register "USER32" "CallWindowProc" "i=lllll" "r=l")
  ;; Message
  (vlax-invoke DWX 'Register "USER32" "GetMessage" "i=plll" "r=l")
  (vlax-invoke DWX 'Register "USER32" "TranslateMessage" "i=l" "r=l")
  (vlax-invoke DWX 'Register "USER32" "DispatchMessage" "i=l" "r=l")
  (vlax-invoke DWX 'Register "USER32" "SendMessageW" "i=llll" "r=l")
  ;; memory
  (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  (vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
)


[chlh_jd]

Nice solution, but we need not only the rolling direction, as well as roll rate, and how to instantly pass information  for VLISP program.

[highflyingbird]

I think I found the more useful application:
VLISP Timer
Chlh_jd, you can reference this post,maybe you will find the answer

[chlh_jd]

Thanks Highflybird !
Very busy this time , Sorry to see it so later .