（1）ActiveX 和脚本技术在CAD的运用(2013.05.17更新)

Highflybird

=========================================
2013.05.17更新
如果对帖子中的代码有疑问或者可能的抄录笔误，请下载下面附件：

请点击此处下载

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

您的用户组是：游客

文件名称:ActiveX and Script.lsp 
下载次数:207  文件大小:46.17 KB 
下载权限: 不限 以上  [免费赚D豆]

=========================================
首先申明，这篇帖子不建议初学者浏览。一则我不能一一回答不明白者的提问，二则避免初学者钻牛角尖。因此有很多地方并不给出完整的代码。
脚本有很多用处，在CAD中如果能灵活运用，也可以为图纸之外的事情发挥较大作用。譬如近来有很多帖子问及系统中有多少个磁盘，设备系列号，屏幕分辨率，等等。如果知道了这方面的知识，完全是可以几行代码就解决问题的。
关于脚本的更多请搜索。
AutoCAD作为一种具有高度开放结构的CAD平台软件，它提供了强大的二次开发环境。从AutoCAD R14版开始，AutoCAD引入了ActiveX Automation技术术。由于ActiveX技术是一种完全面向对象的技术，所以许多面向对象化编程的语言和应用程序，可以通过ActiveX与AutoCAD进行通信，并操纵AutoCAD的许多功能。
AutoCAD ActiveX技术提供了一种机制，该机制可使编程者通过编程手段从AutoCAD的内部或外部来操纵AutoCAD。ActiveX是由一系列的对象，按一定的层次组成的一种对象结构，每一个对象代表了AutoCAD中一个明确的功能，如绘制图形对象、定义块和属性等等。ActiveX所具备的绝大多数AutoCAD功能，均以方法和属性的方式被封装在ActiveX对象中，只要使用某种方式，使ActiveX对象得以“暴露”，那么就可以使用各种面向对象编程的语言对其中的方法、属性进行引用，从而达到对AutoCAD实现编程的目的。这两者我不再详细描述。
CAD中执行ActiveX函数的方法有两种，一种用vlax-import-type-library函数引入，另外一种用vlax-invoke,和vlax-get（或者vlax-invoke-methode,和vlax-get-property）;后一种比前一种更广，但前一种 它的优势在于 可以写更少的代码，更智能化，能利用Vlisp编辑器的自动完成功能获得更多的用法。但对于有的不能用vlax-import-type-library。本帖大多数用的是前者。
首先用了一个函数，为后面的程序做准备。
;;;获得系统工作路径
[pcode=lisp,true](defun GetSpecialPath (n / fso path)
  (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
  (setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))
  (vlax-release-object fso)
  path
)[/pcode]

脚本技术中有几个很重要的东西: WScipt.Shell对象，FileSystemObject对象，Shell.Application对象，WMI，以及
ScriptControl对象。这几个对象我不再介绍了。

脚本宿主对象
[pcode=lisp,true]setq path (strcat (GetSpecialPath 1) "/wshom.ocx")) ;;
(if (not wc-Alias)
  (vlax-import-type-library
    :tlb-filename   path
    :methods-prefix   "wm-"
    :properties-prefix  "wp-"
    :constants-prefix  "wc-"
  )
)
(setq wsh (vlax-create-object "WScript.shell"))[/pcode]

脚本本身
[pcode=lisp,true](setq path (strcat (GetSpecialPath 1) "/msscript.ocx"))
(if (not sc-Connected)
  (vlax-import-type-library
    :tlb-filename   path
    :methods-prefix   "sm-"
    :properties-prefix  "sp-"
    :constants-prefix  "sc-"
  )
)
(setq scr (vlax-create-object "ScriptControl"))
[/pcode]
文件系统对象
[pcode=lisp,true](setq path (strcat (getSpecialPath 1) "/scrrun.dll"))
(if (not fc-Alias)
  (vlax-import-type-library
    :tlb-filename   path
    :methods-prefix   "fm-"
    :properties-prefix  "fp-"
    :constants-prefix  "fc-"
  )
)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
[/pcode]
Shell对象
[pcode=lisp,true](setq path (strcat (getSpecialPath 1) "/shell32.dll"))
(if (not ac-ssfwindows)
  (vlax-import-type-library
    :tlb-filename  path
    :methods-prefix "am-"
    :properties-prefix "ap-"
    :constants-prefix "ac-"
  )
)
(setq sha (vlax-create-object "shell.application"))
[/pcode]
下面我一一介绍它们的用法。

1.WSH对象，ScriptControl对象和WMI

  ;;简单的欢迎
  [pcode=lisp,true] (wm-Popup wsh "Hello,World!")[/pcode]  

  ;;输入框

