ActiveX and Script skill in AutoCAD

Lisphk

收集过的高飞版主的一篇英文的介绍ACTIVEX的，非常的好，推荐给大家。




ActiveX and Script skill in AutoCAD


Actually, In CAD , we can use ActiveX and Script skill to solve a lot of problems.
For example,Send a key to a dialog,get some information of the system,etc.

At the first,you must to create a new instance,like this:

1. (setq obj (vlax-create-object prog-id))

(setq obj (vlax-create-object prog-id))

to create a new instance of ActiveX object.
A tip: Don't forget to release them after finished job.

1. (vlax-release-object obj)

(vlax-release-object obj)

then,There are two (maybe more) ways to use them.
1. vlax-invoke-method ,or vlax-invoke -- to apply a function of a object,
  vlax-get-property ,or vlax-get ---The value of the object’s property.
  vlax-put-property ,or vlax-put ---set the value of the object's property.

2. vlax-import-type-library
for example:

1. (if (equal nil mswc-wd100Words) ; check for a WinWord constant
   
2.   (vlax-import-type-library
   
3.     :tlb-filename "c:/Microsoft Office/Office/msword8.olb"
   
4.     :methods-prefix "mswm-"
   
5.     :properties-prefix "mswp-"
   
6.     :constants-prefix "mswc-"
   
7.   )
   
8. )
   

(if (equal nil mswc-wd100Words) ; check for a WinWord constant<br />   (vlax-import-type-library<br />     :tlb-filename "c:/Microsoft Office/Office/msword8.olb"<br />     :methods-prefix "mswm-"<br />     :properties-prefix "mswp-"<br />     :constants-prefix "mswc-"<br />   ) <br /> ) <br />

I like latter better.because it can give us more information about its usage and its properties,and it supplies automatic completion,and less code.
Of course,it doesn't work in any situation like the former.

At the first, I offer a function for the other procedures.

1. (vl-load-com)
   
2. ;;;Get the system special path
   
3. (defun GetSpecialPath (n / fso path)
   
4.   (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
   
5.   (setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))
   
6.   (vlax-release-object fso)
   
7.   path
   
8. )
   

(vl-load-com)<br /> ;;;Get the system special path<br /> (defun GetSpecialPath (n / fso path)<br />   (setq fso  (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))<br />   (vlax-release-object fso)<br />   path <br /> )<br />

WScript.shell , ScriptControl and WMI

Wscript.shell ,ScriptControl and WMI are the most important ojbects,If you know their usage,
you can do the same things without DOS_Lib,even more.
  ;;;import type library

游客，如果您要查看本帖隐藏内容请回复

A simple toturial

1.   ;;Create a scriptControl instance.
   
2.   (setq scr (vlax-create-object "MSScriptControl.ScriptControl.1"))
   
3.   (setq scr (vlax-create-object "ScriptControl"))
   
4.   ;;put its language as "VBS"
   
5.   (vlax-put Scr "language" "vbs")
   
6.   (sp-put-Language scr "VBS")                                        ;the same as upper
   
7. 
   
8.   ;;Create a Wscript.Shell,a FileSystemObject,a Shell.Application
   
9.   (setq wsh (vlax-create-object "WScript.Shell"))
   
10.   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))
    
11.   (setq *SH (vlax-create-object "Shell.Application"))
    
12. 
    
13.   ;;Pop up a simple box
    
14.   (wm-Popup wsh "Hello,World!")
    
15.   ;;Input box
    
