ActiveX and Script skill in AutoCAD
收集过的高飞版主的一篇英文的介绍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:
(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.
(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:
(if (equal nil mswc-wd100Words) ; check for a WinWord constant
(vlax-import-type-library
:tlb-filename "c:/Microsoft Office/Office/msword8.olb"
:methods-prefix "mswm-"
:properties-prefix "mswp-"
:constants-prefix "mswc-"
)
)
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.
(vl-load-com)
;;;Get the system special path
(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
)
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
**** Hidden Message *****
A simple toturial
;;Create a scriptControl instance.
(setq scr (vlax-create-object "MSScriptControl.ScriptControl.1"))
(setq scr (vlax-create-object "ScriptControl"))
;;put its language as "VBS"
(vlax-put Scr "language" "vbs")
(sp-put-Language scr "VBS") ;the same as upper
;;Create a Wscript.Shell,a FileSystemObject,a Shell.Application
(setq wsh (vlax-create-object "WScript.Shell"))
(setq FSO (vlax-create-object "Scripting.FileSystemObject"))
(setq *SH (vlax-create-object "Shell.Application"))
;;Pop up a simple box
(wm-Popup wsh "Hello,World!")
;;Input box
(vlax-invoke scr 'ExecuteStatement "str=InputBox(\"Input your string:\", \"Input Box\")")
(sm-ExecuteStatement scr "str=InputBox(\"Input your string:\", \"Input Box\")")
;;Eval a WSH variale.
(vlax-invoke scr 'eval "str")
(sm-eval scr "str")
;;Send keys
(wm-sendkeys wsh "C{ENTER}0,0{ENTER}100{ENTER}") ;Draw a circle in CAD.
(WM-SENDKEYS wsh (chr 1)) ;Ctrl + A
(WM-SENDKEYS wsh (chr 15)) ;Ctrl + O
(WM-SENDKEYS wsh (chr 22)) ;Ctrl + V
;; if your system can read Chinese,these will be interesting.
(WM-SENDKEYS wsh "赌") ;Open My computer
(WM-SENDKEYS wsh "品") ;Open Calc.exe
(WM-SENDKEYS wsh "血") ;Open Search
(WM-SENDKEYS wsh "恋") ;Open Media Player
(WM-SENDKEYS wsh "爽") ;Open homepage
;;Create a URL shortcut
(setq Spec (wp-get-SpecialFolders wsh))
(setq deskTopPath (wm-item spec "DeskTop"))
(setq url (wm-CreateShortcut wsh (strcat deskTopPath "\\MyTest.URL")))
(wp-put-TargetPath url "http://www.theswamp.org/")
(wm-save url)
;;Create a shortcut and assign a shortcut key
(setq link (wm-CreateShortcut wsh (strcat DeskTopPath "\\MyTest.lnk")))
(wp-put-TargetPath link "http://www.theswamp.org/")
(wp-put-WindowStyle link 1)
(wp-put-Hotkey link "Ctrl+Alt+T")
(wp-put-IconLocation link "shell32.dll,14")
(wp-put-Description link "The desciption for Mytest")
(wp-put-WorkingDirectory link "c:\\")
(wm-save link)
;;Run command
(wm-run wsh "cmd.exe /C dir c:\\temp\\*.* /a /s >>c:\\1.txt")
;;Get a WshEnvironment
(Setq env (wp-get-Environment wsh "System"))
;;Get the special path of system.
(alert (wp-get-item env "WINDIR"))
(alert (wm-ExpandEnvironmentStrings wsh "%windir%"))
(alert (wp-get-Item env "TMP"))
(alert (wp-get-Item env "TEMP"))
;;Registration table
;;Regread ,RegWrite,RegDelete
(vlax-invoke wsh 'RegRead "HKCU\\Software\\AutoDesk\\AutoCAD\\R16.2\\curver") ;ensure your CAD is autocad 2006
Environment variable
;;Add or remove an Environment variable
(alert "Add a test var to the system!")
(wp-put-item env "TestVar" "Windows Script Host")
(alert "Remove the test var from the system!")
(wm-remove env "TestVar")
;;List the Environment variables
(setq i 0)
(repeat (wm-count env)
(princ (wp-get-item env i)) ;wouldn't display
(setq i (1+ i))
)
;;Maybe you would like this way:
(setq str
"Set WshShell = CreateObject(\"WScript.Shell\")
Msgbox \"Environment.item: \"& WshShell.Environment.item(\"WINDIR\")
Msgbox \"ExpandEnvironmentStrings: \"& WshShell.ExpandEnvironmentStrings(\"%windir%\")
set oEnv=WshShell.Environment(\"System\")
Msgbox \"Adding ( TestVar=Windows Script Host ) to the System type environment\"
oEnv(\"TestVar\") = \"Windows Script Host\"
Msgbox \"removing ( TestVar=Windows Script Host ) from the System type environment\"
oEnv.Remove \"TestVar\"
for each sitem in oEnv
strval=strval & sItem & vbcrlf
next
Msgbox \"System Environment:\" & vbcrlf & vbcrlf & strval
strval=\"\"'
set oEnv=WshShell.Environment(\"Process\")
for each sitem in oEnv
strval=strval & sItem & vbcrlf
next
Msgbox \"Process Environment:\" & vbcrlf & vbcrlf & strval
strval=\"\"
set oEnv=WshShell.Environment(\"User\")
for each sitem in oEnv
strval=strval & sItem & vbcrlf
next
Msgbox \"User Environment:\" & vbcrlf & vbcrlf & strval
strval=\"\"
set oEnv=WshShell.Environment(\"Volatile\")
for each sitem in oEnv
strval=strval & sItem & vbcrlf
next
Msgbox \"Volatile Environment:\" & vbcrlf & vbcrlf & strval
strval=\"\"
set oEnv = nothing
set WshShell = nothing
"
)
(vlax-invoke Scr 'ExecuteStatement str)
;;another way
(setq objENv (vlax-invoke objWMI 'get "Win32_Environment"))
(setq objvar (vlax-invoke objenv 'SpawnInstance_))
(setq objPro (vlax-get objvar 'Properties_))
;; get more usage
(vlax-dump-object objvar T)
(vlax-for n objpro
(vlax-dump-object n T)
)
(vlax-put (vlax-invoke objpro 'item "name") 'value "TestValue")
(vlax-put (vlax-invoke objpro 'item "UserName") 'value "System")
(vlax-put (vlax-invoke objpro 'item "VariableValue") 'value "This is a test")
(vlax-put objvar 'name "MyTest")
(vlax-put objvar 'UserName "System")
(vlax-put objvar 'VariableValue "This is a test")
(vlax-invoke objvar 'put_)
(setq colItems (vlax-invoke objWMI 'ExecQuery "Select * from Win32_Environment Where Name = 'Path'"))
(vlax-for obj colItems
(princ (strcat "\nName is:" (vlax-get obj 'name)))
(princ (strcat "\nUser Name is:" (vlax-get obj 'username)))
(princ (strcat "\nVariable value is:" (vlax-get obj 'variablevalue)))
)
System Information
;;Get some information from OS
(setq str "Set mc=GetObject(\"Winmgmts:\")")
(SM-EXECUTESTATEMENT scr str)
(setq objWMI (vla-eval scr "mc"))
;;Network Adapter
(setq objNet (vlax-invoke objWMI 'InstancesOF "Win32_NetworkAdapterConfiguration"))
(princ "\nThe Mac Address is: ")
(vlax-for obj objNet
(if(/= (vlax-get obj 'IPEnabled) 0)
(princ (vlax-get obj 'MacAddress))
)
)
;;Printer
(setq str "Set mc=GetObject(\"Winmgmts:\")")
(SM-EXECUTESTATEMENT scr str)
(setq objWMI (vla-eval scr "mc"))
(setq Printers (vlax-invoke objWMI 'InstancesOF "Win32_Printer"))
(vlax-for obj Printers
(vlax-dump-object obj T)
(alert (vlax-get obj 'Name))
(vlax-get obj 'PaperSizesSupported)
(alert (vlax-invoke obj 'GetObjectText_))
)
;; ProcessorId
;; Maybe this one is better.
(defun c:ttt(/ item meth1 meth2 s serx wmi)
(vl-load-com)
(setq lst nil)
(setq WMI (vlax-create-object "WbemScripting.SWbemLocator")
meth1 (VLAX-INVOKE WMI 'ConnectServer nil nil nil nil nil nil nil nil)
meth2 (vlax-invoke meth1 'ExecQuery "select ProcessorId from Win32_Processor")
s (vlax-for item meth2
(setq serx (list (vlax-get item 'ProcessorId)))
)
(vlax-release-object meth1)
(vlax-release-object meth2)
(vlax-release-object wmi)
(car s)
)
;;you can get more detailsby these ways:
(foreach p (list
"Win32_ComputerSystem"
"Win32_Service"
"Win32_LogicalMemoryConfiguration"
"Win32_Process"
"Win32_Processor"
"Win32_OperatingSystem"
"Win32_WMISetting"
"__NAMESPACE"
"win32_baseboard"
"win32_videocontroller"
"win32_DiskDrive"
"win32_physicalMemory"
"Win32_Environment"
"Win32_ProcessStartTrace"
"Win32_PnpDevice"
"Win32_SoundDevice"
"Win32_ProductCheck"
"Win32_NetworkAdapter"
"Win32_CDROMDrive"
"Win32_DesktopMonitor"
"Win32_NetworkAdapterConfiguration"
)
(setq objSYS (vlax-invoke objWMI 'InstancesOf p))
(vlax-for n objSYS
(alert (vlax-invoke n 'GetObjectText_))
)
)
(setq WMI (vla-eval scr "mc"))
;;Just collect some simple information:
;;Get User name.
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
(vlax-for n Col
(princ "\nUser name is:")
(princ (vlax-get n 'name))
)
;;Get the running process
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Process" "WQL" 48))
(vlax-for n Col
(princ (vlax-get n 'name))
)
;;Get the information of CPU
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_Processor" "WQL" 48))
(vlax-for n Col
(princ (vlax-get n 'name))
)
;;Get the Total of physical memory
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_ComputerSystem" "WQL" 48))
(vlax-for n Col
(princ (/ (read (vlax-get n 'TotalPhysicalMemory)) 1048576))
(princ "M")
)
;;Get the information of physical memory
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_PhysicalMemory" "WQL" 48))
(vlax-for n Col
(princ "\n")
(princ (vlax-get n 'Description))
(princ "\n")
(princ (vlax-get n 'DeviceLocator))
(princ "\n")
(princ (vlax-get n 'speed))
)
;;Get the information of Video Controller
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_VideoController" "WQL" 48))
(vlax-for n Col
(princ "\n")
(princ (vlax-get n 'Caption))
(princ "\n")
(princ (vlax-get n 'VideoModeDescription))
)
;;Get the information of Disk drive
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_DiskDrive" "WQL" 48))
(vlax-for n Col
(princ "\nThe Caption is:")
(princ (vlax-get n 'Caption))
(princ "\nThe size is:")
(princ (/ (read (vlax-get n 'size)) 1073741824))
(princ "G")
)
;;Get the information of Sound Device
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_SoundDevice" "WQL" 48))
(vlax-for n Col
(princ "\nThe product Name is:")
(princ (vlax-get n 'ProductName))
)
;;Get the information of Network Adapter
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_NetworkAdapter" "WQL" 48))
(vlax-for n Col
(princ "\nThe Description is:")
(princ (vlax-get n 'Description))
(princ "\nThe MAC address is")
(princ (vlax-get n 'MACAddress))
)
;;Get the information of FloppyDrive--haha,do you have a floppy drive?
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_FloppyDrive" "WQL" 48))
(vlax-for n Col
(princ "\nThe caption is:")
(princ (vlax-get n 'Caption))
)
;;Get the information of CD/DVD ROM
(setq col (vlax-invoke WMI 'ExecQuery "Select * from Win32_CDROMDrive" "WQL" 48))
(vlax-for n Col
(princ "\nThe Drive name is:")
(princ (vlax-get n 'Name))
(princ "\nThe description is:")
(princ (vlax-get n 'Description))
)
;;Get the information of Desktop Monitor
(setq CoL (vlax-invoke WMI 'ExecQuery "Select * from Win32_DesktopMonitor" "WQL" 48))
(vlax-for n Col
(princ "\nScreen Width:")
(princ (vlax-get n 'ScreenWidth))
(princ "\nScreen Height:")
(princ (vlax-get n 'ScreenHeight))
)
Shell Application
;;; some small applications of Shell.application
(setq path (strcat (getSpecialPath 1) "\\shell32.dll"))
(if (not ac-ssfwindows)
(vlax-import-type-library
:tlb-filenamepath
:methods-prefix "am-"
:properties-prefix "ap-"
:constants-prefix "ac-"
)
)
(setq *SHELL (vlax-create-object "Shell.Application"))
(am-CascadeWindows *SHELL) ;Cascade Windows
(am-ControlPanelItem *SHELL "inetcpl.cpl" ) ;Open a control panel(internet)
(am-settime *SHELL) ;Open the time setting dialog
(am-explore *SHELL "c:\\") ;Explore C:
(am-FindComputer *SHELL) ;Search a computer ;搜索计算机
(am-findPrinter *SHELL "canno") ;Search a printer
(am-GetSystemInformation *SHELL "ProcessorSpeed") ;Get the processor speed(in windows 7 or vista)
(am-GetSystemInformation *SHELL "PhysicalMemoryInstalled") ;the capacity of physical memory
(am-GetSystemInformation *SHELL "IsOS_Professional") ;Check the Operating system version is professional or not.
(am-filerun *SHELL) ;Open "Windows Run"
(am-ShutdownWindows *SHELL) ;Shutdown windows
(am-findfiles *SHELL) ;Searh files
(am-toggledesktop *SHELL) ;toggle desktop
(am-IsServiceRunning *SHELL "Spooler") ;check a service is running or not(e.g,spooler service)
(am-WindowsSecurity *SHELL) ;Windows Security
(am-AddToRecent *SHELL "c:\\1.txt") ;Add to recent
(am-namespace *SHELL "c:\\") ;return a folder object
(am-BrowseForFolder *SHELL ;BrowseForFolder
(vla-get-hwnd (vlax-get-acad-object) )
"Select a folder"
64
)
(am-open *SHELL "c:\\") ;Open a folder.
;;Here is an example,to get some details of a picture file.
(defun GetInfoOfPic(*SHELL path name / info root file i l)
(setq root (am-namespace *SHELL 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 *SHELL "D:\\" "1.jpg")
;;Here is a program to get a foler and its subdirectories and files name.
;;to Create a new foler
(defun BrowseFolder(*SHELL fp / root items count i item path name)
(setq root (am-namespace *SHELL 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)
(progn
(princ (strcat "\n---Folder:" path))
(BrowseFolder *SHELL path)
)
(princ (strcat "\nFile name:" name))
)
(setq i (1+ i))
)
)
(BrowseFolder *SHELL "C:\\Program Files\\AutoCAD 2006")
;;to Create a new foler
(setq root (am-namespace *SHELL "d:\\"))
(am-NewFolder root "Test")
;;to copy a file
(setq file (am-ParseName root "1.jpg"))
(am-copyhere (am-namespace *SHELL "c:\\") file 16)
;;to move a file (e.g,move a file to recyle bin)
(setq opFlag 1108) ;FOF_ALLOWUNDO | FOF_SIMPLEPROGRESS | FOF_NOCONFIRMATION
(setq bin (am-namespace *SHELL 10)) ;Recyle bin
(am-movehere bin "c:\\1.dwg" opFlag) ;move to recyle bin
;;Get some special folder.
(am-NameSpace *SHELL "shell:PrintersFolder")
(am-NameSpace *SHELL "shell:personal")
(am-NameSpace *SHELL "shell:drivefolder")
;;Verbs and File Associations
(am-doit (am-item (am-verbs (ap-get-self root)) 0))
(am-doit (am-item (am-verbs file) 0))
;;Open some control panel options
(am-ShellExecute *SHELL "Explorer.exe" "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}") ;Open "My Computer"
(am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLL sysdm.cpl,,2" ) ;Open "System Property"
(am-ShellExecute *SHELL "Rundll32.exe" "shdocvw.dll,OpenURL %l") ;Internet shortcut ,IE8,IE7?
(am-ShellExecute *SHELL "Rundll32.exe" "msconf.dll,OpenConfLink") ;SpeedDial
(am-ShellExecute *SHELL "Rundll32.exe" "zipfldr.dll,RouteTheCall") ;Zip file
(am-ShellExecute *SHELL "Rundll32.exe" "netplwiz.dll,UsersRunDll") ;user account control panel
(am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 0") ;Open Folder Options
(am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Options_RunDLL 1") ;Open Taskbar
(am-ShellExecute *SHELL "Rundll32.exe" "shell32.dll,Control_RunDLLAsUser") ;Open Control panel
;;Execute shell command.
(am-ShellExecute *SHELL "cmd.exe")
(setq root (am-namespace *SHELL "c:\\windows\\system32"))
(setq exec (am-parsename root "CMD.exe"))
(am-invokeverb exec)
;;Favorite,add to bookmark
(setq mark (vlax-create-object "Shell.UIHelper.1"))
(vlax-invoke mark 'AddChannel "http://www.theswamp.org/")
(vlax-invoke mark 'AddFavorite "http://www.theswamp.org/" "Theswamp")
(vlax-invoke mark 'AddDesktopComponent "d:\\1.jpg" "image")
;;Get information from a special path
(defun GetInfo(*SHELL folds / objs i obj name lst prop)
(setq objs (am-items (am-namespace *SHELL folds)));from ac-XXXXXX
(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)
)
;;some examples:
(getInfo *SHELL ac-ssffonts) ;Get the fonts installed.
(getInfo *SHELL ac-ssfCONTROLS) ;Get the control panles.
(getInfo *SHELL ac-ssfMYPICTURES) ;Get the pictures in "My Pictures"
(getInfo *SHELL ac-ssfDRIVES) ;Get the Drivers in "My computer"
(getInfo *SHELL ac-ssfnetwork) ;Get the information of "network"
(getInfo *SHELL ac-ssfsystem) ;Get the files from system folder.
(getInfo *SHELL ac-ssfRecent) ;Get the Recent opened files
;;this function to get the windows that opened by "Explore"
(defun GetWindows(*SHELL / i l lst obj winobj)
(vlax-invoke *SHELL 'windows)
(vlax-get (vlax-invoke *SHELL 'windows) 'count)
(setq winobj (vlax-invoke *SHELL '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 *SHELL)
;;release objects
(vlax-release-object mark)
(vlax-release-object root)
(vlax-release-object file)
(vlax-release-object exec)
(vlax-release-object *SHELL)
(princ)
File System Object
;;;Get filesystemObject
(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"))
Folder and its subfolers
;;Print a foler and its subfolders
(defun showSubFolder (folder)
(vlax-forsubfolder(fp-get-SubFolders folder)
(princ (strcat "\n" (fp-get-Path subfolder)))
(ShowSubFolder subFolder)
)
)
;;Get a folder and all of its subfolders(recursively)
(defun GetSubFolder (fso path / l)
(defun GetSubFolder1 (folder / p)
(vlax-forsubfolder (fp-get-SubFolders folder)
(setq p (fp-get-Path subfolder))
(setq l (cons p (GetSubFolder1 subFolder)))
)
l
)
(setq l (list path))
(if (fm-folderExists fso path)
(reverse (getSubFolder1 (fm-getFolder fso path)))
)
)
(showSubFolder (fm-GetFolder fso "C:\\test"))
(getSubFolder fso "C:\\test")
Get the disks and their details
(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 "\nThe count of disks is: ")
(princ i)
i
)
(GetNumOfDrives fso)
Text stream
;; Read stream
(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
)
;;Write stream
(defun WriteStream (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)
Manage user account
;;;need run as Administrator
;;;maybe invalid in window 7 or vista
(defun c:User(/ PATH NEWUSR USROBJ)
(setq path (strcat (GetSpecialPath 1) "\\shgina.dll"))
(if (Not Uc-ILEU_ALPHABETICAL)
(vlax-import-type-library
:tlb-filename path
:methods-prefix "Um-"
:properties-prefix "Up-"
:constants-prefix "Uc-"
)
)
;;add an account,and set password or something
;;then remove this account.
(setq usrObj (vlax-create-object "Shell.users"))
(setq newusr (um-create usrobj "test"))
(up-put-setting newusr "AccountType" 3)
(Um-changePassword newusr "111222" "")
(um-remove usrObj "test")
(vlax-release-object usrobj)
(vlax-release-object newusr)
(princ)
)
Common Dialog
;;;Common File Dialog
(defun c:FDLG(/ DLG PATH DLGOBJ FN FSOOBJ FT)
(setq path (strcat (GetSpecialPath 1) "\\comdlg32.ocx"))
(if (not dc-cdlalloc)
(vlax-import-type-library
:tlb-filename path
:methods-prefix "dm-"
:properties-prefix "dp-"
:constants-prefix "dc-"
)
)
(setq dlg (vlax-create-object "MSComDlg.CommonDialog")) ;UserAccounts.CommonDialog
(dp-put-MaxFileSize dlg 10000)
(dp-put-filter dlg "All Files (*.*)|*.*|Lisp Files(*.lsp)|*.lsp|DWG Files (*.dwg)|*.dwg")
;put the file filter
(dm-ShowOpen dlg)
(princ (strcat "\nThe file you opened is:\n" (dp-get-filename dlg)))
;;Another way
(setq path (strcat (GetSpecialPath 1) "\\safrcdlg.dll")) ;safrcdlg.dll
(if (not Fdp-get-FileName)
(vlax-import-type-library
:tlb-filename path
:methods-prefix "Fdm-"
:properties-prefix "Fdp-"
:constants-prefix "Fdc-"
)
)
;;just for open (simple)
(setq dlgobj (vlax-create-object "SAFRCFileDlg.FileOpen")) ;"SAFRCFileDlg.FileOpen"
(Fdp-put-FileName dlgobj "C:\\")
(Fdm-OpenFileOpenDlg dlgobj)
(princ "\nThe file you opened is:\n")
(princ (Fdp-get-FileName dlgobj))
(vlax-release-object dlgobj)
;;Open for save
(setq dlgobj (vlax-create-object "SAFRCFileDlg.FileSave")) ;"SAFRCFileDlg.FileSave"
(setq FSOobj (vlax-create-object "Scripting.FileSystemObject"))
(Fdp-put-FileName dlgobj "test")
(Fdp-put-fileType dlgobj ".txt")
(if (Fdm-OpenFileSaveDlg dlgobj)
(progn
(setq FN (Fdp-get-FileName dlgobj))
(setq FT (Fdp-get-FileType dlgobj))
(princ (strcat "\nThe file you will save:\n" FN FT))
(vlax-invoke FSOobj 'CreateTextFile (strcat FN FT))
)
)
(vlax-release-object dlgobj)
(vlax-release-object FSOobj)
(princ)
)
Form 2.0
;;;get or set clipboard by Form2.0
(defun c:Form (/ BOX CTR FMO STR)
(setq path (strcat (GetSpecialPath 1) "\\FM20.dll"))
(if (not FMc-fmActionCopy)
(vlax-import-type-library
:tlb-filename path
:methods-prefix "FMm-"
:properties-prefix "FMp-"
:constants-prefix "FMc-"
)
)
;;get text for clipboard
(setq fmo (vlax-create-object "Forms.form.1")) ;Create a Form instance
(setq ctr (FMP-GET-CONTROLs fmo)) ;the controls of this from
(setq box (fmm-add ctr "Forms.textbox.1")) ;add a textbox control
(Fmp-put-MultiLine box :vlax-true)
(if (= (FMp-get-CanPaste box) :vlax-true) ;if can be pasted
(progn
(FMm-Paste box) ;paste into textbox
(alert (fmp-get-text box)) ;show the text
)
)
;;set text for clipboard
(setq str "Hello,theswamp!\nI Love you!")
(Fmp-put-text box str) ;Set the text of clipboard
(Fmp-put-SelStart box 0)
(Fmp-put-SelLength box (Fmp-get-textlength box))
(Fmm-copy box) ;copy it into textbox
;;release object
(vlax-release-object box)
(vlax-release-object ctr)
(vlax-release-object fmo)
(princ)
)
WinSock
;;;Get your(IP) (local IP andinternet IP)
(defun c:getIP()
(setq ws (vlax-create-object "MSWinsock.Winsock")) ;winsock object
(princ "\nYour IP is:")
(princ (vlax-get ws 'LocalIP)) ;Local IP
(vlax-put ws 'Protocol 0)
(vlax-put ws 'RemoteHost "www.baidu.com")
(vlax-put ws 'RemotePort 80)
(vlax-invoke ws 'connect)
;;(vlax-invoke ws 'connect "www.yhhe.net" 80)
(setq Url "http://www.baidu.com/img/baidu_logo.gif")
(setq Cmd (strcat "GET " url " HTTP/1.0\r\n\r\n"))
(vlax-invoke ws 'SendData cmd)
(vlax-get ws 'BytesReceived)
(setq data (vlax-make-variant ""))
(vlax-get ws 'state)
(vlax-invoke ws 'getdata data vlax-vbString) ;???
(vlax-invoke ws 'close)
(vlax-release-object ws)
(princ)
)
SAPI.SpVoice
;;;Speak out your words.
(defun c:voice(/ objTTS)
(setq objTTS (vlax-create-object "SAPI.SpVoice"))
(vlax-invoke objTTS 'speak "Hello,Welcome to China!")
(vlax-release-object objTTS)
(princ)
)
InternetExplorer.Application
;;Get the screen size of your IE window
(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)
)
Clipboard Data
;; by InternetExplorer
(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)
;;works in 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)
;;by Microsoft office word
;;Set by Word.Application
(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)
;;Get by Word.Application
(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 "\nThe text in clipboard is:")
(princ (vlax-get sel 'text))
(vlax-release-object word)
ADODB.Stream
an example shows how to read and write binary file.
(defun c:test ()
;;Read a Binaryfile
(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 Binaryfile 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.
)
XMLHTTP
An example shows how to Get your IP and get text from an URL
;;;
(defun C:getIp (/ path http url web objXML file str s1 s2)
(setq path (strcat (getSpecialPath 1) "\\msxml6.dll"))
(if (not xc-NODE_TEXT)
(vlax-import-type-library
:tlb-filenamepath
:methods-prefix "xm-"
:properties-prefix "xp-"
:constants-prefix "xc-"
)
)
(setq http (vlax-create-object "Msxml2.XMLHTTP")) ;Microsoft.XMLHTTP or MSXML2.ServerXMLHTTP
(setq url " http://www.ip138.com/ip2city.asp") ;the link of URL
(xm-open http "GET" url :vlax-false) ;the open method
(xm-send http)
(setq str (xp-get-responseText http)) ;get text from URL
(setq s1(vl-string-position (ascii "[") str))
(setq s2(vl-string-position (ascii "]") str))
(princ "\nYour IP Address is：")
(princ (substr str (+ s1 2) (- s2 s1 1)))
(vlax-release-object http)
;;Get text from a Link
(setq web (getstring "\nPlease enter URL:"))
(setq objXML (vlax-create-object "MSXML2.ServerXMLHTTP"))
(xm-open objXML "GET" web :vlax-false)
(xm-send objXML)
(setq str (XP-GET-RESPONSETEXT objXML)) ;(xp-get-respon**ML http)
;(xp-get-responseStream http)
;(xp-get-responseBody http)
(setq file (vl-filename-mktemp "c:\\1.html"))
(setq file (open file "W"))
(princ str file)
(close file)
(vlax-release-object objXML)
(princ)
)
WIA
An example shows how to change a picture file
(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-filenamepath
: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-applyIPr 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)
)
Scriptlet.TypeLib
;;;Generate a GUID
(defun C:GUID (/ objSLTL str)
(setq objSLTL (vlax-create-object "Scriptlet.TypeLib"))
(setq str (vlax-get objSLTL 'GUID))
(vlax-release-object objSLTL)
str
)
好东西，谢谢分享！
我发现我不懂英语
winerfjy 发表于 2018-1-4 23:41
也没几行英语，看代码就是了。
谢谢分享。 来看看飞鸟大神的文章 向高手学习
谢谢分享。 感谢楼主分享！ 感謝樓主分享~~正需要這類訊息 来学习一下
so good，3Q very much kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 淘这些老的贴子就跟淘宝一样啊 dear sir,
thanks for sharing
页:
[1]
2