1.   (vlax-invoke scr 'ExecuteStatement "str=InputBox(\"输入您的名字:\", \"输入框\")")
   
2.   (sm-ExecuteStatement scr "str=InputBox(\"输入您的名字:\", \"输入框\")")

  (vlax-invoke scr 'ExecuteStatement "str=InputBox(\"输入您的名字:\", \"输入框\")")<br />   (sm-ExecuteStatement scr "str=InputBox(\"输入您的名字:\", \"输入框\")")

  ;;求值

1.   (vlax-invoke scr 'eval "str")
   
2.   (sm-eval scr "str")

  (vlax-invoke scr 'eval "str")<br />   (sm-eval scr "str")

  ;;利用wscript发送键

1.   (wm-sendkeys wsh "C{ENTER}0,0{ENTER}100{ENTER}")   ;在CAD命令状态下画一个圆
   
2.   (WM-SENDKEYS wsh "赌")                    ;很神奇的，居然是打开我的电脑
   
3.   (WM-SENDKEYS wsh "品")    ;打开计算器
   
4.   (WM-SENDKEYS wsh "血")    ;打开搜索
   
5.   (WM-SENDKEYS wsh "恋")     ;打开媒体播放器
   
6.   (WM-SENDKEYS wsh "爽")     ;打开主页

  (wm-sendkeys wsh "C{ENTER}0,0{ENTER}100{ENTER}")   ;在CAD命令状态下画一个圆<br />   (WM-SENDKEYS wsh "赌")                    ;很神奇的，居然是打开我的电脑<br />   (WM-SENDKEYS wsh "品")    ;打开计算器<br />   (WM-SENDKEYS wsh "血")    ;打开搜索<br />   (WM-SENDKEYS wsh "恋")     ;打开媒体播放器<br />   (WM-SENDKEYS wsh "爽")     ;打开主页

  ;;创建一个URL的快捷方式

1.   (setq Spec (wp-get-SpecialFolders wsh))
   
2.   (setq deskTopPath (wm-item spec "DeskTop"))
   
3.   (setq url (wm-CreateShortcut wsh (strcat deskTopPath "/MyTest.URL")))
   
4.   (wp-put-TargetPath url "http://bbs.xdcad.com")
   
5.   (wm-save url)

  (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://bbs.xdcad.com")<br />   (wm-save url)

  ;;创建一个快捷方式并指定快捷键

1.   (setq link (wm-CreateShortcut wsh (strcat DeskTopPath "/测试快捷方式.lnk")))
   
2.   (wp-put-TargetPath link "http://bbs.xdcad.com")
   
3.   (wp-put-WindowStyle link 1)
   
4.   (wp-put-Hotkey link "Ctrl+Alt+e")
   
5.   (wp-put-IconLocation link "shell32.dll,14")
   
6.   (wp-put-Description link "测试快捷方式的描述")
   
7.   (wp-put-WorkingDirectory link "c:/")
   
8.   (wm-save link)

  (setq link (wm-CreateShortcut wsh (strcat DeskTopPath "/测试快捷方式.lnk")))<br />   (wp-put-TargetPath link "http://bbs.xdcad.com")<br />   (wp-put-WindowStyle link 1)<br />   (wp-put-Hotkey link "Ctrl+Alt+e")<br />   (wp-put-IconLocation link "shell32.dll,14")<br />   (wp-put-Description link "测试快捷方式的描述")<br />   (wp-put-WorkingDirectory link "c:/")<br />   (wm-save link)

;;运行命令
  

1. (wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")

(wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")

  ;;获得系统环境变量
  

1. (Setq env (wp-get-Environment wsh "System"))

(Setq env (wp-get-Environment wsh "System"))

  ;;系统目录

1.   (alert (wp-get-item env "WINDIR"))
   
2.   (alert (wm-ExpandEnvironmentStrings wsh "%windir%"))
   
3.   (alert (wp-get-Item env "TMP"))
   
4.   (alert (wp-get-Item env "TEMP"))

  (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"))

  ;;增加和移除环境变量

1.   (alert "Add a test var to the system!")
   
2.   (wp-put-item env "TestVar" "Windows Script Host")
   
3.   (alert "Remove the test var from the system!")
   
4.   (wm-remove env "TestVar")

  (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")

  ;;列出某个环境变量的全部

1.   (setq i 0)
   
2.   (repeat (wm-count env)
   
3.     (princ (wp-get-item env i))    ;但是不会显现出来在vbs中运行正常
   
4.     (setq i (1+ i))
   
5.   )

  (setq i 0)<br />   (repeat (wm-count env)<br />     (princ (wp-get-item env i))    ;但是不会显现出来在vbs中运行正常<br />     (setq i (1+ i))<br />   )

  ;;以下相同

1.    (setq str
   
2.   "Set WshShell = CreateObject(\"WScript.Shell\")
   
3.   Msgbox \"Environment.item: \"& WshShell.Environment.item(\"WINDIR\")
   
4.   Msgbox \"ExpandEnvironmentStrings: \"& WshShell.ExpandEnvironmentStrings(\"%windir%\")
   
5.   set oEnv=WshShell.Environment(\"System\")
   
6. 
   
7.   Msgbox \"Adding ( TestVar=Windows Script Host ) to the System type environment\"
   
8.          oEnv(\"TestVar\") = \"Windows Script Host\"
   
9.          Msgbox \"removing ( TestVar=Windows Script Host ) from the System type environment\"
   
10.          oEnv.Remove \"TestVar\"
    
11.   for each sitem in oEnv
    
12.   strval=strval & sItem & vbcrlf
    
13.   next
    
14.   Msgbox \"System Environment:\" & vbcrlf & vbcrlf & strval
    
15.   strval=\"\"'
    
16. 
    
17.   set oEnv=WshShell.Environment(\"Process\")
    
18.   for each sitem in oEnv
    
19.   strval=strval & sItem & vbcrlf
    
20.   next
    
21.   Msgbox \"Process Environment:\" & vbcrlf & vbcrlf & strval
    
22.   strval=\"\"
    
23.   set oEnv=WshShell.Environment(\"User\")
    
24.   for each sitem in oEnv
    
25.   strval=strval & sItem & vbcrlf
    
26.   next
    
27.   Msgbox \"User Environment:\" & vbcrlf & vbcrlf & strval
    
28.   strval=\"\"
    
29.   set oEnv=WshShell.Environment(\"Volatile\")
    
30.   for each sitem in oEnv
    
31.   strval=strval & sItem & vbcrlf
    
32.   next
    
33.   Msgbox \"Volatile Environment:\" & vbcrlf & vbcrlf & strval
    
34.   strval=\"\"
    
35.   set oEnv = nothing
    
36.   set WshShell = nothing
    
37.   "
    
38.   )
    
39.   (vlax-invoke Scr 'ExecuteStatement str)

   (setq str<br />   "Set WshShell = CreateObject(\"WScript.Shell\")<br />   Msgbox \"Environment.item: \"& WshShell.Environment.item(\"WINDIR\")<br />   Msgbox \"ExpandEnvironmentStrings: \"& WshShell.ExpandEnvironmentStrings(\"%windir%\")<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 />          Msgbox \"removing ( TestVar=Windows Script Host ) from the System type environment\"<br />          oEnv.Remove \"TestVar\"<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 />   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 />   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 />   set oEnv = nothing<br />   set WshShell = nothing<br />   "<br />   )<br />   (vlax-invoke Scr 'ExecuteStatement str)

;;读写注册表 regread ,regwrite,regdelete

1. (vlax-invoke wsh 'RegRead "HKCU\\Software\\AutoDesk\\AutoCAD\\R16.2\\curver")  ;确保你装的是autocad 2006否则出错

(vlax-invoke wsh 'RegRead "HKCU\\Software\\AutoDesk\\AutoCAD\\R16.2\\curver")  ;确保你装的是autocad 2006否则出错

  ;;系统信息篇
  ;;（如获取机器的物理地址）

1.   (setq str "Set mc=GetObject(\"Winmgmts:\")")
   
2.   (SM-EXECUTESTATEMENT scr str)
   
3.   (setq objWMI (vla-eval scr "mc"))
   
4.   (setq objNet (vlax-invoke objWMI 'InstancesOF "Win32_NetworkAdapterConfiguration"))
   
5.   (princ "\n物理地址是:")
   
6.   (vlax-for obj objNet
   
7.     (if(/= (vlax-get obj 'IPEnabled) 0)
   
8.       (princ (vlax-get obj 'MacAddress))
   
9.     )
   
10.   )

  (setq str "Set mc=GetObject(\"Winmgmts:\")")<br />   (SM-EXECUTESTATEMENT scr str)<br />   (setq objWMI (vla-eval scr "mc"))<br />   (setq objNet (vlax-invoke objWMI 'InstancesOF "Win32_NetworkAdapterConfiguration"))<br />   (princ "\n物理地址是:")<br />   (vlax-for obj objNet<br />     (if(/= (vlax-get obj 'IPEnabled) 0)<br />       (princ (vlax-get obj 'MacAddress))<br />     )<br />   )

;;也可以按照如下方式获得详细信息
  

1. (foreach p (list
   
2.         "Win32_ComputerSystem"
   
3.         "Win32_Service"
   
4.         "Win32_LogicalMemoryConfiguration"
   
5.         "Win32_Process"
   
6.         "Win32_Processor"
   
7.         "Win32_OperatingSystem"
   
8.         "Win32_WMISetting"
   
9.         "__NAMESPACE"
   
10.         "win32_baseboard"
    
11.         "win32_videocontroller"
    
12.         "win32_DiskDrive"
    
13.         "win32_physicalMemory"
    
14.         "Win32_Environment"
    
15.         "Win32_ProcessStartTrace"
    
16.         "Win32_PnpDevice"
    
17.         "Win32_SoundDevice"
    
18.         "Win32_ProductCheck"
    
19.         "Win32_NetworkAdapter"
    
20.         "Win32_CDROMDrive"
    
21.         "Win32_DesktopMonitor"
    
22.         "Win32_NetworkAdapterConfiguration"
    
23.         ;;"Win32_NTLogEvent"  ;太多了
    
24.       )
    
25.     (setq objSYS (vlax-invoke objWMI 'InstancesOf p))
    
26.     (vlax-for n objSYS
    
27.       (alert (vlax-invoke n 'GetObjectText_))  
    
28.     )
    
29.   )
    

(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 />         ;;"Win32_NTLogEvent"  ;太多了<br />       )<br />     (setq objSYS (vlax-invoke objWMI 'InstancesOf p))<br />     (vlax-for n objSYS<br />       (alert (vlax-invoke n 'GetObjectText_))  <br />     )<br />   )<br />

  ;;以下相同只不过只是收集简单的信息

1.   (setq WMI (vla-eval scr "mc"))

  (setq WMI (vla-eval scr "mc"))

  ;;收集计算机用户信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n用户名是:")
   
4.     (princ (vlax-get n 'name))
   
5.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n用户名是:")<br />     (princ (vlax-get n 'name))<br />   )

;;获取进程

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Process" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ (vlax-get n 'name))
   
4.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Process" "WQL" 48))<br />   (vlax-for n Col<br />     (princ (vlax-get n 'name))<br />   )

;;获取CPU信息

1.    (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Processor" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ (vlax-get n 'name))
   
4.   )

   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Processor" "WQL" 48))<br />   (vlax-for n Col<br />     (princ (vlax-get n 'name))<br />   )

;;获取内存总容量

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ (/ (read (vlax-get n 'TotalPhysicalMemory)) 1048576))
   
4.     (princ "M")
   
5.   )

  (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 />   )

;;获取内存外频和数量信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_PhysicalMemory" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n")
   
4.     (princ (vlax-get n 'Description))
   
5.     (princ "\n")
   
6.     (princ (vlax-get n 'DeviceLocator))
   
7.     (princ "\n")
   
8.     (princ (vlax-get n 'speed))
   
9.   )

  (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 />   )

;;获取显卡信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_VideoController" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n")
   
4.     (princ (vlax-get n 'Caption))
   
5.     (princ "\n")
   
6.     (princ (vlax-get n 'VideoModeDescription))
   
7.   )

  (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 />   )

;;获取硬盘基本信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_DiskDrive" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n硬盘的设备编号是:")
   
4.     (princ (vlax-get n 'Caption))
   
5.     (princ "\n这个硬盘的容量是:")
   
6.     (princ (/ (read (vlax-get n 'size)) 1073741824))
   
7.     (princ "G")
   
8.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_DiskDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n硬盘的设备编号是:")<br />     (princ (vlax-get n 'Caption))<br />     (princ "\n这个硬盘的容量是:")<br />     (princ (/ (read (vlax-get n 'size)) 1073741824))<br />     (princ "G")<br />   )

;;获取声卡信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_SoundDevice" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n声卡的信息是:")
   
4.     (princ (vlax-get n 'ProductName))
   
5.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_SoundDevice" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n声卡的信息是:")<br />     (princ (vlax-get n 'ProductName))<br />   )

;;获取网卡信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_NetworkAdapter" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n网卡的设备描述是:")
   
4.     (princ (vlax-get n 'Description))
   
5.     (princ "\n网卡的信MAC地址是:")
   
6.     (princ (vlax-get n 'MACAddress))
   
7.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_NetworkAdapter" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n网卡的设备描述是:")<br />     (princ (vlax-get n 'Description))<br />     (princ "\n网卡的信MAC地址是:")<br />     (princ (vlax-get n 'MACAddress))<br />   )

  ;;获取软驱信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_FloppyDrive" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n软驱的信息是:")
   
4.     (princ (vlax-get n 'Caption))
   
5.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_FloppyDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n软驱的信息是:")<br />     (princ (vlax-get n 'Caption))<br />   )

;;获取CD/DVD ROM信息

1.   (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_CDROMDrive" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n光驱的信息是:")
   
4.     (princ (vlax-get n 'Name))
   
5.     (princ "\n光驱的信息是:")
   
6.     (princ (vlax-get n 'Description))   
   
7.   )

  (setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_CDROMDrive" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n光驱的信息是:")<br />     (princ (vlax-get n 'Name))<br />     (princ "\n光驱的信息是:")<br />     (princ (vlax-get n 'Description))    <br />   )

  ;;获取屏幕分辨率

1.   (setq CoL (vlax-invoke WMI 'ExecQuery "Select * from Win32_DesktopMonitor" "WQL" 48))
   
2.   (vlax-for n Col
   
3.     (princ "\n屏幕横向分辨率为:")
   
4.     (princ (vlax-get n 'ScreenWidth))
   
5.     (princ "\n屏幕竖向分辨率为:")
   
6.     (princ (vlax-get n 'ScreenHeight))
   
7.   )

  (setq CoL (vlax-invoke WMI 'ExecQuery "Select * from Win32_DesktopMonitor" "WQL" 48))<br />   (vlax-for n Col<br />     (princ "\n屏幕横向分辨率为:")<br />     (princ (vlax-get n 'ScreenWidth))<br />     (princ "\n屏幕竖向分辨率为:")<br />     (princ (vlax-get n 'ScreenHeight))<br />   )

小提醒：如果用vlax-Create-object方法创建了一个对象，别忘记用vlax-release-object释放它。

SmartStar

老大，不睡觉吗？

crazylsp

老大兴趣来了不睡觉{:soso_e113:}

sachindkini

dear sir,

nice
thx for sharing

Highflybird

Shell.Application篇
;;;windows shell
[pcode=lisp,true]
  (setq path (strcat (getSpecialPath 1) "/shell32.dll"))
  (if (not ac-ssfwindows)
    (vlax-import-type-library
      :tlb-filename  path
      :methods-prefix "am-"
      :properties-prefix "ap-"
      :constants-prefix "ac-"
    )
  )
  (setq shapp (vlax-create-object "shell.application"))
[/pcode]
以下种种用法：
;层叠窗口
[pcode=lisp,true] (am-CascadeWindows shapp)[/pcode]
;打开控制面板(internet)
[pcode=lisp,true] (am-ControlPanelItem shapp "inetcpl.cpl" )[/pcode]           
;打开时间和日期设置对话框
[pcode=lisp,true](am-settime shapp)  [/pcode]   
;日期和时间 属性
[pcode=lisp,true] (am-TrayProperties shapp)[/pcode]   
;打开 C 盘
[pcode=lisp,true]  (am-explore shapp "c:\\")[/pcode]                                 
;搜索计算机
[pcode=lisp,true]  (am-FindComputer shapp)[/pcode]   
;搜索打印机
[pcode=lisp,true] (am-findPrinter shapp "canno")[/pcode]                          
;处理器速度:运行windows 7 和vista
[pcode=lisp,true](am-GetSystemInformation shapp "ProcessorSpeed")[/pcode]            
;物理内存容量
[pcode=lisp,true](am-GetSystemInformation shapp "PhysicalMemoryInstalled")[/pcode]   


;是否是专业版
[pcode=lisp,true] (am-GetSystemInformation shapp "IsOS_Professional")[/pcode]        
;打开运行窗口
[pcode=lisp,true] (am-filerun shapp)[/pcode]                                          
;关机对话框
[pcode=lisp,true](am-ShutdownWindows shapp)[/pcode]                                 
;搜索文件
[pcode=lisp,true](am-findfiles shapp)[/pcode]
;显示桌面
[pcode=lisp,true](am-toggledesktop shapp)[/pcode]
;检测某项服务(打印机)是否在运行
[pcode=lisp,true](am-IsServiceRunning shapp "Spooler") [/pcode]
;Windows安全
[pcode=lisp,true](am-WindowsSecurity shapp)[/pcode]
;添加到最近打开文档
[pcode=lisp,true](am-AddToRecent shapp "c:\\1.txt")[/pcode]
;返回所打开的Folder对象
[pcode=lisp,true](am-namespace shapp "c:\\") [/pcode]
;选择文件夹对话框
[pcode=lisp,true](am-BrowseForFolder shapp
    (vla-get-hwnd (vlax-get-acad-object) )
    "Select a folder"
    64
  )[/pcode]     
;打开文件浏览对话框，并获得文件夹对象
[pcode=lisp,true](am-BrowseForFolder shapp 0 "我的电脑" 16 17)  [/pcode]
;打开某个目录
[pcode=lisp,true](am-open shapp "c:\\")[/pcode]

;;获得图像的详细信息，包括分辨率等等


[pcode=lisp,true]
(defun GetInfoOfPic(shapp path name / info root file i l)
    (setq root (am-namespace shapp path))
    (setq file (am-ParseName root name))
    (setq i 0)
    (repeat 256
      (setq info (am-GetDetailsOf root file i))
      (if (/= info "")
(progn
          (princ (strcat "\nIndex " (itoa i) ": " info))
   (setq l (cons info l))
)
      )
      (setq i (1+ i))
    )
    (reverse l)
  )
  (getInfoOfPic shapp "D:\\" "1.jpg")
[/pcode]  
;;下面是一个小小的程序，用来获得某个目录下的文件夹和文

件名
  [pcode=lisp,true](defun BrowseFolder(shapp fp / root items

count i item path name)
    (setq root (am-namespace shapp fp))
    (setq items (am-items root))
    (setq count (ap-get-Count items))
    (setq i 0)
    (repeat count
      (setq item (am-item items i))
      (setq path (ap-get-path item))
      (setq name (ap-get-name item))
      (if (= (ap-get-IsFolder item) :vlax-true)   ;zip 也是folder??呵呵
(progn
   (princ (strcat "\n---Folder:" path))
   (BrowseFolder shapp path)
)
(princ (strcat "\nFile name:" name))
      )
      (setq i (1+ i))
    )
  )
  (BrowseFolder shapp "C:\\Program Files\\AutoCAD 2006")
[/pcode]  
;;创建一个新的文件夹(移动MoveHere，拷贝copyhere，等)
[pcode=lisp,true] (setq root (am-namespace shapp "d:\\"))
  (am-NewFolder root "Test")
  (setq file (am-ParseName root "1.jpg"))
  (am-copyhere (am-namespace shapp "c:\\") file 16)
  (am-movehere (am-namespace shapp "c:\\") file 0)
[/pcode]  
;;得到某些特殊文件夹
[pcode=lisp,true] (am-NameSpace shapp "shell:PrintersFolder")
  (am-NameSpace shapp "shell:personal")
  (am-NameSpace shapp "shell:drivefolder")
  ;;(am-ShowBrowserBar shapp "{C4EE31F3-4768-11D2-BE5C-00A0C9A83DA1}" :vlax-

true);;???
[/pcode]                              
;;执行跟一个文件或者文件夹相关联的
[pcode=lisp,true]  (am-doit (am-item (am-verbs (ap-get-self root)) 0))
  (am-doit (am-item (am-verbs file) 0))
[/pcode]  
;;调出控制面版选项
[pcode=lisp,true]  (am-ShellExecute shapp "Explorer.exe" "::{20D04FE0-3AEA-

1069-A2D8-08002B30309D}")  ;//打开我的电脑
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,Control_RunDLL sysdm.cpl,,2" )
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,Control_RunDLL netcpl.cpl,,1")
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,SHCreateLocalServerRunDll

{601ac3dc-786a-4eb0-bf40-ee3521e70bfb}");
  (am-ShellExecute shapp "Rundll32.exe" "shdocvw.dll,OpenURL")   ;//Internet 快捷方式

要IE8,IE7?
  (am-ShellExecute shapp "Rundll32.exe" "msconf.dll,OpenConfLink")  ;//SpeedDial
  (am-ShellExecute shapp "Rundll32.exe" "zipfldr.dll,RouteTheCall")  ;//压缩文件夹

shdocvw.dll,OpenURL
  (am-ShellExecute shapp "Rundll32.exe" "netplwiz.dll,UsersRunDll")  ;//用户帐户
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,Options_RunDLL 0")  ;//文件夹选

项
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,Options_RunDLL 1")  ;//显示任务

栏和开始菜单
  (am-ShellExecute shapp "Rundll32.exe" "shell32.dll,Control_RunDLLAsUser")     ;//控

制面版  
[/pcode]  
;;执行程序
[pcode=lisp,true]  (am-ShellExecute shapp "cmd.exe")
  (setq root (am-namespace shapp "c:\\windows\\system32"))
  (setq exec (am-parsename root "CMD.exe"))
  (am-invokeverb exec)
[/pcode]
;;收藏夹
[pcode=lisp,true]  (setq mark (vlax-create-object "Shell.UIHelper.1"))
  (vlax-invoke mark 'AddChannel "http://bbs.xdcad.com/")
  (vlax-invoke mark 'AddFavorite "http://bbs.xdcad.com/" "XDCAD")
  (vlax-invoke mark 'AddDesktopComponent "d:\\1.jpg" "image")
[/pcode]
;;下面用来获取某些特殊目录下的文件信息
[pcode=lisp,true]  (defun GetInfo(shapp folds / objs i obj name lst prop)
    (setq objs (am-items (am-namespace shapp folds)))  ;这些常量可以智能查取
    (setq i 0)
    (repeat (ap-get-count objs)
      (setq obj  (am-item objs i))
      (setq name (ap-get-name obj))
      (setq prop (am-ExtendedProperty obj "type"))
      (setq lst  (cons (cons name prop) lst))
      (setq i (1+ i))
    )
    (reverse lst)
  )
[/pcode]  
;;例子
  [pcode=lisp,true](getInfo shapp ac-ssffonts)    ;获取系统中安

装的字体
  (getInfo shapp ac-ssfCONTROLS)    ;获取有哪些控制面板
  (getInfo shapp ac-ssfMYPICTURES)             ;获取我的图片
  (getInfo shapp ac-ssfDRIVES)                 ;获取系统的磁盘信息
  (getInfo shapp ac-ssfnetwork)                ;网络
  (getInfo shapp ac-ssfsystem)    ;系统文件夹信息
  (getInfo shapp ac-ssfnetwork)               ;获得网上邻居
  (getInfo shapp ac-ssfRecent)                ;获得最近打开
  ;;下面用来获得你浏览器(Explore)打开的窗口
  (defun GetWindows(shapp / i l lst obj winobj)
    (vlax-invoke shapp 'windows)
    (vlax-get (vlax-invoke shapp 'windows) 'count)
    (setq winobj (vlax-invoke shapp 'windows))
    (setq i 0)
    (repeat (vlax-get winobj 'count)
      (setq obj (vlax-invoke winobj 'item i))
      (setq lst (list
    (vlax-get obj 'toolbar)
    (vlax-get obj 'StatusText)
    (vlax-get obj 'FullName)
    (vlax-get obj 'LocationURL)
    (vlax-get obj 'Path)
  )
      )
      (setq l (cons lst l))     
      (setq i (1+ i))
    )
    (reverse l)
  )
  (GetWindows shapp)
[/pcode]  
;;清空指针
[pcode=lisp,true]  (vlax-release-object mark)
  (vlax-release-object root)
  (vlax-release-object file)
  (vlax-release-object exec)
  (vlax-release-object shapp)
  (princ)
[/pcode]

Highflybird

FSO对象
;;;filesystemObject
[pcode=lisp,true](defun C:FSO(/ FSO PATH)
  (setq path (strcat (getSpecialPath 1) "/scrrun.dll"))   scrrun.dll
  (if (not fc-Alias)
    (vlax-import-type-library
      :tlb-filename                 path
      :methods-prefix                 "fm-"
      :properties-prefix         "fp-"
      :constants-prefix         "fc-"
    )
  )
  (setq fso (vlax-create-object "Scripting.FileSystemObject"))
[/pcode]  
  ;;显示目录下所有的目录
[pcode=lisp,true]  (defun showSubFolder (folder)
    (vlax-for  subfolder  (fp-get-SubFolders folder)
      (princ (strcat "\n" (fp-get-Path subfolder)))
      (ShowSubFolder subFolder)
    )
  )
[/pcode]  ;;获取某个目录下所有的文件夹
[pcode=lisp,true]  (defun GetSubFolder (fso path / l)
    (defun GetSubFolder1 (folder / p)
      (vlax-for  subfolder (fp-get-SubFolders folder)
        (setq p (fp-get-Path subfolder))
        (setq l (cons p (GetSubFolder subFolder)))
      )
      l
    )
    (if (fm-folderExists fso path)
      (reverse (getSunFolder1 (fm-getFolder fso path)))
    )        
  )

  (showSubFolder (fm-GetFolder fso "C:\\Program Files"))
  (getSubFolder (fm-GetFolder fso "C:\\Program Files"))
[/pcode]  
;;获取磁盘个数和详细情况
[pcode=lisp,true]  (defun GetNumOfDrives(fso / drives i)
    (setq drives (vlax-get fso 'drives))
    (setq i 0)
    (vlax-for drive drives
      (vlax-dump-object drive)
      (setq i (1+ i))
    )
    (princ "\n共有磁盘个数:")
    (princ i)
    i
  )
  (GetNumOfDrives fso)
[/pcode]
  ;;读取文本流
[pcode=lisp,true]  (defun ReadStream (path format / fso file str res size)
    ;;path    the full name of a file
    ;;iomode   1 ;; 1 = read, 2 = write, 8 = append
    ;;format   0 ;; 0 = ascii, -1 = unicode, -2 = system default
    (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
    (setq file (vlax-invoke fso  'getfile path))
    (setq str  (vlax-invoke fso 'OpenTextFile path 1 format))
    (setq size (vlax-get file 'Size))
    (setq res  (vlax-invoke str 'read size))
    (vlax-invoke str 'close)
    (if str  (vlax-release-object str))
    (if file (vlax-release-object file))
    (if fso  (vlax-release-object fso))
    res
  )
[/pcode]  ;;写文本流
[pcode=lisp,true]  (defun WriteStrem (path text format / fso str file res)
    (setq fso  (vlax-create-object "Scripting.FileSystemObject"))
    (setq str  (vlax-invoke fso 'CreateTextFile path -1 format))
    (setq file (vlax-invoke fso 'getFile path))
    (vlax-invoke str 'Write text)
    (vlax-invoke str 'close)
    (setq res (vlax-get file 'size))
    (if str  (vlax-release-object str))
    (if file (vlax-release-object file))
    (if fso  (vlax-release-object fso))
    res
  )
  (writeStrem "C:\\test1.txt" (readStream "c:\\1.txt" -2) -2)

  ;;RubbishCleaner
  ;;详见我的帖子《CAD垃圾文件删除工具》
)
[/pcode]

Highflybird

接下来是其他的ActiveX 的用法:
通用文件对话框对象

1. ;;;通用文件对话框
   
2. ;;;用来替代CAD的getfiled对话框，用以获得更多功能
   
3. (defun c:FDLG(/ DLG PATH DLGOBJ FN FSOOBJ FT)
   
4.   (setq path (strcat (GetSpecialPath 1) "/comdlg32.ocx"))
   
5.   (if (not dc-cdlalloc)
   
6.     (vlax-import-type-library
   
7.       :tlb-filename  path
   
8.       :methods-prefix  "dm-"
   
9.       :properties-prefix "dp-"
   
10.       :constants-prefix       "dc-"
    
11.     )
    
12.   )
    
13.   (setq dlg (vlax-create-object "MSComDlg.CommonDialog"))  ;;UserAccounts.CommonDialog
    
14.   (dp-put-MaxFileSize dlg 10000)
    
15.   (dp-put-filter dlg "All Files (*.*)|*.*|Lisp Files(*.lsp)|*.lsp|DWG Files (*.dwg)|*.dwg");增加过滤类型
    
16.   (dm-ShowOpen dlg)
    
17.   (princ (strcat "\n你打开的文件是:\n" (dp-get-filename dlg)))
    
18. 
    
19.   ;;另外一种方式
    
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.   ;;打开文件
    
30.   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileOpen"))  ;;"SAFRCFileDlg.FileOpen"
    
31.   (Fdp-put-FileName dlgobj "C:\\")
    
32.   (Fdm-OpenFileOpenDlg dlgobj)
    
33.   (princ "\n你打开的文件是:\n")
    
34.   (princ (Fdp-get-FileName dlgobj))
    
35.   (vlax-release-object dlgobj)
    
36.   ;;保存文件
    
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 "\n你要保存的文件是:\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. )
    

;;;通用文件对话框<br /> ;;;用来替代CAD的getfiled对话框，用以获得更多功能<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 />   (dm-ShowOpen dlg)<br />   (princ (strcat "\n你打开的文件是:\n" (dp-get-filename dlg)))<br /> <br />   ;;另外一种方式<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 />   ;;打开文件<br />   (setq dlgobj (vlax-create-object "SAFRCFileDlg.FileOpen"))  ;;"SAFRCFileDlg.FileOpen"<br />   (Fdp-put-FileName dlgobj "C:\\")<br />   (Fdm-OpenFileOpenDlg dlgobj)<br />   (princ "\n你打开的文件是:\n") <br />   (princ (Fdp-get-FileName dlgobj))<br />   (vlax-release-object dlgobj)<br />   ;;保存文件<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 "\n你要保存的文件是:\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 />

Highflybird

前段时间有人问到如何获取或者设置剪贴版，下面就是一个例子：
Form2.0对象

1. ;;;利用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.   ;;获取剪贴版数据
    
13.   (setq fmo (vlax-create-object "Forms.form.1"))  ;Form
    
14.   (setq ctr (FMP-GET-CONTROLs fmo))   ;控件
    
15.   (setq box (fmm-add ctr "Forms.textbox.1"))   ;文本框
    
16.   (Fmp-put-MultiLine box :vlax-true)
    
17.   (if (= (FMp-get-CanPaste box) :vlax-true)   ;如能粘贴
    
18.     (progn
    
19.       (FMm-Paste box)     ;粘贴进去
    
20.       (alert (fmp-get-text box))   ;显示文本
    
21.     )
    
22.   )
    
23.   ;;设置剪贴版数据
    
24.   (setq str "Hello,MJTD!\n我爱你，CAD!")
    
25.   (Fmp-put-text box str)    ;设置剪贴板文本内容
    
26.   (Fmp-put-SelStart box 0)
    
27.   (Fmp-put-SelLength box (Fmp-get-textlength box))
    
28.   (Fmm-copy box)     ;拷贝进去
    
29.   ;;释放
    
30.   (vlax-release-object box)
    
31.   (vlax-release-object ctr)
    
32.   (vlax-release-object fmo)
    
33.   (princ)
    
34. )
    

;;;利用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 />   ;;获取剪贴版数据<br />   (setq fmo (vlax-create-object "Forms.form.1"))  ;Form<br />   (setq ctr (FMP-GET-CONTROLs fmo))   ;控件<br />   (setq box (fmm-add ctr "Forms.textbox.1"))   ;文本框<br />   (Fmp-put-MultiLine box :vlax-true)<br />   (if (= (FMp-get-CanPaste box) :vlax-true)   ;如能粘贴<br />     (progn<br />       (FMm-Paste box)     ;粘贴进去<br />       (alert (fmp-get-text box))   ;显示文本<br />     )<br />   )<br />   ;;设置剪贴版数据<br />   (setq str "Hello,MJTD!\n我爱你，CAD!")<br />   (Fmp-put-text box str)    ;设置剪贴板文本内容<br />   (Fmp-put-SelStart box 0)<br />   (Fmp-put-SelLength box (Fmp-get-textlength box))<br />   (Fmm-copy box)     ;拷贝进去<br />   ;;释放<br />   (vlax-release-object box)<br />   (vlax-release-object ctr)<br />   (vlax-release-object fmo)<br />   (princ)<br /> )<br />

Highflybird

InternetExplorer.Application对象和word 对象

[pcode=lisp,true];;获得IE窗口大小
(defun C:getscreenRes()
  (setq IE (vlax-create-object "InternetExplorer.Application"))
  (vlax-invoke IE 'navigate "about:blank")
  (setq screen (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'screen))
  (princ (vlax-get screen 'height))
  (princ (vlax-get screen 'width))
  (vlax-release-object IE)
)
;;;访问剪贴板
(defun C:GetPaste()
  (setq IE (vlax-create-object "InternetExplorer.Application"))
  (vlax-invoke IE 'navigate "about:blank")
  (setq Clip (vlax-get (vlax-get (vlax-get ie 'Document) 'parentWindow) 'clipboardData))
  (vlax-invoke clip 'setdata "text" "This is a test!")
  (princ  (vlax-invoke clip 'GetData "text"))
   (vlax-release-object IE)


  ;;windows 7下用
  (setq wsh (vlax-create-object "Wscript.Shell"))
  (setq str "This is a test (by wscript.shll)")
  (vlax-invoke wsh 'run
    (strcat "CMD.exe /C echo " str " | clip")
    0
    :vlax-false
  )
  (vlax-release-object wsh)

  ;;通过word设置剪贴板
  (setq word (vlax-create-object "Word.Application"))
  (setq doc (vlax-get word 'Documents))
  (setq sel (vlax-get word 'Selection))
  (vlax-invoke doc 'add)
  (vlax-put sel 'text  "This is a test(by word)")
  (vlax-invoke sel 'copy)
  (vlax-invoke word 'quit 0)
  (vlax-release-object word)

  ;;通过word获取剪贴板
  (setq word (vlax-create-object "Word.Application"))
  (setq doc (vlax-get word 'Documents))
  (setq sel (vlax-get word 'Selection))
  (vlax-invoke doc 'add)
  (vlax-invoke sel 'Paste)  ;word.Selection.PasteAndFormat(wdFormatPlainText)
  (vlax-invoke sel 'wholeStory)
  (princ "\n剪贴板的文字是:")
  (princ (vlax-get sel 'text))
  (vlax-release-object word)
)

[/pcode]
其实这两个东西有更多的运用，我这里只是仅仅举了几个个例子。

Highflybird

其他的对象的用法
Scriptlet.TypeLib对象

1. ;;;生成GUID（全球唯一标志码）
   
2. ;;;可以用来做为软件的加密
   
3. (defun C:GUID (/ objSLTL str)
   
4.   (setq objSLTL (vlax-create-object "Scriptlet.TypeLib"))
   
5.   (setq str (vlax-get objSLTL 'GUID))
   
6.   (vlax-release-object objSLTL)
   
7.   str
   
8. )
   

;;;生成GUID（全球唯一标志码）<br /> ;;;可以用来做为软件的加密<br /> (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 />

Shell.USER对象

1. ;;;账户管理
   
2. ;;;需要在管理员身份下运行
   
3. ;;;window 7 和vista 可能无效
   
4. (defun c:User(/ PATH NEWUSR USROBJ)
   
5.   (setq path (strcat (GetSpecialPath 1) "/shgina.dll"))  
   
6.   (if (Not Uc-ILEU_ALPHABETICAL)
   
7.     (vlax-import-type-library
   
8.       :tlb-filename   path
   
9.       :methods-prefix   "Um-"
   
10.       :properties-prefix  "Up-"
    
11.       :constants-prefix  "Uc-"
    
12.     )
    
13.   )
    
14.   ;;创建一个账户，设置密码和权限
    
15.   ;;然后移除
    
16.   (setq usrObj (vlax-create-object "Shell.users"))
    
17.   (setq newusr (um-create usrobj "test"))
    
18.   (up-put-setting newusr "AccountType" 3)
    
19.   (Um-changePassword newusr "111222" "")
    
20.   (um-remove usrObj "test")
    
21.   (vlax-release-object usrobj)
    
22.   (vlax-release-object newusr)
    
23.   (princ)
    
24. )
    

;;;账户管理<br /> ;;;需要在管理员身份下运行<br /> ;;;window 7 和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 />   ;;创建一个账户，设置密码和权限<br />   ;;然后移除<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 />

让你的软件发声：
SAPI.SpVoice对象

1. ;;;语音相关
   
2. (defun c:voice(/ objTTS)
   
3.   (setq objTTS (vlax-create-object "SAPI.SpVoice"))
   
4.   (vlax-invoke objTTS 'speak "Hello,明经通道欢迎你!")
   
5.   (vlax-release-object objTTS)
   
6.   (princ)
   
7. )
   

;;;语音相关<br /> (defun c:voice(/ objTTS)<br />   (setq objTTS (vlax-create-object "SAPI.SpVoice"))<br />   (vlax-invoke objTTS 'speak "Hello,明经通道欢迎你!")<br />   (vlax-release-object objTTS)<br />   (princ)<br /> )<br />

Highflybird

其他的还有，WIA对象（用来图像处理）WMPlayer(媒体播放）,WinSock（网络通信）,ZIP（文件压缩及其解压缩）以及其他等等很多。以后将一一讲解。可见CAD的lisp语言不仅仅能画图，还一样可以做其他很多事情.
(其实，还有正则表达式等等，这些明总等已经讲的详细了)
这次讲的东西是主要的，呵呵，留以后补充吧。

Microsoft.XMLHTTP对象

;;获取本机的公网IP

  (setq path (strcat (getSpecialPath 1) "\\msxml6.dll"))
  (if (not xc-NODE_TEXT)
    (vlax-import-type-library
      :tlb-filename  path
      :methods-prefix "xm-"
      :properties-prefix "xp-"
      :constants-prefix "xc-"
    )
  )
  (setq http (vlax-create-object "Msxml2.XMLHTTP")) ;调用XMLHTTP对象
  (setq url " http://www.ip138.com/ip2city.asp")  ;赋予变量URL值
  (xm-open http "GET" url :vlax-false)   ;定义打开URL方式
  (xm-send http)
  
  
  (setq str (xp-get-responseText http))   ;获得网页文本
  (setq s1  (vl-string-position (ascii "[") str))
  (setq s2  (vl-string-position (ascii "]") str))
  (princ "\n你的IP地址是：")
  (princ (substr str (+ s1 2) (- s2 s1 1)))
  (vlax-release-object http)

WINSOCK对象
;;获取本机的内网IP
  (setq wsock (vlax-create-object "MSWinsock.Winsock"))
  (princ "\n本机的地址为:")
  (princ (vlax-get wsock 'LocalIP))
  (vlax-release-object wsock)

待续.....

Highflybird

ADODB.Stream
展示如何打包二进制文件和读写二进制文件。
[pcode=lisp,true]
;;;=============================================================
;;; 利用ADOBE读写二进制文件                                    
;;;=============================================================
(defun c:test (/ ARRAY BIN DAT DATA F L PATH S)
  ;;Read a Binary  file
  (defun ReadBinary (FileName / stream arr)
    (setq stream (vlax-create-object "ADODB.Stream"))
    (vlax-put stream 'type 1)                                                 ;adTypeBinary
    (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3
    (vlax-invoke stream 'LoadFromFile filename)
    (setq Arr (vlax-invoke-method stream 'read (vlax-get stream 'SIZE)));read stream
    (vlax-invoke stream 'close)
    (vlax-release-object stream)
    (vlax-safearray->list (vlax-variant-value arr))                        ;if a large size file ,it will take a long time in this step
  )
  ;;Write to a Binary  file from a text stream
  (defun WriteBinary (FileName Array / stream)
    (setq stream (vlax-create-object "ADODB.Stream"))
    (vlax-put stream 'type 1)                                                 ;adTypeBinary
    (vlax-invoke stream 'open)                                                ;adModeRead  =1 adModeWrite  =2 adModeReadWrite =3
    (vlax-invoke-method stream 'Write array)                                ;write stream
    (vlax-invoke stream 'saveToFile fileName 2)                                ;save
    (vlax-invoke stream 'close)
    (vlax-release-object stream)
  )
       
  (setq path (getfiled "Please select a binary file:" "c:/" "" 8 ))     ;get file path
  (setq f (open "C:\\test.txt" "W"))
  (setq data (readBinary path))
  (princ data f)
  (close F)

  ;;(setq stream (vl-get-resource "test"))                              ;we can wrap this text file into .vlx file
  (setq f (open "C:\\test.txt" "R"))                                           ;open for read
  (setq l "")
  (while (setq s (read-line f))
    (setq l (strcat l s))
  )
  (setq array (read l))
  (close f)
  
  (setq dat (vlax-make-safearray 17 (cons 0 (1- (length array)))))             ;17 for unsigned char
  (vlax-safearray-fill dat array)
  (setq bin (vlax-make-variant dat))
  (writeBinary "C:\\test.jpg" bin)                                        ;write binary file.
)
[/pcode]

Highflybird

WIA图像控件的利用
[pcode=lisp,true]
;;;=============================================================
;;; WIA图像控件的利用                                          
;;;=============================================================
;| 一下是VB的源码，可以参考
Sub WIA_ARGB()
    Dim Img        'As ImageFile
    Dim IP        'As ImageProcess
    Dim v        'As Vector
    Dim i        'As Long
    Set Img = CreateObject("WIA.ImageFile")
    Set IP = CreateObject("WIA.ImageProcess")
    Img.LoadFile r & "\1.jpg"
    Set v = Img.ARGBData
    For i = 1 To v.Count Step 300
        v(i) = &HFFFF00FF        'opaque pink (A=255,R=255,G=0,B=255)
    Next
    '使用指定的位元組更新影像位元組。
    IP.Filters.Add IP.FilterInfos("ARGB").FilterID
    Set IP.Filters(1).Properties("ARGBData") = v
    Set Img = IP.Apply(Img)
    Img.SaveFile r & "\2.jpg"
    UserForm1.Image1.Picture = LoadPicture(r & "\1.jpg")
    UserForm1.Image2.Picture = LoadPicture(r & "\2.jpg")
    Kill r & "\2.jpg"
End Sub
;;|;
(defun c:img(/ path Img IPr vec cnt col old val fil i new)
  (setq path (strcat (getSpecialPath 1) "\\wiaaut.dll"))
  (if (not ic-actionEvent)
    (vlax-import-type-library
      :tlb-filename  path
      :methods-prefix "im-"
      :properties-prefix "ip-"
      :constants-prefix "ic-"
    )
  )
  (setq Img (vlax-create-object "WIA.ImageFile"))
  (setq IPr  (vlax-create-object "WIA.ImageProcess"))
  (im-loadfile Img "C:\\1.bmp")
  (setq vec (ip-get-ARGBData Img))
  (setq cnt (ip-get-count vec))
  (setq col (vlax-make-variant -2147418367))                         ;-2147418368 &HFFFF00FF
                                                                  ;'opaque pink (A=255,R=255,G=0,B=255)
  (setq i 1)
  (repeat (/ cnt 3)
    (setq old (ip-get-item vec i))
    (setq val (vlax-variant-value old))
    (setq val (- val))
    (ip-put-item vec i val)                                          ;4294967295
    (setq i (+ i 3))
  )
  (setq fil (ip-get-Filters IPr))
  (im-add fil (ip-get-filterID (ip-get-item (ip-get-filterinfos IPr) "ARGB")) 0)
  (ip-put-value (ip-get-item (ip-get-Properties (ip-get-item fil 1)) "ARGBData") vec)
  (setq new (im-apply  IPr Img))
  (im-savefile new "C:\\2.bmp")

  (vlax-release-object Img)
  (vlax-release-object IPr)
  (vlax-release-object vec)
  (vlax-release-object fil)
  (vlax-release-object new)
)[/pcode]

Highflybird

正则表达式和ServerXMLHTTP的综合运用
[pcode=lisp,true]
;;;=============================================================
获取外网地址--正则表达式和ServerXMLHTTP的综合运用           
;;;=============================================================
(defun C:GetIP (/ htt regexp text mathes address item0)
  (setq Http (vlax-create-object "Msxml2.ServerXMLHTTP"))
  (vlax-invoke-method http 'open "GET" "http://iframe.ip138.com/ic.asp")
  (vlax-invoke-method http 'send)
  (setq text (vlax-get-property http 'responseText))
  
  (setq RegExp (vlax-create-object "VBScript.RegExp"))
  (vlax-put-property  RegExp 'pattern "((?:(?:25[0-5]|2[0-4]\\d|[01]?\\d?\\d)\\.){3}(?:25[0-5]|2[0-4]\\d|[01]?\\d?\\d))")
  (vlax-put-property  RegExp 'IgnoreCase 1)
  (vlax-put-property  RegExp 'Global 1)
  (setq matches (vlax-invoke-method RegExp 'Execute text))
  (setq item0   (vlax-get-property matches 'item 0))
  (setq Address (vlax-get-property item0 'value))
  (vlax-release-object item0)
  (vlax-release-object matches)
  (vlax-release-object regexp)
  (vlax-release-object http)
  (alert (strcat "你的IP地址是:" address))
  (princ)
)[/pcode]

Highflybird

其他控件和对象的利用
[pcode=lisp,true];;;=============================================================
;;; 其他控件的利用                                             
;;;=============================================================

;;; ADO Recordset对象用于容纳一个来自数据库表的记录集。         
;;; 一个Recordset对象由记录和列（字段）组成。在 ADO 中，此对象是
;;; 最重要且最常用于对数据库的数据进行操作的对象。              
(defun c:kk(/ rr)
  (setq rs (vlax-create-object "Adodb.recordset"))
  (vlax-dump-object rs T)
  (vlax-release-object rs)
  (princ)
)

;;;  利用DOS控制台做些事情,譬如列举文件目录到某个文本文件，等等.
(defun C:Cout(/ wsh exe)
  (setq wsh (vlax-create-object "WScript.shell"))
  (setq exe (vlax-invoke wsh 'exec "ipconfig"))
  (wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")
  (alert (vlax-invoke (vlax-get exe 'stdout) 'readAll))
  (setq exe (wm-exec wsh "cmd.exe /C dir c:\\temp\\*.* /a /s"))
  (princ (vlax-invoke (vlax-get exe 'stdout) 'readAll))
  (vlax-release-object exe)
  (vlax-release-object wsh)
)

;;;  一些综合应用.
(defun c:test()
  (setq path (strcat (GetSpecialPath 1) "\\vbscript.dll"))        ;"\\Wscript.exe"
  (if (not RM-abs)
    (vlax-import-type-library
      :tlb-filename                 path
      :methods-prefix                 "Rm-"
      :properties-prefix         "Rp-"
      :constants-prefix         "Rc-"
    )
  )
  (setq regExp (vlax-create-object "Vbscript.RegExp"))
  (setq wsh (vlax-create-object "wscript.shell"))
  (setq scr (vlax-create-object "ScriptControl"))
  (vlax-put scr 'language "VBS")
  (vlax-make-variant 1)
  (vlax-create-object "vbscript.GlobalObj")
  (rm-abs (vlax-make-variant 1) -1)
  (rm-inputbox  scr "Dim x As VBScript_Global.GlobalObj")
  (SM-EXECUTESTATEMENT scr "Function sss()
                            Dim x As new VBScript_Global.GlobalObj
                            end Function")

  (princ (readStream "C:\\delete.dcl" T))
  (vlax-release-object regExp)
)

;;;FireWall等等控件均可测试。
(defun FHQ()
  ;;(vlax-create-object "ToolsObject.TelnetTool")
  ;;(vlax-create-object "RCBdyCtl.Setting")
  (setq fwObj (vlax-create-object "HNetCfg.FwMgr"))
)[/pcode]