16.   (vlax-invoke scr 'ExecuteStatement "str=InputBox(\"Input your string:\", \"Input Box\")")
    
17.   (sm-ExecuteStatement scr "str=InputBox(\"Input your string:\", \"Input Box\")")
    
18.   ;;Eval a WSH variale.
    
19.   (vlax-invoke scr 'eval "str")
    
20.   (sm-eval scr "str")
    
21. 
    
22.   ;;Send keys
    
23.   (wm-sendkeys wsh "C{ENTER}0,0{ENTER}100{ENTER}")                  ;Draw a circle in CAD.
    
24.   (WM-SENDKEYS wsh (chr 1))                                          ;Ctrl + A
    
25.   (WM-SENDKEYS wsh (chr 15))                                          ;Ctrl + O
    
26.   (WM-SENDKEYS wsh (chr 22))                                        ;Ctrl + V
    
27.   ;; if your system can read Chinese,these will be interesting.
    
28.   (WM-SENDKEYS wsh "赌")                                        ;Open My computer
    
29.   (WM-SENDKEYS wsh "品")                                        ;Open Calc.exe
    
30.   (WM-SENDKEYS wsh "血")                                        ;Open Search
    
31.   (WM-SENDKEYS wsh "恋")                                         ;Open Media Player
    
32.   (WM-SENDKEYS wsh "爽")                                         ;Open homepage
    
33.   ;;Create a URL shortcut
    
34.   (setq Spec (wp-get-SpecialFolders wsh))
    
35.   (setq deskTopPath (wm-item spec "DeskTop"))
    
36.   (setq url (wm-CreateShortcut wsh (strcat deskTopPath "\\MyTest.URL")))
    
37.   (wp-put-TargetPath url "http://www.theswamp.org/")
    
38.   (wm-save url)
    
39.   ;;Create a shortcut and assign a shortcut key
    
40.   (setq link (wm-CreateShortcut wsh (strcat DeskTopPath "\\MyTest.lnk")))
    
41.   (wp-put-TargetPath link "http://www.theswamp.org/")
    
42.   (wp-put-WindowStyle link 1)
    
43.   (wp-put-Hotkey link "Ctrl+Alt+T")
    
44.   (wp-put-IconLocation link "shell32.dll,14")
    
45.   (wp-put-Description link "The desciption for Mytest")
    
46.   (wp-put-WorkingDirectory link "c:\\")
    
47.   (wm-save link)
    
48.   ;;Run command
    
49.   (wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")
    
50.   ;;Get a WshEnvironment
    
51.   (Setq env (wp-get-Environment wsh "System"))
    
52.   ;;Get the special path of system.
    
53.   (alert (wp-get-item env "WINDIR"))
    
54.   (alert (wm-ExpandEnvironmentStrings wsh "%windir%"))
    
55.   (alert (wp-get-Item env "TMP"))
    
56.   (alert (wp-get-Item env "TEMP"))
    
57. 
    
58.   ;;Registration table
    
59.   ;;Regread ,RegWrite,RegDelete
    
60.   (vlax-invoke wsh 'RegRead "HKCU\\Software\\AutoDesk\\AutoCAD\\R16.2\\curver")        ;ensure your CAD is autocad 2006
    

  ;;Create a scriptControl instance.<br />   (setq scr (vlax-create-object "MSScriptControl.ScriptControl.1"))<br />   (setq scr (vlax-create-object "ScriptControl"))<br />   ;;put its language as "VBS"<br />   (vlax-put Scr "language" "vbs")<br />   (sp-put-Language scr "VBS")                                        ;the same as upper<br /> <br />   ;;Create a Wscript.Shell,a FileSystemObject,a Shell.Application<br />   (setq wsh (vlax-create-object "WScript.Shell"))<br />   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq *SH (vlax-create-object "Shell.Application"))<br /> <br />   ;;Pop up a simple box<br />   (wm-Popup wsh "Hello,World!")<br />   ;;Input box<br />   (vlax-invoke scr 'ExecuteStatement "str=InputBox(\"Input your string:\", \"Input Box\")")<br />   (sm-ExecuteStatement scr "str=InputBox(\"Input your string:\", \"Input Box\")")<br />   ;;Eval a WSH variale.<br />   (vlax-invoke scr 'eval "str")<br />   (sm-eval scr "str")<br /> <br />   ;;Send keys<br />   (wm-sendkeys wsh "C{ENTER}0,0{ENTER}100{ENTER}")                  ;Draw a circle in CAD.<br />   (WM-SENDKEYS wsh (chr 1))                                          ;Ctrl + A<br />   (WM-SENDKEYS wsh (chr 15))                                          ;Ctrl + O<br />   (WM-SENDKEYS wsh (chr 22))                                        ;Ctrl + V <br />   ;; if your system can read Chinese,these will be interesting.<br />   (WM-SENDKEYS wsh "赌")                                        ;Open My computer<br />   (WM-SENDKEYS wsh "品")                                        ;Open Calc.exe<br />   (WM-SENDKEYS wsh "血")                                        ;Open Search <br />   (WM-SENDKEYS wsh "恋")                                         ;Open Media Player<br />   (WM-SENDKEYS wsh "爽")                                         ;Open homepage<br />   ;;Create a URL shortcut<br />   (setq Spec (wp-get-SpecialFolders wsh))<br />   (setq deskTopPath (wm-item spec "DeskTop"))<br />   (setq url (wm-CreateShortcut wsh (strcat deskTopPath "\\MyTest.URL")))<br />   (wp-put-TargetPath url "http://www.theswamp.org/")<br />   (wm-save url)<br />   ;;Create a shortcut and assign a shortcut key<br />   (setq link (wm-CreateShortcut wsh (strcat DeskTopPath "\\MyTest.lnk")))<br />   (wp-put-TargetPath link "http://www.theswamp.org/")<br />   (wp-put-WindowStyle link 1)<br />   (wp-put-Hotkey link "Ctrl+Alt+T")<br />   (wp-put-IconLocation link "shell32.dll,14")<br />   (wp-put-Description link "The desciption for Mytest")<br />   (wp-put-WorkingDirectory link "c:\\")<br />   (wm-save link)<br />   ;;Run command<br />   (wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")<br />   ;;Get a WshEnvironment<br />   (Setq env (wp-get-Environment wsh "System"))<br />   ;;Get the special path of system.<br />   (alert (wp-get-item env "WINDIR"))<br />   (alert (wm-ExpandEnvironmentStrings wsh "%windir%"))<br />   (alert (wp-get-Item env "TMP"))<br />   (alert (wp-get-Item env "TEMP"))<br /> <br />   ;;Registration table <br />   ;;Regread ,RegWrite,RegDelete<br />   (vlax-invoke wsh 'RegRead "HKCU\\Software\\AutoDesk\\AutoCAD\\R16.2\\curver")        ;ensure your CAD is autocad 2006<br />

Environment variable

1.   ;;Add or remove an Environment variable
   
2.   (alert "Add a test var to the system!")
   
3.   (wp-put-item env "TestVar" "Windows Script Host")
   
4.   (alert "Remove the test var from the system!")
   
5.   (wm-remove env "TestVar")
   
6.   ;;List the Environment variables
   
7.   (setq i 0)
   
8.   (repeat (wm-count env)
   
9.     (princ (wp-get-item env i))                                        ;wouldn't display
   
10.     (setq i (1+ i))
    
11.   )
    
12. 
    
13.   ;;Maybe you would like this way:
    
14.   (setq str
    
15.          "Set WshShell = CreateObject(\"WScript.Shell\")
    
16. 
    
17.          Msgbox \"Environment.item: \"& WshShell.Environment.item(\"WINDIR\")
    
18.          Msgbox \"ExpandEnvironmentStrings: \"& WshShell.ExpandEnvironmentStrings(\"%windir%\")
    
19. 
    
20.          set oEnv=WshShell.Environment(\"System\")
    
21.          
    
22.          Msgbox \"Adding ( TestVar=Windows Script Host ) to the System type environment\"
    
23.          oEnv(\"TestVar\") = \"Windows Script Host\"
    
24. 
    
25.          Msgbox \"removing ( TestVar=Windows Script Host ) from the System type environment\"
    
26.          oEnv.Remove \"TestVar\"
    
27.         
    
28.          for each sitem in oEnv
    
29.          strval=strval & sItem & vbcrlf
    
30.          next
    
31.          Msgbox \"System Environment:\" & vbcrlf & vbcrlf & strval
    
32.          strval=\"\"'
    
33.          
    
34.          set oEnv=WshShell.Environment(\"Process\")
    
35.          for each sitem in oEnv
    
36.          strval=strval & sItem & vbcrlf
    
37.          next
    
38.          Msgbox \"Process Environment:\" & vbcrlf & vbcrlf & strval
    
39.          strval=\"\"
    
40.         
    
41.          set oEnv=WshShell.Environment(\"User\")
    
42.          for each sitem in oEnv
    
43.          strval=strval & sItem & vbcrlf
    
44.          next
    
45.          Msgbox \"User Environment:\" & vbcrlf & vbcrlf & strval
    
46.          strval=\"\"
    
47.         
    
48.          set oEnv=WshShell.Environment(\"Volatile\")
    
49.          for each sitem in oEnv
    
50.          strval=strval & sItem & vbcrlf
    
51.          next
    
52.          Msgbox \"Volatile Environment:\" & vbcrlf & vbcrlf & strval
    
53.          strval=\"\"
    
54. 
    
55.          set oEnv = nothing
    
56.          set WshShell = nothing
    
57.          "
    
58.   )
    
59.   (vlax-invoke Scr 'ExecuteStatement str)
    
60. 
    
61. 
    
62.   ;;another way
    
63.   (setq objENv (vlax-invoke objWMI 'get "Win32_Environment"))
    
64.   (setq objvar (vlax-invoke objenv 'SpawnInstance_))
    
65.   (setq objPro (vlax-get objvar 'Properties_))
    
66. 
    
67.   ;; get more usage
    
68.   (vlax-dump-object objvar T)
    
69.   (vlax-for n objpro
    
70.     (vlax-dump-object n T)
    
71.   )
    
72. 
    
73.   (vlax-put (vlax-invoke objpro 'item "name") 'value "TestValue")
    
74.   (vlax-put (vlax-invoke objpro 'item "UserName") 'value "System")
    
75.   (vlax-put (vlax-invoke objpro 'item "VariableValue") 'value "This is a test")
    
76.   (vlax-put objvar 'name "MyTest")
    
77.   (vlax-put objvar 'UserName "System")
    
78.   (vlax-put objvar 'VariableValue "This is a test")
    
79.   (vlax-invoke objvar 'put_)
    
80.   
    
81.   (setq colItems (vlax-invoke objWMI 'ExecQuery "Select * from Win32_Environment Where Name = 'Path'"))
    
82.   (vlax-for obj colItems
    
83.     (princ (strcat "\nName is:" (vlax-get obj 'name)))
    
84.     (princ (strcat "\nUser Name is:" (vlax-get obj 'username)))
    
85.     (princ (strcat "\nVariable value is:" (vlax-get obj 'variablevalue)))
    
86.   )
    

  ;;Add or remove an Environment variable <br />   (alert "Add a test var to the system!")<br />   (wp-put-item env "TestVar" "Windows Script Host")<br />   (alert "Remove the test var from the system!")<br />   (wm-remove env "TestVar")<br />   ;;List the Environment variables <br />   (setq i 0)<br />   (repeat (wm-count env)<br />     (princ (wp-get-item env i))                                        ;wouldn't display<br />     (setq i (1+ i))<br />   )<br /> <br />   ;;Maybe you would like this way:<br />   (setq str<br />          "Set WshShell = CreateObject(\"WScript.Shell\")<br /> <br />          Msgbox \"Environment.item: \"& WshShell.Environment.item(\"WINDIR\")<br />          Msgbox \"ExpandEnvironmentStrings: \"& WshShell.ExpandEnvironmentStrings(\"%windir%\")<br /> <br />          set oEnv=WshShell.Environment(\"System\")<br />          <br />          Msgbox \"Adding ( TestVar=Windows Script Host ) to the System type environment\"<br />          oEnv(\"TestVar\") = \"Windows Script Host\"<br /> <br />          Msgbox \"removing ( TestVar=Windows Script Host ) from the System type environment\"<br />          oEnv.Remove \"TestVar\"<br />         <br />          for each sitem in oEnv<br />          strval=strval & sItem & vbcrlf<br />          next<br />          Msgbox \"System Environment:\" & vbcrlf & vbcrlf & strval<br />          strval=\"\"'<br />          <br />          set oEnv=WshShell.Environment(\"Process\")<br />          for each sitem in oEnv<br />          strval=strval & sItem & vbcrlf<br />          next<br />          Msgbox \"Process Environment:\" & vbcrlf & vbcrlf & strval<br />          strval=\"\"<br />         <br />          set oEnv=WshShell.Environment(\"User\")<br />          for each sitem in oEnv<br />          strval=strval & sItem & vbcrlf<br />          next<br />          Msgbox \"User Environment:\" & vbcrlf & vbcrlf & strval<br />          strval=\"\"<br />         <br />          set oEnv=WshShell.Environment(\"Volatile\")<br />          for each sitem in oEnv<br />          strval=strval & sItem & vbcrlf<br />          next<br />          Msgbox \"Volatile Environment:\" & vbcrlf & vbcrlf & strval<br />          strval=\"\"<br /> <br />          set oEnv = nothing<br />          set WshShell = nothing<br />          "<br />   )<br />   (vlax-invoke Scr 'ExecuteStatement str)<br /> <br /> <br />   ;;another way<br />   (setq objENv (vlax-invoke objWMI 'get "Win32_Environment"))<br />   (setq objvar (vlax-invoke objenv 'SpawnInstance_))<br />   (setq objPro (vlax-get objvar 'Properties_))<br /> <br />   ;; get more usage<br />   (vlax-dump-object objvar T)<br />   (vlax-for n objpro<br />     (vlax-dump-object n T)<br />   )<br /> <br />   (vlax-put (vlax-invoke objpro 'item "name") 'value "TestValue")<br />   (vlax-put (vlax-invoke objpro 'item "UserName") 'value "System")<br />   (vlax-put (vlax-invoke objpro 'item "VariableValue") 'value "This is a test")<br />   (vlax-put objvar 'name "MyTest")<br />   (vlax-put objvar 'UserName "System")<br />   (vlax-put objvar 'VariableValue "This is a test")<br />   (vlax-invoke objvar 'put_)<br />   <br />   (setq colItems (vlax-invoke objWMI 'ExecQuery "Select * from Win32_Environment Where Name = 'Path'"))<br />   (vlax-for obj colItems<br />     (princ (strcat "\nName is:" (vlax-get obj 'name)))<br />     (princ (strcat "\nUser Name is:" (vlax-get obj 'username)))<br />     (princ (strcat "\nVariable value is:" (vlax-get obj 'variablevalue)))<br />   )<br />

System Information

1.   ;;Get some information from OS
   
2.   (setq str "Set mc=GetObject(\"Winmgmts:\")")
   
3.   (SM-EXECUTESTATEMENT scr str)
   
4.   (setq objWMI (vla-eval scr "mc"))
   
5. 
   
6.   ;;Network Adapter
   
7.   (setq objNet (vlax-invoke objWMI 'InstancesOF "Win32_NetworkAdapterConfiguration"))
   
8.   (princ "\nThe Mac Address is: ")
   
9.   (vlax-for obj objNet
   
10.     (if(/= (vlax-get obj 'IPEnabled) 0)
    
11.       (princ (vlax-get obj 'MacAddress))
    
12.     )
    
13.   )
    
14.   
    
15.   ;;Printer
    
16.   (setq str "Set mc=GetObject(\"Winmgmts:\")")
    
17.   (SM-EXECUTESTATEMENT scr str)
    
18.   (setq objWMI (vla-eval scr "mc"))
    
19.   (setq Printers (vlax-invoke objWMI 'InstancesOF "Win32_Printer"))
    
20.   (vlax-for obj Printers
    
21.     (vlax-dump-object obj T)
    
22.     (alert (vlax-get obj 'Name))
    
23.     (vlax-get obj 'PaperSizesSupported)
    
24.     (alert (vlax-invoke obj 'GetObjectText_))
    
25.   )
    
26.   
    
27.   ;; ProcessorId
    
28.   ;; Maybe this one is better.
    
29.   (defun c:ttt(/ item meth1 meth2 s serx wmi)
    
30.     (vl-load-com)
    
31.     (setq lst nil)
    
32.     (setq WMI   (vlax-create-object "WbemScripting.SWbemLocator")
    
33.           meth1 (VLAX-INVOKE WMI 'ConnectServer nil nil nil nil nil nil nil nil)
    
34.           meth2 (vlax-invoke meth1 'ExecQuery "select ProcessorId from Win32_Processor")
    
35.           s     (vlax-for        item meth2
    
36.                 (setq serx (list (vlax-get item 'ProcessorId)))
    
37.     )
    
38.     (vlax-release-object meth1)
    
39.     (vlax-release-object meth2)
    
40.     (vlax-release-object wmi)
    
41.     (car s)
    
42.   )
    
43. 
    
44.   ;;you can get more details  by these ways:
    
45.   (foreach p (list
    
46.                "Win32_ComputerSystem"
    
47.                "Win32_Service"
    
48.                "Win32_LogicalMemoryConfiguration"
    
49.                "Win32_Process"
    
50.                "Win32_Processor"
    
51.                "Win32_OperatingSystem"
    
52.                "Win32_WMISetting"
    
53.                "__NAMESPACE"
    
54.                "win32_baseboard"
    
55.                "win32_videocontroller"
    
56.                "win32_DiskDrive"
    
57.                "win32_physicalMemory"
    
58.                "Win32_Environment"
    
59.                "Win32_ProcessStartTrace"
    
60.                "Win32_PnpDevice"
    
61.                "Win32_SoundDevice"
    
62.                "Win32_ProductCheck"
    
63.                "Win32_NetworkAdapter"
    
64.                "Win32_CDROMDrive"
    
65.                "Win32_DesktopMonitor"
    
66.                "Win32_NetworkAdapterConfiguration"
    
67.              )
    
68.     (setq objSYS (vlax-invoke objWMI 'InstancesOf p))
    
69.     (vlax-for n objSYS
    
70.       (alert (vlax-invoke n 'GetObjectText_))  
    
71.     )
    
72.   )
    
73.   
    
74.   (setq WMI (vla-eval scr "mc"))
    
75.   ;;Just collect some simple information:
    
76.   ;;Get User name.
    
77.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
    
78.   (vlax-for n Col
    
79.     (princ "\nUser name is:")
    
80.     (princ (vlax-get n 'name))
    
81.   )
    
82. 
    
83.   ;;Get the running process
    
84.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Process" "WQL" 48))
    
85.   (vlax-for n Col
    
86.     (princ (vlax-get n 'name))
    
87.   )
    
88. 
    
89.   ;;Get the information of CPU
    
90.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Processor" "WQL" 48))
    
91.   (vlax-for n Col
    
92.     (princ (vlax-get n 'name))
    
93.   )
    
94. 
    
95.   ;;Get the Total of physical memory
    
96.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
    
97.   (vlax-for n Col
    
98.     (princ (/ (read (vlax-get n 'TotalPhysicalMemory)) 1048576))
    
99.     (princ "M")
    
100.   )
     
101. 
     
102.   ;;Get the information of physical memory
     
103.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_PhysicalMemory" "WQL" 48))
     
104.   (vlax-for n Col
     
105.     (princ "\n")
     
106.     (princ (vlax-get n 'Description))
     
107.     (princ "\n")
     
108.     (princ (vlax-get n 'DeviceLocator))
     
109.     (princ "\n")
     
110.     (princ (vlax-get n 'speed))
     
111.   )
     
112. 
     
113.   ;;Get the information of Video Controller
     
114.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_VideoController" "WQL" 48))
     
115.   (vlax-for n Col
     
116.     (princ "\n")
     
117.     (princ (vlax-get n 'Caption))
     
118.     (princ "\n")
     
119.     (princ (vlax-get n 'VideoModeDescription))
     
120.   )
     
121. 
     
122.   ;;Get the information of Disk drive
     
123.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_DiskDrive" "WQL" 48))
     
124.   (vlax-for n Col
     
125.     (princ "\nThe Caption is:")
     
126.     (princ (vlax-get n 'Caption))
     
127.     (princ "\nThe size is:")
     
128.     (princ (/ (read (vlax-get n 'size)) 1073741824))
     
129.     (princ "G")
     
130.   )
     
131. 
     
132.   ;;Get the information of Sound Device
     
133.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_SoundDevice" "WQL" 48))
     
134.   (vlax-for n Col
     
135.     (princ "\nThe product Name is:")
     
136.     (princ (vlax-get n 'ProductName))
     
137.   )
     
138. 
     
139.   ;;Get the information of Network Adapter
     
140.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_NetworkAdapter" "WQL" 48))
     
141.   (vlax-for n Col
     
142.     (princ "\nThe Description is:")
     
143.     (princ (vlax-get n 'Description))
     
144.     (princ "\nThe MAC address is")
     
145.     (princ (vlax-get n 'MACAddress))
     
146.   )
     
147.   
     
148.   ;;Get the information of FloppyDrive  --haha,do you have a floppy drive?
     
149.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_FloppyDrive" "WQL" 48))
     
150.   (vlax-for n Col
     
151.     (princ "\nThe caption is:")
     
152.     (princ (vlax-get n 'Caption))
     
153.   )
     
154. 
     
155.   ;;Get the information of CD/DVD ROM
     
156.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_CDROMDrive" "WQL" 48))
     
157.   (vlax-for n Col
     
158.     (princ "\nThe Drive name is:")
     
159.     (princ (vlax-get n 'Name))
     
160.     (princ "\nThe description is:")
     
161.     (princ (vlax-get n 'Description))           
     
162.   )
     
163.   
     
164.   ;;Get the information of Desktop Monitor
     
165.   (setq CoL (vlax-invoke WMI 'ExecQuery "Select * from Win32_DesktopMonitor" "WQL" 48))
     
166.   (vlax-for n Col
     
167.     (princ "\nScreen Width:")
     
168.     (princ (vlax-get n 'ScreenWidth))
     
169.     (princ "\nScreen Height:")
     
170.     (princ (vlax-get n 'ScreenHeight))
     
171.   )
     

  ;;Get some information from OS<br />   (setq str "Set mc=GetObject(\"Winmgmts:\")")<br />   (SM-EXECUTESTATEMENT scr str)<br />   (setq objWMI (vla-eval scr "mc"))<br /> <br />   ;;Network Adapter<br />   (setq objNet (vlax-invoke objWMI 'InstancesOF "Win32_NetworkAdapterConfiguration"))<br />   (princ "\nThe Mac Address is: ")<br />   (vlax-for obj objNet<br />     (if(/= (vlax-get obj 'IPEnabled) 0)<br />       (princ (vlax-get obj 'MacAddress))<br />     )<br />   )<br />   <br />   ;;Printer<br />   (setq str "Set mc=GetObject(\"Winmgmts:\")")<br />   (SM-EXECUTESTATEMENT scr str)<br />   (setq objWMI (vla-eval scr "mc"))<br />   (setq Printers (vlax-invoke objWMI 'InstancesOF "Win32_Printer"))<br />   (vlax-for obj Printers<br />     (vlax-dump-object obj T)<br />     (alert (vlax-get obj 'Name))<br />     (vlax-get obj 'PaperSizesSupported)<br />     (alert (vlax-invoke obj 'GetObjectText_))<br />   )<br />   <br />   ;; ProcessorId<br />   ;; Maybe this one is better.<br />   (defun c:ttt(/ item meth1 meth2 s serx wmi)<br />     (vl-load-com)<br />     (setq lst nil)<br />     (setq WMI   (vlax-create-object "WbemScripting.SWbemLocator")<br />           meth1 (VLAX-INVOKE WMI 'ConnectServer nil nil nil nil nil nil nil nil)<br />           meth2 (vlax-invoke meth1 'ExecQuery "select ProcessorId from Win32_Processor")<br />           s     (vlax-for        item meth2<br />                 (setq serx (list (vlax-get item 'ProcessorId)))<br />     )<br />     (vlax-release-object meth1)<br />     (vlax-release-object meth2)<br />     (vlax-release-object wmi)<br />     (car s)<br />   )<br /> <br />   ;;you can get more details  by these ways:<br />   (foreach p (list<br />                "Win32_ComputerSystem"<br />                "Win32_Service"<br />                "Win32_LogicalMemoryConfiguration"<br />                "Win32_Process"<br />                "Win32_Processor"<br />                "Win32_OperatingSystem"<br />                "Win32_WMISetting"<br />                "__NAMESPACE"<br />                "win32_baseboard"<br />                "win32_videocontroller"<br />                "win32_DiskDrive"<br />                "win32_physicalMemory"<br />                "Win32_Environment"<br />                "Win32_ProcessStartTrace"<br />                "Win32_PnpDevice"<br />                "Win32_SoundDevice"<br />                "Win32_ProductCheck"<br />                "Win32_NetworkAdapter"<br />                "Win32_CDROMDrive"<br />                "Win32_DesktopMonitor"<br />                "Win32_NetworkAdapterConfiguration"<br />              )<br />     (setq objSYS (vlax-invoke objWMI 'InstancesOf p))<br />     (vlax-for n objSYS<br />       (alert (vlax-invoke n 'GetObjectText_))  <br />     )<br />   )<br />   <br />   (setq WMI (vla-eval scr "mc"))<br />   ;;Just collect some simple information:<br />   ;;Get User name.<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nUser name is:")<br />     (princ (vlax-get n 'name))<br />   )<br /> <br />   ;;Get the running process<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Process" "WQL" 48))<br />   (vlax-for n Col<br />     (princ (vlax-get n 'name))<br />   )<br /> <br />   ;;Get the information of CPU<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Processor" "WQL" 48))<br />   (vlax-for n Col<br />     (princ (vlax-get n 'name))<br />   )<br /> <br />   ;;Get the Total of physical memory<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))<br />   (vlax-for n Col<br />     (princ (/ (read (vlax-get n 'TotalPhysicalMemory)) 1048576))<br />     (princ "M")<br />   )<br /> <br />   ;;Get the information of physical memory<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_PhysicalMemory" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n")<br />     (princ (vlax-get n 'Description))<br />     (princ "\n")<br />     (princ (vlax-get n 'DeviceLocator))<br />     (princ "\n")<br />     (princ (vlax-get n 'speed))<br />   )<br /> <br />   ;;Get the information of Video Controller<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_VideoController" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n")<br />     (princ (vlax-get n 'Caption))<br />     (princ "\n")<br />     (princ (vlax-get n 'VideoModeDescription))<br />   )<br /> <br />   ;;Get the information of Disk drive<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_DiskDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nThe Caption is:")<br />     (princ (vlax-get n 'Caption))<br />     (princ "\nThe size is:")<br />     (princ (/ (read (vlax-get n 'size)) 1073741824))<br />     (princ "G")<br />   )<br /> <br />   ;;Get the information of Sound Device<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_SoundDevice" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nThe product Name is:")<br />     (princ (vlax-get n 'ProductName))<br />   )<br /> <br />   ;;Get the information of Network Adapter<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_NetworkAdapter" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nThe Description is:")<br />     (princ (vlax-get n 'Description))<br />     (princ "\nThe MAC address is")<br />     (princ (vlax-get n 'MACAddress))<br />   )<br />   <br />   ;;Get the information of FloppyDrive  --haha,do you have a floppy drive?<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_FloppyDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nThe caption is:")<br />     (princ (vlax-get n 'Caption))<br />   )<br /> <br />   ;;Get the information of CD/DVD ROM<br />   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_CDROMDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nThe Drive name is:")<br />     (princ (vlax-get n 'Name))<br />     (princ "\nThe description is:")<br />     (princ (vlax-get n 'Description))           <br />   )<br />   <br />   ;;Get the information of Desktop Monitor<br />   (setq CoL (vlax-invoke WMI 'ExecQuery "Select * from Win32_DesktopMonitor" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\nScreen Width:")<br />     (princ (vlax-get n 'ScreenWidth))<br />     (princ "\nScreen Height:")<br />     (princ (vlax-get n 'ScreenHeight))<br />   )<br />

Shell Application

;;; some small applications of Shell.application

1.   (setq path (strcat (getSpecialPath 1) "\\shell32.dll"))
   
2.   (if (not ac-ssfwindows)
   
3.     (vlax-import-type-library
   
4.       :tlb-filename  path
   
5.       :methods-prefix "am-"
   
6.       :properties-prefix "ap-"
   
7.       :constants-prefix "ac-"
   
8.     )
   
9.   )
   
10.   (setq *SHELL (vlax-create-object "Shell.Application"))
    
11.   (am-CascadeWindows *SHELL)                                          ;Cascade Windows
    
12.   (am-ControlPanelItem *SHELL "inetcpl.cpl" )                    ;Open a control panel(internet)
    
13.   (am-settime *SHELL)                                                 ;Open the time setting dialog
    
14. 
    
15.   (am-explore *SHELL "c:\\")                                    ;Explore C:
    
16.   (am-FindComputer *SHELL)                                      ;Search a computer                                                                                                                                         ;搜索计算机
    
17.   (am-findPrinter *SHELL "canno")                               ;Search a printer
    
18.   (am-GetSystemInformation *SHELL "ProcessorSpeed")             ;Get the processor speed(in windows 7 or vista)
    
19.   (am-GetSystemInformation *SHELL "PhysicalMemoryInstalled")    ;the capacity of physical memory
    
20.   (am-GetSystemInformation *SHELL "IsOS_Professional")          ;Check the Operating system version is professional or not.
    
21.   (am-filerun *SHELL)                                           ;Open "Windows Run"
    
22.   (am-ShutdownWindows *SHELL)                                   ;Shutdown windows
    
23.   (am-findfiles *SHELL)                                         ;Searh files
    
24.   (am-toggledesktop *SHELL)                                     ;toggle desktop
    
25.   (am-IsServiceRunning *SHELL "Spooler")                        ;check a service is running or not(e.g,spooler service)
    
26.   (am-WindowsSecurity *SHELL)                                   ;Windows Security
    
27.   (am-AddToRecent *SHELL "c:\\1.txt")                                ;Add to recent
    
28.   (am-namespace *SHELL "c:\\")                                  ;return a folder object
    
29.   (am-BrowseForFolder *SHELL                                        ;BrowseForFolder               
    
30.     (vla-get-hwnd (vlax-get-acad-object) )
    
31.     "Select a folder"
    
32.     64
    
33.   )                                                        
    
34.   (am-open *SHELL "c:\\")                                        ;Open a folder.
    

  (setq path (strcat (getSpecialPath 1) "\\shell32.dll"))<br />   (if (not ac-ssfwindows)<br />     (vlax-import-type-library<br />       :tlb-filename  path<br />       :methods-prefix "am-"<br />       :properties-prefix "ap-"<br />       :constants-prefix "ac-"<br />     )<br />   )<br />   (setq *SHELL (vlax-create-object "Shell.Application"))<br />   (am-CascadeWindows *SHELL)                                          ;Cascade Windows<br />   (am-ControlPanelItem *SHELL "inetcpl.cpl" )                    ;Open a control panel(internet)<br />   (am-settime *SHELL)                                                 ;Open the time setting dialog<br /> <br />   (am-explore *SHELL "c:\\")                                    ;Explore C:<br />   (am-FindComputer *SHELL)                                      ;Search a computer                                                                                                                                         ;搜索计算机<br />   (am-findPrinter *SHELL "canno")                               ;Search a printer<br />   (am-GetSystemInformation *SHELL "ProcessorSpeed")             ;Get the processor speed(in windows 7 or vista)<br />   (am-GetSystemInformation *SHELL "PhysicalMemoryInstalled")    ;the capacity of physical memory<br />   (am-GetSystemInformation *SHELL "IsOS_Professional")          ;Check the Operating system version is professional or not.<br />   (am-filerun *SHELL)                                           ;Open "Windows Run"<br />   (am-ShutdownWindows *SHELL)                                   ;Shutdown windows<br />   (am-findfiles *SHELL)                                         ;Searh files<br />   (am-toggledesktop *SHELL)                                     ;toggle desktop<br />   (am-IsServiceRunning *SHELL "Spooler")                        ;check a service is running or not(e.g,spooler service)<br />   (am-WindowsSecurity *SHELL)                                   ;Windows Security<br />   (am-AddToRecent *SHELL "c:\\1.txt")                                ;Add to recent<br />   (am-namespace *SHELL "c:\\")                                  ;return a folder object<br />   (am-BrowseForFolder *SHELL                                        ;BrowseForFolder                <br />     (vla-get-hwnd (vlax-get-acad-object) )<br />     "Select a folder"<br />     64<br />   )                                                        <br />   (am-open *SHELL "c:\\")                                        ;Open a folder.<br />

;;Here is an example,to get some details of a picture file.

1.   (defun GetInfoOfPic(*SHELL path name / info root file i l)
   
2.     (setq root (am-namespace *SHELL path))
   
3.     (setq file (am-ParseName root name))
   
4.     (setq i 0)
   
5.     (repeat 256
   
6.       (setq info (am-GetDetailsOf root file i))
   
7.       (if (/= info "")
   
8.         (progn
   
9.           (princ (strcat "\nIndex " (itoa i) ": " info))
   
10.           (setq l (cons info l))
    
11.         )
    
12.       )
    
13.       (setq i (1+ i))
    
14.     )
    
15.     (reverse l)
    
16.   )
    
17.   (getInfoOfPic *SHELL "D:\\" "1.jpg")
    

  (defun GetInfoOfPic(*SHELL path name / info root file i l)<br />     (setq root (am-namespace *SHELL path))<br />     (setq file (am-ParseName root name))<br />     (setq i 0)<br />     (repeat 256<br />       (setq info (am-GetDetailsOf root file i))<br />       (if (/= info "")<br />         (progn <br />           (princ (strcat "\nIndex " (itoa i) ": " info))<br />           (setq l (cons info l))<br />         )<br />       )<br />       (setq i (1+ i))<br />     )<br />     (reverse l)<br />   )<br />   (getInfoOfPic *SHELL "D:\\" "1.jpg")<br />

;;Here is a program to get a foler and its subdirectories and files name.

1. 
   
2. 
   
3. ;;to Create a new foler
   
4. [code=lisp]
   
5.   (defun BrowseFolder(*SHELL fp / root items count i item path name)
   
6.     (setq root (am-namespace *SHELL fp))
   
7.     (setq items (am-items root))
   
8.     (setq count (ap-get-Count items))
   
9.     (setq i 0)
   
10.     (repeat count
    
11.       (setq item (am-item items i))
    
12.       (setq path (ap-get-path item))
    
13.       (setq name (ap-get-name item))
    
14.       (if (= (ap-get-IsFolder item) :vlax-true)                        
    
15.         (progn
    
16.           (princ (strcat "\n---Folder:" path))
    
17.           (BrowseFolder *SHELL path)
    
18.         )
    
19.         (princ (strcat "\nFile name:" name))
    
20.       )
    
21.       (setq i (1+ i))
    
22.     )
    
23.   )
    
24.   (BrowseFolder *SHELL "C:\\Program Files\\AutoCAD 2006")
    

</font></font></font></font><br /> <font color=\"#000\"><font style=\"background-color:rgb(240, 244, 247)\"><font face=\"Verdana, Arial, Helvetica, sans-serif\"><font style=\"font-size:12.48px\"><br /> </font></font></font></font><font color=\"#000\"><font style=\"background-color:rgb(240, 244, 247)\"><font face=\"Verdana, Arial, Helvetica, sans-serif\"><font style=\"font-size:12.48px\">;;to Create a new foler </font></font></font></font><font face=\"Verdana, Arial, Helvetica, sans-serif\"><font color=\"#000000\"><font style=\"font-size:12.48px\"><br /> </font></font></font>[code=lisp]<br />   (defun BrowseFolder(*SHELL fp / root items count i item path name)<br />     (setq root (am-namespace *SHELL fp))<br />     (setq items (am-items root))<br />     (setq count (ap-get-Count items))<br />     (setq i 0)<br />     (repeat count<br />       (setq item (am-item items i))<br />       (setq path (ap-get-path item))<br />       (setq name (ap-get-name item))<br />       (if (= (ap-get-IsFolder item) :vlax-true)                        <br />         (progn<br />           (princ (strcat "\n---Folder:" path))<br />           (BrowseFolder *SHELL path)<br />         )<br />         (princ (strcat "\nFile name:" name))<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   (BrowseFolder *SHELL "C:\\Program Files\\AutoCAD 2006")<br />

;;to Create a new foler

1.   (setq root (am-namespace *SHELL "d:\\"))
   
2.   (am-NewFolder root "Test")
   

  (setq root (am-namespace *SHELL "d:\\"))<br />   (am-NewFolder root "Test")<br />

;;to copy a file

1.   (setq file (am-ParseName root "1.jpg"))
   
2.   (am-copyhere (am-namespace *SHELL "c:\\") file 16)
   

  (setq file (am-ParseName root "1.jpg"))<br />   (am-copyhere (am-namespace *SHELL "c:\\") file 16)<br />

;;to move a file (e.g,move a file to recyle bin)

1.   (setq opFlag 1108)                                ;FOF_ALLOWUNDO | FOF_SIMPLEPROGRESS | FOF_NOCONFIRMATION
   
2.   (setq bin (am-namespace *SHELL 10))                ;Recyle bin
   
3.   (am-movehere bin "c:\\1.dwg" opFlag)          ;move to recyle bin
   

  (setq opFlag 1108)                                ;FOF_ALLOWUNDO | FOF_SIMPLEPROGRESS | FOF_NOCONFIRMATION<br />   (setq bin (am-namespace *SHELL 10))                ;Recyle bin <br />   (am-movehere bin "c:\\1.dwg" opFlag)          ;move to recyle bin<br />

;;Get some special folder.

1.   (am-NameSpace *SHELL "shell:PrintersFolder")
   
2.   (am-NameSpace *SHELL "shell:personal")
   
3.   (am-NameSpace *SHELL "shell:drivefolder")
   

  (am-NameSpace *SHELL "shell:PrintersFolder")<br />   (am-NameSpace *SHELL "shell:personal")<br />   (am-NameSpace *SHELL "shell:drivefolder")<br />

;;Verbs and File Associations

1.   (am-doit (am-item (am-verbs (ap-get-self root)) 0))
   
2.   (am-doit (am-item (am-verbs file) 0))
   

  (am-doit (am-item (am-verbs (ap-get-self root)) 0))<br />   (am-doit (am-item (am-verbs file) 0))<br />

;;Open some control panel options

1.   (am-ShellExecute *SHELL "Explorer.exe" "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")    ;Open "My Computer"
   
2.   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLL sysdm.cpl,,2" )    ;Open "System Property"
   
3.   (am-ShellExecute *SHELL "Rundll32.exe" "shdocvw.dll,OpenURL %l")                        ;Internet shortcut ,IE8,IE7?
   
4.   (am-ShellExecute *SHELL "Rundll32.exe" "msconf.dll,OpenConfLink")                        ;SpeedDial
   
5.   (am-ShellExecute *SHELL "Rundll32.exe" "zipfldr.dll,RouteTheCall")                        ;Zip file
   
6.   (am-ShellExecute *SHELL "Rundll32.exe" "netplwiz.dll,UsersRunDll")                        ;user account control panel
   
7.   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 0")                ;Open Folder Options
   
8.   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 1")                ;Open Taskbar
   
9.   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLLAsUser")                ;Open Control panel
   

  (am-ShellExecute *SHELL "Explorer.exe" "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")    ;Open "My Computer"<br />   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLL sysdm.cpl,,2" )    ;Open "System Property"<br />   (am-ShellExecute *SHELL "Rundll32.exe" "shdocvw.dll,OpenURL %l")                        ;Internet shortcut ,IE8,IE7?<br />   (am-ShellExecute *SHELL "Rundll32.exe" "msconf.dll,OpenConfLink")                        ;SpeedDial<br />   (am-ShellExecute *SHELL "Rundll32.exe" "zipfldr.dll,RouteTheCall")                        ;Zip file<br />   (am-ShellExecute *SHELL "Rundll32.exe" "netplwiz.dll,UsersRunDll")                        ;user account control panel<br />   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 0")                ;Open Folder Options<br />   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 1")                ;Open Taskbar <br />   (am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLLAsUser")                ;Open Control panel<br />

;;Execute shell command.

1.   (am-ShellExecute *SHELL "cmd.exe")
   
2.   (setq root (am-namespace *SHELL "c:\\windows\\system32"))
   
3.   (setq exec (am-parsename root "CMD.exe"))
   
4.   (am-invokeverb exec)
   

  (am-ShellExecute *SHELL "cmd.exe")<br />   (setq root (am-namespace *SHELL "c:\\windows\\system32"))<br />   (setq exec (am-parsename root "CMD.exe"))<br />   (am-invokeverb exec)<br />

;;Favorite,add to bookmark

1.   (setq mark (vlax-create-object "Shell.UIHelper.1"))
   
2.   (vlax-invoke mark 'AddChannel "http://www.theswamp.org/")
   
3.   (vlax-invoke mark 'AddFavorite "http://www.theswamp.org/" "Theswamp")
   
4.   (vlax-invoke mark 'AddDesktopComponent "d:\\1.jpg" "image")
   

  (setq mark (vlax-create-object "Shell.UIHelper.1"))<br />   (vlax-invoke mark 'AddChannel "http://www.theswamp.org/")<br />   (vlax-invoke mark 'AddFavorite "http://www.theswamp.org/" "Theswamp")<br />   (vlax-invoke mark 'AddDesktopComponent "d:\\1.jpg" "image")<br />

;;Get information from a special path

1.   (defun GetInfo(*SHELL folds / objs i obj name lst prop)
   
2.     (setq objs (am-items (am-namespace *SHELL folds)))  ;from ac-XXXXXX
   
3.     (setq i 0)
   
4.     (repeat (ap-get-count objs)
   
5.       (setq obj  (am-item objs i))
   
6.       (setq name (ap-get-name obj))
   
7.       (setq prop (am-ExtendedProperty obj "type"))
   
8.       (setq lst  (cons (cons name prop) lst))
   
9.       (setq i (1+ i))
   
10.     )
    
11.     (reverse lst)
    
12.   )
    
13.   ;;some examples:
    
14.   (getInfo *SHELL ac-ssffonts)                                ;Get the fonts installed.
    
15.   (getInfo *SHELL ac-ssfCONTROLS)                         ;Get the control panles.
    
16.   (getInfo *SHELL ac-ssfMYPICTURES)                           ;Get the pictures in "My Pictures"
    
17.   (getInfo *SHELL ac-ssfDRIVES)                               ;Get the Drivers in "My computer"
    
18.   (getInfo *SHELL ac-ssfnetwork)                              ;Get the information of "network"
    
19.   (getInfo *SHELL ac-ssfsystem)                                ;Get the files from system folder.
    
20.   (getInfo *SHELL ac-ssfRecent)                              ;Get the Recent opened files
    

  (defun GetInfo(*SHELL folds / objs i obj name lst prop)<br />     (setq objs (am-items (am-namespace *SHELL folds)))  ;from ac-XXXXXX<br />     (setq i 0)<br />     (repeat (ap-get-count objs)<br />       (setq obj  (am-item objs i))<br />       (setq name (ap-get-name obj))<br />       (setq prop (am-ExtendedProperty obj "type"))<br />       (setq lst  (cons (cons name prop) lst))<br />       (setq i (1+ i))<br />     )<br />     (reverse lst)<br />   )<br />   ;;some examples:<br />   (getInfo *SHELL ac-ssffonts)                                ;Get the fonts installed.<br />   (getInfo *SHELL ac-ssfCONTROLS)                         ;Get the control panles.<br />   (getInfo *SHELL ac-ssfMYPICTURES)                           ;Get the pictures in "My Pictures"<br />   (getInfo *SHELL ac-ssfDRIVES)                               ;Get the Drivers in "My computer"<br />   (getInfo *SHELL ac-ssfnetwork)                              ;Get the information of "network"<br />   (getInfo *SHELL ac-ssfsystem)                                ;Get the files from system folder.<br />   (getInfo *SHELL ac-ssfRecent)                              ;Get the Recent opened files<br />

;;this function to get the windows that opened by "Explore"

1.   (defun GetWindows(*SHELL / i l lst obj winobj)
   
2.     (vlax-invoke *SHELL 'windows)
   
3.     (vlax-get (vlax-invoke *SHELL 'windows) 'count)
   
4.     (setq winobj (vlax-invoke *SHELL 'windows))
   
5.     (setq i 0)
   
6.     (repeat (vlax-get winobj 'count)
   
7.       (setq obj (vlax-invoke winobj 'item i))
   
8.       (setq lst (list
   
9.                   (vlax-get obj 'toolbar)
   
10.                   (vlax-get obj 'StatusText)
    
11.                   (vlax-get obj 'FullName)
    
12.                   (vlax-get obj 'LocationURL)
    
13.                   (vlax-get obj 'Path)
    
14.                 )
    
15.       )
    
16.       (setq l (cons lst l))            
    
17.       (setq i (1+ i))
    
18.     )
    
19.     (reverse l)
    
20.   )
    
21.   (GetWindows *SHELL)
    

  (defun GetWindows(*SHELL / i l lst obj winobj)<br />     (vlax-invoke *SHELL 'windows)<br />     (vlax-get (vlax-invoke *SHELL 'windows) 'count)<br />     (setq winobj (vlax-invoke *SHELL 'windows))<br />     (setq i 0)<br />     (repeat (vlax-get winobj 'count)<br />       (setq obj (vlax-invoke winobj 'item i))<br />       (setq lst (list<br />                   (vlax-get obj 'toolbar)<br />                   (vlax-get obj 'StatusText)<br />                   (vlax-get obj 'FullName)<br />                   (vlax-get obj 'LocationURL)<br />                   (vlax-get obj 'Path)<br />                 )<br />       )<br />       (setq l (cons lst l))            <br />       (setq i (1+ i))<br />     )<br />     (reverse l)<br />   )<br />   (GetWindows *SHELL)<br />

;;release objects

1.   (vlax-release-object mark)
   
2.   (vlax-release-object root)
   
3.   (vlax-release-object file)
   
4.   (vlax-release-object exec)
   
5.   (vlax-release-object *SHELL)
   
6.   (princ)
   

  (vlax-release-object mark)<br />   (vlax-release-object root)<br />   (vlax-release-object file)<br />   (vlax-release-object exec)<br />   (vlax-release-object *SHELL)<br />   (princ)<br />

File System Object


;;;Get filesystemObject

1.   (setq path (strcat (getSpecialPath 1) "\\scrrun.dll"))
   
2.   (if (not fc-Alias)
   
3.     (vlax-import-type-library
   
4.       :tlb-filename                 path
   
5.       :methods-prefix                 "fm-"
   
6.       :properties-prefix         "fp-"
   
7.       :constants-prefix         "fc-"
   
8.     )
   
9.   )
   
10.   (setq fso (vlax-create-object "Scripting.FileSystemObject"))
    

  (setq path (strcat (getSpecialPath 1) "\\scrrun.dll"))<br />   (if (not fc-Alias)<br />     (vlax-import-type-library<br />       :tlb-filename                 path<br />       :methods-prefix                 "fm-"<br />       :properties-prefix         "fp-"<br />       :constants-prefix         "fc-"<br />     )<br />   )<br />   (setq fso (vlax-create-object "Scripting.FileSystemObject"))<br />

Folder and its subfolers

1.   ;;Print a foler and its subfolders
   
2.   (defun showSubFolder (folder)
   
3.     (vlax-for  subfolder  (fp-get-SubFolders folder)
   
4.       (princ (strcat "\n" (fp-get-Path subfolder)))
   
5.       (ShowSubFolder subFolder)
   
6.     )
   
7.   )
   
8.   ;;Get a folder and all of its subfolders(recursively)
   
9.   (defun GetSubFolder (fso path / l)
   
10.     (defun GetSubFolder1 (folder / p)
    
11.       (vlax-for  subfolder (fp-get-SubFolders folder)
    
12.         (setq p (fp-get-Path subfolder))
    
13.         (setq l (cons p (GetSubFolder1 subFolder)))
    
14.       )
    
15.       l
    
16.     )
    
17.     (setq l (list path))
    
18.     (if (fm-folderExists fso path)
    
19.       (reverse (getSubFolder1 (fm-getFolder fso path)))
    
20.     )        
    
21.   )
    
22. 
    
23.   (showSubFolder (fm-GetFolder fso "C:\\test"))
    
24.   (getSubFolder fso "C:\\test")
    

  ;;Print a foler and its subfolders<br />   (defun showSubFolder (folder)<br />     (vlax-for  subfolder  (fp-get-SubFolders folder)<br />       (princ (strcat "\n" (fp-get-Path subfolder)))<br />       (ShowSubFolder subFolder)<br />     )<br />   )<br />   ;;Get a folder and all of its subfolders(recursively)<br />   (defun GetSubFolder (fso path / l)<br />     (defun GetSubFolder1 (folder / p)<br />       (vlax-for  subfolder (fp-get-SubFolders folder)<br />         (setq p (fp-get-Path subfolder))<br />         (setq l (cons p (GetSubFolder1 subFolder)))<br />       )<br />       l<br />     )<br />     (setq l (list path))<br />     (if (fm-folderExists fso path)<br />       (reverse (getSubFolder1 (fm-getFolder fso path)))<br />     )        <br />   )<br /> <br />   (showSubFolder (fm-GetFolder fso "C:\\test"))<br />   (getSubFolder fso "C:\\test")<br />

Get the disks and their details

1.   (defun GetNumOfDrives(fso / drives i)
   
2.     (setq drives (vlax-get fso 'drives))
   
3.     (setq i 0)
   
4.     (vlax-for drive drives
   
5.       (vlax-dump-object drive)
   
6.       (setq i (1+ i))
   
7.     )
   
8.     (princ "\nThe count of disks is: ")
   
9.     (princ i)
   
10.     i
    
11.   )
    
12.   (GetNumOfDrives fso)
    

  (defun GetNumOfDrives(fso / drives i)<br />     (setq drives (vlax-get fso 'drives))<br />     (setq i 0)<br />     (vlax-for drive drives<br />       (vlax-dump-object drive)<br />       (setq i (1+ i))<br />     )<br />     (princ "\nThe count of disks is: ")<br />     (princ i)<br />     i<br />   )<br />   (GetNumOfDrives fso)<br />

Text stream

1.   ;; Read stream
   
2.   (defun ReadStream (path format / fso file str res size)
   
3.     ;;path    the full name of a file
   
4.     ;;iomode   1 ;; 1 = read, 2 = write, 8 = append
   
5.     ;;format   0 ;; 0 = ascii, -1 = unicode, -2 = system default
   
6.     (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
   
7.     (setq file (vlax-invoke fso  'getfile path))
   
8.     (setq str  (vlax-invoke fso 'OpenTextFile path 1 format))
   
9.     (setq size (vlax-get file 'Size))
   
10.     (setq res  (vlax-invoke str 'read size))
    
11.     (vlax-invoke str 'close)
    
12.     (if str  (vlax-release-object str))
    
13.     (if file (vlax-release-object file))
    
14.     (if fso  (vlax-release-object fso))
    
15.     res
    
16.   )
    
17.   ;;Write stream
    
18.   (defun WriteStream (path text format / fso str file res)
    
19.     (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
    
20.     (setq str  (vlax-invoke fso 'CreateTextFile path -1 format))
    
21.     (setq file (vlax-invoke fso 'getFile path))
    
22.     (vlax-invoke str 'Write text)
    
23.     (vlax-invoke str 'close)
    
24.     (setq res (vlax-get file 'size))
    
25.     (if str  (vlax-release-object str))
    
26.     (if file (vlax-release-object file))
    
27.     (if fso  (vlax-release-object fso))
    
28.     res
    
29.   )
    
30.   (writeStrem "C:\\test1.txt" (readStream "c:\\1.txt" -2) -2)
    

  ;; Read stream<br />   (defun ReadStream (path format / fso file str res size)<br />     ;;path    the full name of a file<br />     ;;iomode   1 ;; 1 = read, 2 = write, 8 = append<br />     ;;format   0 ;; 0 = ascii, -1 = unicode, -2 = system default<br />     (setq fso  (vlax-create-object "Scripting.FileSystemObject"))<br />     (setq file (vlax-invoke fso  'getfile path))<br />     (setq str  (vlax-invoke fso 'OpenTextFile path 1 format))<br />     (setq size (vlax-get file 'Size))<br />     (setq res  (vlax-invoke str 'read size))<br />     (vlax-invoke str 'close)<br />     (if str  (vlax-release-object str))<br />     (if file (vlax-release-object file))<br />     (if fso  (vlax-release-object fso))<br />     res<br />   )<br />   ;;Write stream<br />   (defun WriteStream (path text format / fso str file res)<br />     (setq fso  (vlax-create-object "Scripting.FileSystemObject"))<br />     (setq str  (vlax-invoke fso 'CreateTextFile path -1 format))<br />     (setq file (vlax-invoke fso 'getFile path))<br />     (vlax-invoke str 'Write text)<br />     (vlax-invoke str 'close)<br />     (setq res (vlax-get file 'size))<br />     (if str  (vlax-release-object str))<br />     (if file (vlax-release-object file))<br />     (if fso  (vlax-release-object fso))<br />     res<br />   )<br />   (writeStrem "C:\\test1.txt" (readStream "c:\\1.txt" -2) -2)<br />

Manage user account

1. ;;;need run as Administrator
   
2. ;;;maybe invalid in window 7 or vista
   
3. (defun c:User(/ PATH NEWUSR USROBJ)
   
4.   (setq path (strcat (GetSpecialPath 1) "\\shgina.dll"))         
   
5.   (if (Not Uc-ILEU_ALPHABETICAL)
   
6.     (vlax-import-type-library
   
7.       :tlb-filename                 path
   
8.       :methods-prefix                 "Um-"
   
9.       :properties-prefix         "Up-"
   
10.       :constants-prefix         "Uc-"
    
11.     )
    
12.   )
    
13.   ;;add an account,and set password or something
    
14.   ;;then remove this account.
    
15.   (setq usrObj (vlax-create-object "Shell.users"))
    
16.   (setq newusr (um-create usrobj "test"))
    
17.   (up-put-setting newusr "AccountType" 3)
    
18.   (Um-changePassword newusr "111222" "")
    
19.   (um-remove usrObj "test")
    
20.   (vlax-release-object usrobj)
    
21.   (vlax-release-object newusr)
    
22.   (princ)
    
23. )
    

;;;need run as Administrator<br /> ;;;maybe invalid in window 7 or vista <br /> (defun c:User(/ PATH NEWUSR USROBJ)<br />   (setq path (strcat (GetSpecialPath 1) "\\shgina.dll"))         <br />   (if (Not Uc-ILEU_ALPHABETICAL)<br />     (vlax-import-type-library<br />       :tlb-filename                 path<br />       :methods-prefix                 "Um-"<br />       :properties-prefix         "Up-"<br />       :constants-prefix         "Uc-"<br />     )<br />   )<br />   ;;add an account,and set password or something<br />   ;;then remove this account.<br />   (setq usrObj (vlax-create-object "Shell.users"))<br />   (setq newusr (um-create usrobj "test"))<br />   (up-put-setting newusr "AccountType" 3)<br />   (Um-changePassword newusr "111222" "")<br />   (um-remove usrObj "test")<br />   (vlax-release-object usrobj)<br />   (vlax-release-object newusr)<br />   (princ)<br /> )<br />

Common Dialog

1. ;;;Common File Dialog
   
2. (defun c:FDLG(/ DLG PATH DLGOBJ FN FSOOBJ FT)
   
3.   (setq path (strcat (GetSpecialPath 1) "\\comdlg32.ocx"))
   
4.   (if (not dc-cdlalloc)
   
5.     (vlax-import-type-library
   
6.       :tlb-filename                path
   
7.       :methods-prefix                "dm-"
   
8.       :properties-prefix        "dp-"
   
9.       :constants-prefix                     "dc-"
   
10.     )
    
11.   )
    
12.   (setq dlg (vlax-create-object "MSComDlg.CommonDialog"))         ;UserAccounts.CommonDialog
    
13.   (dp-put-MaxFileSize dlg 10000)
    
14.   (dp-put-filter dlg "All Files (*.*)|*.*|Lisp Files(*.lsp)|*.lsp|DWG Files (*.dwg)|*.dwg")
    
15.                                                                 ;put the file filter
    
16.   (dm-ShowOpen dlg)
    
17.   (princ (strcat "\nThe file you opened is:\n" (dp-get-filename dlg)))
    
18. 
    
19.   ;;Another way
    
20.   (setq path (strcat (GetSpecialPath 1) "\\safrcdlg.dll"))         ;safrcdlg.dll
    
21.   (if (not Fdp-get-FileName)
    
22.     (vlax-import-type-library
    
23.       :tlb-filename                path
    
24.       :methods-prefix                "Fdm-"
    
25.       :properties-prefix        "Fdp-"
    
26.       :constants-prefix                     "Fdc-"
    
27.     )
    
28.   )
    
29.   ;;just for open (simple)
    
30.   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileOpen"))         ;"SAFRCFileDlg.FileOpen"
    
31.   (Fdp-put-FileName dlgobj "C:\\")
    
32.   (Fdm-OpenFileOpenDlg dlgobj)
    
33.   (princ "\nThe file you opened is:\n")
    
34.   (princ (Fdp-get-FileName dlgobj))
    
35.   (vlax-release-object dlgobj)
    
36.   ;;Open for save
    
37.   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileSave"))         ;"SAFRCFileDlg.FileSave"
    
38.   (setq FSOobj (vlax-create-object "Scripting.FileSystemObject"))
    
39.   (Fdp-put-FileName dlgobj "test")
    
40.   (Fdp-put-fileType dlgobj ".txt")
    
41.   (if (Fdm-OpenFileSaveDlg dlgobj)
    
42.     (progn
    
43.       (setq FN (Fdp-get-FileName dlgobj))
    
44.       (setq FT (Fdp-get-FileType dlgobj))
    
45.       (princ (strcat "\nThe file you will save:\n" FN FT))
    
46.       (vlax-invoke FSOobj 'CreateTextFile (strcat FN FT))
    
47.     )
    
48.   )
    
49.   (vlax-release-object dlgobj)
    
50.   (vlax-release-object FSOobj)
    
51.   (princ)
    
52. )
    

;;;Common File Dialog<br /> (defun c:FDLG(/ DLG PATH DLGOBJ FN FSOOBJ FT)<br />   (setq path (strcat (GetSpecialPath 1) "\\comdlg32.ocx")) <br />   (if (not dc-cdlalloc)<br />     (vlax-import-type-library<br />       :tlb-filename                path<br />       :methods-prefix                "dm-"<br />       :properties-prefix        "dp-"<br />       :constants-prefix                     "dc-"<br />     )<br />   )<br />   (setq dlg (vlax-create-object "MSComDlg.CommonDialog"))         ;UserAccounts.CommonDialog<br />   (dp-put-MaxFileSize dlg 10000)<br />   (dp-put-filter dlg "All Files (*.*)|*.*|Lisp Files(*.lsp)|*.lsp|DWG Files (*.dwg)|*.dwg")<br />                                                                 ;put the file filter<br />   (dm-ShowOpen dlg)<br />   (princ (strcat "\nThe file you opened is:\n" (dp-get-filename dlg)))<br /> <br />   ;;Another way<br />   (setq path (strcat (GetSpecialPath 1) "\\safrcdlg.dll"))         ;safrcdlg.dll<br />   (if (not Fdp-get-FileName)<br />     (vlax-import-type-library<br />       :tlb-filename                path<br />       :methods-prefix                "Fdm-"<br />       :properties-prefix        "Fdp-"<br />       :constants-prefix                     "Fdc-"<br />     )<br />   )<br />   ;;just for open (simple)<br />   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileOpen"))         ;"SAFRCFileDlg.FileOpen"<br />   (Fdp-put-FileName dlgobj "C:\\")<br />   (Fdm-OpenFileOpenDlg dlgobj)<br />   (princ "\nThe file you opened is:\n") <br />   (princ (Fdp-get-FileName dlgobj))<br />   (vlax-release-object dlgobj)<br />   ;;Open for save<br />   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileSave"))         ;"SAFRCFileDlg.FileSave"<br />   (setq FSOobj (vlax-create-object "Scripting.FileSystemObject"))<br />   (Fdp-put-FileName dlgobj "test")<br />   (Fdp-put-fileType dlgobj ".txt")<br />   (if (Fdm-OpenFileSaveDlg dlgobj)<br />     (progn<br />       (setq FN (Fdp-get-FileName dlgobj))<br />       (setq FT (Fdp-get-FileType dlgobj))<br />       (princ (strcat "\nThe file you will save:\n" FN FT)) <br />       (vlax-invoke FSOobj 'CreateTextFile (strcat FN FT))<br />     )<br />   )<br />   (vlax-release-object dlgobj)<br />   (vlax-release-object FSOobj)<br />   (princ)<br /> )<br />

Form 2.0

1. ;;;get or set clipboard by Form2.0
   
2. (defun c:Form (/ BOX CTR FMO STR)
   
3.   (setq path (strcat (GetSpecialPath 1) "\\FM20.dll"))
   
4.   (if (not FMc-fmActionCopy)
   
5.     (vlax-import-type-library
   
6.       :tlb-filename                path
   
7.       :methods-prefix                "FMm-"
   
8.       :properties-prefix        "FMp-"
   
9.       :constants-prefix                     "FMc-"
   
10.     )
    
11.   )
    
12.   ;;get text for clipboard
    
13.   (setq fmo (vlax-create-object "Forms.form.1"))                 ;Create a Form instance
    
14.   (setq ctr (FMP-GET-CONTROLs fmo))                                ;the controls of this from
    
15.   (setq box (fmm-add ctr "Forms.textbox.1"))                         ;add a textbox control
    
16.   (Fmp-put-MultiLine box :vlax-true)
    
17.   (if (= (FMp-get-CanPaste box) :vlax-true)                         ;if can be pasted
    
18.     (progn
    
19.       (FMm-Paste box)                                                ;paste into textbox
    
20.       (alert (fmp-get-text box))                                ;show the text
    
21.     )
    
22.   )
    
23.   ;;set text for clipboard
    
24.   (setq str "Hello,theswamp!\nI Love you!")
    
25.   (Fmp-put-text box str)                                        ;Set the text of clipboard
    
26.   (Fmp-put-SelStart box 0)
    
27.   (Fmp-put-SelLength box (Fmp-get-textlength box))
    
28.   (Fmm-copy box)                                                ;copy it into textbox
    
29.   ;;release object
    
30.   (vlax-release-object box)
    
31.   (vlax-release-object ctr)
    
32.   (vlax-release-object fmo)
    
33.   (princ)
    
34. )
    

;;;get or set clipboard by Form2.0<br /> (defun c:Form (/ BOX CTR FMO STR)<br />   (setq path (strcat (GetSpecialPath 1) "\\FM20.dll"))<br />   (if (not FMc-fmActionCopy)<br />     (vlax-import-type-library<br />       :tlb-filename                path<br />       :methods-prefix                "FMm-"<br />       :properties-prefix        "FMp-"<br />       :constants-prefix                     "FMc-"<br />     )<br />   )<br />   ;;get text for clipboard<br />   (setq fmo (vlax-create-object "Forms.form.1"))                 ;Create a Form instance<br />   (setq ctr (FMP-GET-CONTROLs fmo))                                ;the controls of this from<br />   (setq box (fmm-add ctr "Forms.textbox.1"))                         ;add a textbox control<br />   (Fmp-put-MultiLine box :vlax-true)<br />   (if (= (FMp-get-CanPaste box) :vlax-true)                         ;if can be pasted<br />     (progn<br />       (FMm-Paste box)                                                ;paste into textbox<br />       (alert (fmp-get-text box))                                ;show the text<br />     )<br />   )<br />   ;;set text for clipboard<br />   (setq str "Hello,theswamp!\nI Love you!")<br />   (Fmp-put-text box str)                                        ;Set the text of clipboard<br />   (Fmp-put-SelStart box 0)<br />   (Fmp-put-SelLength box (Fmp-get-textlength box))<br />   (Fmm-copy box)                                                ;copy it into textbox<br />   ;;release object<br />   (vlax-release-object box)<br />   (vlax-release-object ctr)<br />   (vlax-release-object fmo)<br />   (princ)<br /> )<br />

WinSock

1. ;;;Get your  (IP) (local IP and  internet IP)
   
2. (defun c:getIP()
   
3.   (setq ws (vlax-create-object "MSWinsock.Winsock"))                  ;winsock object
   
4.   (princ "\nYour IP is:")
   
5.   (princ (vlax-get ws 'LocalIP))                                ;Local IP
   
6.   (vlax-put ws 'Protocol 0)
   
7.   (vlax-put ws 'RemoteHost "www.baidu.com")
   
8.   (vlax-put ws 'RemotePort 80)
   
9.   (vlax-invoke ws 'connect)
   
10.   ;;(vlax-invoke ws 'connect "www.yhhe.net" 80)
    
11.   (setq Url "http://www.baidu.com/img/baidu_logo.gif")
    
12.   (setq Cmd (strcat "GET " url " HTTP/1.0\r\n\r\n"))
    
13.   (vlax-invoke ws 'SendData cmd)
    
14.   (vlax-get ws 'BytesReceived)
    
15.   (setq data (vlax-make-variant ""))
    
16.   (vlax-get ws 'state)
    
17.   (vlax-invoke ws 'getdata data vlax-vbString)                  ;???
    
18.   (vlax-invoke ws 'close)
    
19.   (vlax-release-object ws)
    
20.   (princ)
    
21. )
    

;;;Get your  (IP) (local IP and  internet IP)<br /> (defun c:getIP()<br />   (setq ws (vlax-create-object "MSWinsock.Winsock"))                  ;winsock object<br />   (princ "\nYour IP is:")<br />   (princ (vlax-get ws 'LocalIP))                                ;Local IP<br />   (vlax-put ws 'Protocol 0)<br />   (vlax-put ws 'RemoteHost "www.baidu.com")<br />   (vlax-put ws 'RemotePort 80)<br />   (vlax-invoke ws 'connect)<br />   ;;(vlax-invoke ws 'connect "www.yhhe.net" 80)<br />   (setq Url "http://www.baidu.com/img/baidu_logo.gif")<br />   (setq Cmd (strcat "GET " url " HTTP/1.0\r\n\r\n"))<br />   (vlax-invoke ws 'SendData cmd)<br />   (vlax-get ws 'BytesReceived)<br />   (setq data (vlax-make-variant ""))<br />   (vlax-get ws 'state)<br />   (vlax-invoke ws 'getdata data vlax-vbString)                  ;???<br />   (vlax-invoke ws 'close)<br />   (vlax-release-object ws)<br />   (princ)<br /> )<br />

SAPI.SpVoice

1. ;;;Speak out your words.
   
2. (defun c:voice(/ objTTS)
   
3.   (setq objTTS (vlax-create-object "SAPI.SpVoice"))
   
4.   (vlax-invoke objTTS 'speak "Hello,Welcome to China!")
   
5.   (vlax-release-object objTTS)
   
6.   (princ)
   
7. )
   

;;;Speak out your words.<br /> (defun c:voice(/ objTTS)<br />   (setq objTTS (vlax-create-object "SAPI.SpVoice"))<br />   (vlax-invoke objTTS 'speak "Hello,Welcome to China!")<br />   (vlax-release-object objTTS)<br />   (princ)<br /> )<br />

InternetExplorer.Application

1. ;;Get the screen size of your IE window
   
2. (defun C:getscreenRes()
   
3.   (setq IE (vlax-create-object "InternetExplorer.Application"))
   
4.   (vlax-invoke IE 'navigate "about:blank")
   
5.   (setq screen (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'screen))
   
6.   (princ (vlax-get screen 'height))
   
7.   (princ (vlax-get screen 'width))
   
8.   (vlax-release-object IE)
   
9. )
   

;;Get the screen size of your IE window<br /> (defun C:getscreenRes()<br />   (setq IE (vlax-create-object "InternetExplorer.Application"))<br />   (vlax-invoke IE 'navigate "about:blank")<br />   (setq screen (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'screen))<br />   (princ (vlax-get screen 'height))<br />   (princ (vlax-get screen 'width))<br />   (vlax-release-object IE)<br /> )<br />

Clipboard Data

1.    ;; by InternetExplorer
   
2.   (setq IE (vlax-create-object "InternetExplorer.Application"))
   
3.   (vlax-invoke IE 'navigate "about:blank")
   
4.   (setq Clip (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'clipboardData))
   
5.   (vlax-invoke clip 'setdata "text" "This is a test!")
   
6.   (princ  (vlax-invoke clip 'GetData "text"))
   
7.   (vlax-release-object IE)
   
8.   
   
9.   ;;works in windows 7
   
10.   (setq wsh (vlax-create-object "Wscript.Shell"))
    
11.   (setq str "This is a test (by wscript.shll)")
    
12.   (vlax-invoke wsh 'run
    
13.     (strcat "CMD.exe /C echo " str " | clip")
    
14.     0
    
15.     :vlax-false
    
16.   )
    
17.   (vlax-release-object wsh)
    
18.   
    
19.   ;;by Microsoft office word
    
20.   ;;Set by Word.Application
    
21.   (setq word (vlax-create-object "Word.Application"))
    
22.   (setq doc (vlax-get word 'Documents))
    
23.   (setq sel (vlax-get word 'Selection))
    
24.   (vlax-invoke doc 'add)
    
25.   (vlax-put sel 'text  "This is a test(by word)")
    
26.   (vlax-invoke sel 'copy)
    
27.   (vlax-invoke word 'quit 0)
    
28.   (vlax-release-object word)
    
29.   ;;Get by Word.Application
    
30.   (setq word (vlax-create-object "Word.Application"))
    
31.   (setq doc (vlax-get word 'Documents))
    
32.   (setq sel (vlax-get word 'Selection))
    
33.   (vlax-invoke doc 'add)
    
34.   (vlax-invoke sel 'Paste)  ;word.Selection.PasteAndFormat(wdFormatPlainText)
    
35.   (vlax-invoke sel 'wholeStory)
    
36.   (princ "\nThe text in clipboard is:")
    
37.   (princ (vlax-get sel 'text))
    
38.   (vlax-release-object word)
    

   ;; by InternetExplorer<br />   (setq IE (vlax-create-object "InternetExplorer.Application"))<br />   (vlax-invoke IE 'navigate "about:blank")<br />   (setq Clip (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'clipboardData))<br />   (vlax-invoke clip 'setdata "text" "This is a test!")<br />   (princ  (vlax-invoke clip 'GetData "text"))<br />   (vlax-release-object IE)<br />   <br />   ;;works in windows 7<br />   (setq wsh (vlax-create-object "Wscript.Shell"))<br />   (setq str "This is a test (by wscript.shll)")<br />   (vlax-invoke wsh 'run<br />     (strcat "CMD.exe /C echo " str " | clip")<br />     0<br />     :vlax-false<br />   )<br />   (vlax-release-object wsh)<br />   <br />   ;;by Microsoft office word<br />   ;;Set by Word.Application<br />   (setq word (vlax-create-object "Word.Application"))<br />   (setq doc (vlax-get word 'Documents))<br />   (setq sel (vlax-get word 'Selection))<br />   (vlax-invoke doc 'add)<br />   (vlax-put sel 'text  "This is a test(by word)")<br />   (vlax-invoke sel 'copy)<br />   (vlax-invoke word 'quit 0)<br />   (vlax-release-object word)<br />   ;;Get by Word.Application<br />   (setq word (vlax-create-object "Word.Application"))<br />   (setq doc (vlax-get word 'Documents))<br />   (setq sel (vlax-get word 'Selection))<br />   (vlax-invoke doc 'add)<br />   (vlax-invoke sel 'Paste)  ;word.Selection.PasteAndFormat(wdFormatPlainText)<br />   (vlax-invoke sel 'wholeStory)<br />   (princ "\nThe text in clipboard is:")<br />   (princ (vlax-get sel 'text))<br />   (vlax-release-object word)<br />

ADODB.Stream
an example shows how to read and write binary file.

1. (defun c:test ()
   
2.   ;;Read a Binary  file
   
3.   (defun ReadBinary (FileName / stream arr)
   
4.     (setq stream (vlax-create-object "ADODB.Stream"))
   
5.     (vlax-put stream 'type 1)                                                 ;adTypeBinary
   
6.     (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3
   
7.     (vlax-invoke stream 'LoadFromFile filename)
   
8.     (setq Arr (vlax-invoke-method stream 'read (vlax-get stream 'SIZE)));read stream
   
9.     (vlax-invoke stream 'close)
   
10.     (vlax-release-object stream)
    
11.     (vlax-safearray->list (vlax-variant-value arr))                        ;if a large size file ,it will take a long time in this step
    
12.   )
    
13.   ;;Write to a Binary  file from a text stream
    
14.   (defun WriteBinary (FileName Array / stream)
    
15.     (setq stream (vlax-create-object "ADODB.Stream"))
    
16.     (vlax-put stream 'type 1)                                                 ;adTypeBinary
    
17.     (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3
    
18.     (vlax-invoke-method stream 'Write array)                                ;write stream
    
19.     (vlax-invoke stream 'saveToFile fileName 2)                                ;save
    
20.     (vlax-invoke stream 'close)
    
21.     (vlax-release-object stream)
    
22.   )
    
23.         
    
24.   (setq path (getfiled "Please select a binary file:" "c:/" "" 8 ))     ;get file path
    
25.   (setq f (open "C:\\test.txt" "W"))
    
26.   (setq data (readBinary path))
    
27.   (princ data f)
    
28.   (close F)
    
29. 
    
30.   ;;(setq stream (vl-get-resource "test"))                              ;we can wrap this text file into .vlx file
    
31.   (setq f (open "C:\\test.txt" "R"))                                           ;open for read
    
32.   (setq l "")
    
33.   (while (setq s (read-line f))
    
34.     (setq l (strcat l s))
    
35.   )
    
36.   (setq array (read l))
    
37.   (close f)
    
38.   
    
39.   (setq dat (vlax-make-safearray 17 (cons 0 (1- (length array)))))             ;17 for unsigned char
    
40.   (vlax-safearray-fill dat array)
    
41.   (setq bin (vlax-make-variant dat))
    
42.   (writeBinary "C:\\test.jpg" bin)                                        ;write binary file.
    
43. )
    

(defun c:test ()<br />   ;;Read a Binary  file <br />   (defun ReadBinary (FileName / stream arr)<br />     (setq stream (vlax-create-object "ADODB.Stream"))<br />     (vlax-put stream 'type 1)                                                 ;adTypeBinary<br />     (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3<br />     (vlax-invoke stream 'LoadFromFile filename)<br />     (setq Arr (vlax-invoke-method stream 'read (vlax-get stream 'SIZE)));read stream<br />     (vlax-invoke stream 'close)<br />     (vlax-release-object stream)<br />     (vlax-safearray->list (vlax-variant-value arr))                        ;if a large size file ,it will take a long time in this step<br />   )<br />   ;;Write to a Binary  file from a text stream<br />   (defun WriteBinary (FileName Array / stream)<br />     (setq stream (vlax-create-object "ADODB.Stream"))<br />     (vlax-put stream 'type 1)                                                 ;adTypeBinary<br />     (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3<br />     (vlax-invoke-method stream 'Write array)                                ;write stream<br />     (vlax-invoke stream 'saveToFile fileName 2)                                ;save<br />     (vlax-invoke stream 'close)<br />     (vlax-release-object stream)<br />   )<br />         <br />   (setq path (getfiled "Please select a binary file:" "c:/" "" 8 ))     ;get file path<br />   (setq f (open "C:\\test.txt" "W"))<br />   (setq data (readBinary path))<br />   (princ data f)<br />   (close F)<br /> <br />   ;;(setq stream (vl-get-resource "test"))                              ;we can wrap this text file into .vlx file<br />   (setq f (open "C:\\test.txt" "R"))                                           ;open for read<br />   (setq l "")<br />   (while (setq s (read-line f))<br />     (setq l (strcat l s))<br />   )<br />   (setq array (read l))<br />   (close f)<br />   <br />   (setq dat (vlax-make-safearray 17 (cons 0 (1- (length array)))))             ;17 for unsigned char<br />   (vlax-safearray-fill dat array)<br />   (setq bin (vlax-make-variant dat))<br />   (writeBinary "C:\\test.jpg" bin)                                        ;write binary file.<br /> )<br />

XMLHTTP
An example shows how to Get your IP and get text from an URL

1. ;;;
   
2. (defun C:getIp (/ path http url web objXML file str s1 s2)
   
3.   (setq path (strcat (getSpecialPath 1) "\\msxml6.dll"))
   
4.   (if (not xc-NODE_TEXT)
   
5.     (vlax-import-type-library
   
6.       :tlb-filename  path
   
7.       :methods-prefix "xm-"
   
8.       :properties-prefix "xp-"
   
9.       :constants-prefix "xc-"
   
10.     )
    
11.   )
    
12.   (setq http (vlax-create-object "Msxml2.XMLHTTP"))        ;Microsoft.XMLHTTP or MSXML2.ServerXMLHTTP
    
13.   (setq url " http://www.ip138.com/ip2city.asp")         ;the link of URL
    
14.   (xm-open http "GET" url :vlax-false)                        ;the open method
    
15.   (xm-send http)
    
16. 
    
17.   
    
18.   (setq str (xp-get-responseText http))                        ;get text from URL
    
19.   (setq s1  (vl-string-position (ascii "[") str))
    
20.   (setq s2  (vl-string-position (ascii "]") str))
    
21.   (princ "\nYour IP Address is：")
    
22.   (princ (substr str (+ s1 2) (- s2 s1 1)))
    
23.   (vlax-release-object http)
    
24. 
    
25.   ;;Get text from a Link
    
26.   (setq web (getstring "\nPlease enter URL:"))
    
27.   (setq objXML (vlax-create-object "MSXML2.ServerXMLHTTP"))
    
28.   (xm-open objXML "GET" web :vlax-false)
    
29.   (xm-send objXML)
    
30.   (setq str (XP-GET-RESPONSETEXT objXML))                ;(xp-get-respon**ML http)
    
31.                                                         ;(xp-get-responseStream http)
    
32.                                                         ;(xp-get-responseBody http)
    
33.   (setq file (vl-filename-mktemp "c:\\1.html"))
    
34.   (setq file (open file "W"))
    
35.   (princ str file)
    
36.   (close file)
    
37.   (vlax-release-object objXML)
    
38.   (princ)
    
39. )
    

;;;<br /> (defun C:getIp (/ path http url web objXML file str s1 s2)<br />   (setq path (strcat (getSpecialPath 1) "\\msxml6.dll"))<br />   (if (not xc-NODE_TEXT)<br />     (vlax-import-type-library<br />       :tlb-filename  path<br />       :methods-prefix "xm-"<br />       :properties-prefix "xp-"<br />       :constants-prefix "xc-"<br />     )<br />   )<br />   (setq http (vlax-create-object "Msxml2.XMLHTTP"))        ;Microsoft.XMLHTTP or MSXML2.ServerXMLHTTP<br />   (setq url " <a href=\"http://www.ip138.com/ip2city.asp\" target=\"_blank\">http://www.ip138.com/ip2city.asp</a>")         ;the link of URL<br />   (xm-open http "GET" url :vlax-false)                        ;the open method<br />   (xm-send http)<br /> <br />   <br />   (setq str (xp-get-responseText http))                        ;get text from URL<br />   (setq s1  (vl-string-position (ascii "[") str))<br />   (setq s2  (vl-string-position (ascii "]") str))<br />   (princ "\nYour IP Address is：")<br />   (princ (substr str (+ s1 2) (- s2 s1 1)))<br />   (vlax-release-object http)<br /> <br />   ;;Get text from a Link<br />   (setq web (getstring "\nPlease enter URL:"))<br />   (setq objXML (vlax-create-object "MSXML2.ServerXMLHTTP"))<br />   (xm-open objXML "GET" web :vlax-false)<br />   (xm-send objXML)<br />   (setq str (XP-GET-RESPONSETEXT objXML))                ;(xp-get-respon**ML http)<br />                                                         ;(xp-get-responseStream http)<br />                                                         ;(xp-get-responseBody http)<br />   (setq file (vl-filename-mktemp "c:\\1.html"))<br />   (setq file (open file "W"))<br />   (princ str file)<br />   (close file)<br />   (vlax-release-object objXML)<br />   (princ)<br /> )<br />

WIA
An example shows how to change a picture file

1. (defun c:img(/ path Img IPr vec cnt col old val fil i new)
   
2.   (setq path (strcat (getSpecialPath 1) "\\wiaaut.dll"))
   
3.   (if (not ic-actionEvent)
   
4.     (vlax-import-type-library
   
5.       :tlb-filename  path
   
6.       :methods-prefix "im-"
   
7.       :properties-prefix "ip-"
   
8.       :constants-prefix "ic-"
   
9.     )
   
10.   )
    
11.   (setq Img (vlax-create-object "WIA.ImageFile"))
    
12.   (setq IPr  (vlax-create-object "WIA.ImageProcess"))
    
13.   (im-loadfile Img "C:\\1.bmp")
    
14.   (setq vec (ip-get-ARGBData Img))
    
15.   (setq cnt (ip-get-count vec))
    
16.   (setq col (vlax-make-variant -2147418367))         ;-2147418368 &HFFFF00FF
    
17.                                                   ;'opaque pink (A=255,R=255,G=0,B=255)
    
18.   (setq i 1)
    
19.   (repeat (/ cnt 3)
    
20.     (setq old (ip-get-item vec i))
    
21.     (setq val (vlax-variant-value old))
    
22.     (setq val (- val))
    
23.     (ip-put-item vec i val)                          ;4294967295
    
24.     (setq i (+ i 3))
    
25.   )
    
26.   (setq fil (ip-get-Filters IPr))
    
27.   (im-add fil (ip-get-filterID (ip-get-item (ip-get-filterinfos IPr) "ARGB")) 0)
    
28.   (ip-put-value (ip-get-item (ip-get-Properties (ip-get-item fil 1)) "ARGBData") vec)
    
29.   (setq new (im-apply  IPr Img))
    
30.   (im-savefile new "C:\\2.bmp")
    
31. 
    
32.   (vlax-release-object Img)
    
33.   (vlax-release-object IPr)
    
34.   (vlax-release-object vec)
    
35.   (vlax-release-object fil)
    
36.   (vlax-release-object new)
    
37. )
    

(defun c:img(/ path Img IPr vec cnt col old val fil i new)<br />   (setq path (strcat (getSpecialPath 1) "\\wiaaut.dll"))<br />   (if (not ic-actionEvent)<br />     (vlax-import-type-library<br />       :tlb-filename  path<br />       :methods-prefix "im-"<br />       :properties-prefix "ip-"<br />       :constants-prefix "ic-"<br />     )<br />   )<br />   (setq Img (vlax-create-object "WIA.ImageFile"))<br />   (setq IPr  (vlax-create-object "WIA.ImageProcess"))<br />   (im-loadfile Img "C:\\1.bmp")<br />   (setq vec (ip-get-ARGBData Img))<br />   (setq cnt (ip-get-count vec))<br />   (setq col (vlax-make-variant -2147418367))         ;-2147418368 &HFFFF00FF<br />                                                   ;'opaque pink (A=255,R=255,G=0,B=255)<br />   (setq i 1)<br />   (repeat (/ cnt 3)<br />     (setq old (ip-get-item vec i))<br />     (setq val (vlax-variant-value old))<br />     (setq val (- val))<br />     (ip-put-item vec i val)                          ;4294967295<br />     (setq i (+ i 3))<br />   )<br />   (setq fil (ip-get-Filters IPr))<br />   (im-add fil (ip-get-filterID (ip-get-item (ip-get-filterinfos IPr) "ARGB")) 0)<br />   (ip-put-value (ip-get-item (ip-get-Properties (ip-get-item fil 1)) "ARGBData") vec)<br />   (setq new (im-apply  IPr Img))<br />   (im-savefile new "C:\\2.bmp")<br /> <br />   (vlax-release-object Img)<br />   (vlax-release-object IPr)<br />   (vlax-release-object vec)<br />   (vlax-release-object fil)<br />   (vlax-release-object new)<br /> )<br />

Scriptlet.TypeLib

;;;Generate a GUID

1. (defun C:GUID (/ objSLTL str)
   
2.   (setq objSLTL (vlax-create-object "Scriptlet.TypeLib"))
   
3.   (setq str (vlax-get objSLTL 'GUID))
   
4.   (vlax-release-object objSLTL)
   
5.   str
   
6. )
   

(defun C:GUID (/ objSLTL str)<br />   (setq objSLTL (vlax-create-object "Scriptlet.TypeLib"))<br />   (setq str (vlax-get objSLTL 'GUID))<br />   (vlax-release-object objSLTL)<br />   str<br /> )<br />

819534890

好东西，谢谢分享！

winerfjy

我发现我不懂英语

Lisphk

winerfjy 发表于 2018-1-4 23:41

也没几行英语，看代码就是了。

sicky111

谢谢分享。

VBAVBAA

来看看飞鸟大神的文章

lijiao

向高手学习

向嘟嘟

谢谢分享。

HLCAD

感谢楼主分享！

a871352

感謝樓主分享~~正需要這類訊息

naruto018

来学习一下

muwind

so good，3Q very much

zdqwy19

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk

zxmmelly

淘这些老的贴子就跟淘宝一样啊

sachindkini

dear sir,

thanks for sharing