日志
编程档案之LISP
|||
http://bbs.mjtd.com/thread-65115-1-1.html
=====================================================================
分割文件路径
AutoCAD提供了fnsplitl函数，将文件完全路径字符串分解为包含3个字符串元素的表：（路径 文件名 扩展名），如：
(fnsplitl "C:\\Program Files\\AutoCAD 2004\\acad.exe")
返回
("C:\\Program Files\\AutoCAD 2004\\" "acad" ".exe")
在多文档间传递变量
Visual LISP函数(vl-propagate 'symbol)可以将符号变量传递到当前AutoCAD进程的所有文档中（包括已经打开的和后来打开的）。如：
(setq var 3)
(vl-propagate 'var)
那么其它文档中就可以使用var变量的值了。
对具有XDATA属性的实体作选择集
选择含扩展属性的实体，格式为：
(setq ss (ssget "cp" pts (list (list -3 '("APP"))(cons 0 "INSERT"))))
这里"APP"是扩展属性应用程序名，(cons 0 "INSERT")是其它过滤条件。
而目前在ARX程序中，仅能对应用程序名进行过滤。
应用ADO时如何取得记录总数
要注意CursorType的使用：
(setq conn (vlax-Create-Object "ADODB.Connection"))
(setq rs (vlax-Create-Object "ADODB.RecordSet"))
(vlax-invoke-method conn
"Open"
"provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\\test.mdb"
""
""
adok-adModeUnknown)
(vlax-invoke-method rs "Open" "SELECT * FROM mytable"
conn adok-adOpenStatic adok-LockOptimistic adok-adCmdText)
;其中CursorType参数若使用adok-adOpenDynamic将无法取得记录总数
(setq count (vlax-get-property rs 'RecordCount))
用LISP实现Windows选择目录对话框
方法一:
(defun BrowseForFolder (msg / WinShell hwnd shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq hwnd (vlax-get-property (vlax-get-acad-object) 'Hwnd))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder hwnd msg 1))
(setq catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit) nil path);if
);defun
方法二:
(defun BrowseForFolder (msg / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq ShlObj (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")
Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 msg 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
);if
);defun
用LISP实现CommonDialog对话框
;(CommonDialog_Show "Save Drawing As" "Drawing (*.dwg)|*.dwg|所有文件|*.*" 1)
;action = 1 (ShowOpen) 打开
;action = 2 (ShowSave) 保存
(defun CommonDialog_Show (title filter action / obj)
(vl-load-com)
(setq obj (vlax-create-object "MSComDlg.CommonDialog"))
(vlax-put-property obj "FileName" "未命名")
(vlax-put-property obj "MaxFileSize" 10000)
(vlax-put-property obj "DialogTitle" title)
(vlax-put-property obj "Filter" filter)
(vlax-put-property obj "Action" action)
(vlax-get-property obj "FileName")
)
原子转字符串
使用vl-prin1-to-string或vl-princ-to-string。
(vl-prin1-to-string 'aaa) 返回"AAA"
(vl-princ-to-string 'aaa) 返回"AAA"
VLISP编译器的监视窗口无法显示解决办法
删除
C:\Documents and Settings\用户名\Application Data\Autodesk\AutoCAD 2004\R16.0\enu（或chs）下的VLIDE_DS、VLIDE.DSK两个文件。
Getfiled用法VLISP编译器的监视窗口无法显示解决办法
选择多种类型的文件：
(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 8)) ;打开模式
(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 18)) ;保存打开模式
在命令行显示进度
(defun progress()
; Indicate progess on the command line.
(setq i 0)
(while (< i 10000)
; erase previous number
(setq j 0)
(while (< j (strlen (itoa i)))
; Hack: type a backspace!
;;; (princ "\010")
(setq j (1+ j))
)
(setq i (1+ i))
(princ i)
(princ)
)
)
AutoCAD2008激活错误解决
删除C:\Documents and Settings\All Users\Application Data\Autodesk\Software Licenses目录下的*.dat文件，然后重新使用注册机计算激活码，激活产品。
启动AutoCAD时出现下面对话框的解决办法
启动AutoCAD时出现Fail to get CommCntrController!的原因是： “通讯控制中心”出了问题，通讯中心会收集计算机的用户信息是发送到Autodesk,所以建议关闭，修改注册表内即可：
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:409\Applications\WSCommCntrAcCon]
"LOADER"="C:\\Program Files\\AutoCAD 2004\\WSCommCntrAcCon.arx"
"DESCRIPTION"="WSCommCntrAcCon"
"LOADCTRLS"=dword:00000000
LISP调用DOS命令
(command "shell" "c:\\test.bat")
Bat文件内容如:
Regsvr32.exe /s vbapi.dll
静态命令行提示
(prompt "\n正在处理,请稍候...")
(princ) ;如果不加这句,命令行不显示“正在处理,请稍候…”信息
LISP向MDB中添加记录注意事项:
;连接MDB
(OPL:DbInitADO)
(setq conn (OPL:DbConnection)
rs (OPL:DbRecordSet))
;打开mdb文件
(vlax-invoke-method conn "Open" (OPL:DbConnect_MSAccess2 mdbfile) "" "" adok-adModeUnknown)
;管线点属性表
(setq sql "SELECT * FROM 管线点属性表")
(vlax-invoke-method rs "Open" sql conn adok-adOpenStatic adok-adLockOptimistic adok-adCmdText)
;添加记录
(vlax-invoke-method rs 'AddNew)
(vlax-invoke-method rs 'Update) ;AddNew方法必须伴随Update,否则rs.Close会出错!!!
;释放对象
(OPL:DbCloseRecordSet rs)
(OPL:DbCloseConnection conn)
LISP控制PLINE命令:
(defun C:MYPOLY()
(command "_.PLINE")
(while (= (getvar "CMDNAMES") "PLINE")
(command pause)
)
(princ "\nEntity name of polyline: ")
(princ (entlast))
(princ)
)
LISP打开密码保护的mdb:
(setq adodll (strcat (getenv "systemdrive")
"\\Program Files\\Common Files\\System\\Ado\\msado15.dll"))
(if (and (null adom-Append)(findfile adodll))
(vlax-import-type-library
:tlb-filename adodll
:methods-prefix "adom-"
:properties-prefix "adop-"
:constants-prefix "adok-")
)
(defun c:test ( / conn rs fields rc)
(setq conn (vlax-create-object "ADODB.Connection"))
(setq rs (vlax-Create-Object "ADODB.RecordSet"))
(vlax-invoke-method
conn
"Open"
(strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
"c:\\aa.mdb"
";Jet OLEDB:Database Password=111111")
""
""
adok-adModeUnknown
)
(vlax-invoke-method
rs
"Open"
"SELECT * FROM test"
conn
adok-adOpenStatic
adok-adLockOptimistic
adok-adCmdText)
(while (= (vlax-Get-property rs "EOF") :vlax-false)
(setq fields (vlax-get-property rs 'Fields))
(setq rc (vlax-variant-value
(vlax-get-property
(vlax-get-property Fields 'Item "F1")
'Value)))
(alert rc)
(vlax-invoke-method rs 'MoveNext)
);while
(vlax-Invoke-Method rs "Close")
(vlax-Invoke-Method conn "Close")
)
LISP绘制多义线完整解决方案:
(defun DRAW_PLINE1 ( / PT LST STR)
(if (setq PT (getpoint "\n指定起点:"))
(progn
(command "_.PLINE" "NON" PT)
(setq LST (list PT))
(while (progn (if (= (length lst) 1)
(setq STR "\n下一点:")
(progn
(setq STR "\n下一点或[回撤(U)]:")
(initget "U")
)
);if
(setq PT (getpoint (car LST) STR))
)
(command "NON" PT)
(if (= PT "U")
(setq LST (cdr LST))
(setq LST (cons PT LST))
);if
);while
(command "")
)
);if
(princ)
)
(defun DRAW_PLINE2 ( / PT LST STR)
(if (setq PT (getpoint "\n指定起点:"))
(progn
(command "_.PLINE" "NON" PT)
(setq LST (list PT))
(while (progn (if (= (length lst) 1)
(setq STR "\n下一点:")
(progn
(setq STR "\n下一点或[闭合(C)/回退(U)]:")
(initget "C U")
)
);if
(if (/= PT "C")(setq PT (getpoint (car LST) STR)) nil)
)
(command "NON" PT)
(cond
((= PT "U")(setq LST (cdr LST)));
(T (setq LST (cons PT LST)));
);cond
);while
(if (not PT)(command ""))
)
);if
(princ)
)
LISP清除命令行窗口::
(repeat 50 (princ "\n"))(princ)
=====================================================================
分割文件路径
AutoCAD提供了fnsplitl函数，将文件完全路径字符串分解为包含3个字符串元素的表：（路径 文件名 扩展名），如：
(fnsplitl "C:\\Program Files\\AutoCAD 2004\\acad.exe")
返回
("C:\\Program Files\\AutoCAD 2004\\" "acad" ".exe")
在多文档间传递变量
Visual LISP函数(vl-propagate 'symbol)可以将符号变量传递到当前AutoCAD进程的所有文档中（包括已经打开的和后来打开的）。如：
(setq var 3)
(vl-propagate 'var)
那么其它文档中就可以使用var变量的值了。
对具有XDATA属性的实体作选择集
选择含扩展属性的实体，格式为：
(setq ss (ssget "cp" pts (list (list -3 '("APP"))(cons 0 "INSERT"))))
这里"APP"是扩展属性应用程序名，(cons 0 "INSERT")是其它过滤条件。
而目前在ARX程序中，仅能对应用程序名进行过滤。
应用ADO时如何取得记录总数
要注意CursorType的使用：
(setq conn (vlax-Create-Object "ADODB.Connection"))
(setq rs (vlax-Create-Object "ADODB.RecordSet"))
(vlax-invoke-method conn
"Open"
"provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\\test.mdb"
""
""
adok-adModeUnknown)
(vlax-invoke-method rs "Open" "SELECT * FROM mytable"
conn adok-adOpenStatic adok-LockOptimistic adok-adCmdText)
;其中CursorType参数若使用adok-adOpenDynamic将无法取得记录总数
(setq count (vlax-get-property rs 'RecordCount))
用LISP实现Windows选择目录对话框
方法一:
(defun BrowseForFolder (msg / WinShell hwnd shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq hwnd (vlax-get-property (vlax-get-acad-object) 'Hwnd))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder hwnd msg 1))
(setq catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit) nil path);if
);defun
方法二:
(defun BrowseForFolder (msg / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq ShlObj (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")
Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 msg 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
);if
);defun
用LISP实现CommonDialog对话框
;(CommonDialog_Show "Save Drawing As" "Drawing (*.dwg)|*.dwg|所有文件|*.*" 1)
;action = 1 (ShowOpen) 打开
;action = 2 (ShowSave) 保存
(defun CommonDialog_Show (title filter action / obj)
(vl-load-com)
(setq obj (vlax-create-object "MSComDlg.CommonDialog"))
(vlax-put-property obj "FileName" "未命名")
(vlax-put-property obj "MaxFileSize" 10000)
(vlax-put-property obj "DialogTitle" title)
(vlax-put-property obj "Filter" filter)
(vlax-put-property obj "Action" action)
(vlax-get-property obj "FileName")
)
原子转字符串
使用vl-prin1-to-string或vl-princ-to-string。
(vl-prin1-to-string 'aaa) 返回"AAA"
(vl-princ-to-string 'aaa) 返回"AAA"
VLISP编译器的监视窗口无法显示解决办法
删除
C:\Documents and Settings\用户名\Application Data\Autodesk\AutoCAD 2004\R16.0\enu（或chs）下的VLIDE_DS、VLIDE.DSK两个文件。
Getfiled用法VLISP编译器的监视窗口无法显示解决办法
选择多种类型的文件：
(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 8)) ;打开模式
(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 18)) ;保存打开模式
在命令行显示进度
(defun progress()
; Indicate progess on the command line.
(setq i 0)
(while (< i 10000)
; erase previous number
(setq j 0)
(while (< j (strlen (itoa i)))
; Hack: type a backspace!
;;; (princ "\010")
(setq j (1+ j))
)
(setq i (1+ i))
(princ i)
(princ)
)
)
AutoCAD2008激活错误解决
删除C:\Documents and Settings\All Users\Application Data\Autodesk\Software Licenses目录下的*.dat文件，然后重新使用注册机计算激活码，激活产品。
启动AutoCAD时出现下面对话框的解决办法
启动AutoCAD时出现Fail to get CommCntrController!的原因是： “通讯控制中心”出了问题，通讯中心会收集计算机的用户信息是发送到Autodesk,所以建议关闭，修改注册表内即可：
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:409\Applications\WSCommCntrAcCon]
"LOADER"="C:\\Program Files\\AutoCAD 2004\\WSCommCntrAcCon.arx"
"DESCRIPTION"="WSCommCntrAcCon"
"LOADCTRLS"=dword:00000000
LISP调用DOS命令
(command "shell" "c:\\test.bat")
Bat文件内容如:
Regsvr32.exe /s vbapi.dll
静态命令行提示
(prompt "\n正在处理,请稍候...")
(princ) ;如果不加这句,命令行不显示“正在处理,请稍候…”信息
LISP向MDB中添加记录注意事项:
;连接MDB
(OPL:DbInitADO)
(setq conn (OPL:DbConnection)
rs (OPL:DbRecordSet))
;打开mdb文件
(vlax-invoke-method conn "Open" (OPL:DbConnect_MSAccess2 mdbfile) "" "" adok-adModeUnknown)
;管线点属性表
(setq sql "SELECT * FROM 管线点属性表")
(vlax-invoke-method rs "Open" sql conn adok-adOpenStatic adok-adLockOptimistic adok-adCmdText)
;添加记录
(vlax-invoke-method rs 'AddNew)
(vlax-invoke-method rs 'Update) ;AddNew方法必须伴随Update,否则rs.Close会出错!!!
;释放对象
(OPL:DbCloseRecordSet rs)
(OPL:DbCloseConnection conn)
LISP控制PLINE命令:
(defun C:MYPOLY()
(command "_.PLINE")
(while (= (getvar "CMDNAMES") "PLINE")
(command pause)
)
(princ "\nEntity name of polyline: ")
(princ (entlast))
(princ)
)
LISP打开密码保护的mdb:
(setq adodll (strcat (getenv "systemdrive")
"\\Program Files\\Common Files\\System\\Ado\\msado15.dll"))
(if (and (null adom-Append)(findfile adodll))
(vlax-import-type-library
:tlb-filename adodll
:methods-prefix "adom-"
:properties-prefix "adop-"
:constants-prefix "adok-")
)
(defun c:test ( / conn rs fields rc)
(setq conn (vlax-create-object "ADODB.Connection"))
(setq rs (vlax-Create-Object "ADODB.RecordSet"))
(vlax-invoke-method
conn
"Open"
(strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
"c:\\aa.mdb"
";Jet OLEDB:Database Password=111111")
""
""
adok-adModeUnknown
)
(vlax-invoke-method
rs
"Open"
"SELECT * FROM test"
conn
adok-adOpenStatic
adok-adLockOptimistic
adok-adCmdText)
(while (= (vlax-Get-property rs "EOF") :vlax-false)
(setq fields (vlax-get-property rs 'Fields))
(setq rc (vlax-variant-value
(vlax-get-property
(vlax-get-property Fields 'Item "F1")
'Value)))
(alert rc)
(vlax-invoke-method rs 'MoveNext)
);while
(vlax-Invoke-Method rs "Close")
(vlax-Invoke-Method conn "Close")
)
LISP绘制多义线完整解决方案:
(defun DRAW_PLINE1 ( / PT LST STR)
(if (setq PT (getpoint "\n指定起点:"))
(progn
(command "_.PLINE" "NON" PT)
(setq LST (list PT))
(while (progn (if (= (length lst) 1)
(setq STR "\n下一点:")
(progn
(setq STR "\n下一点或[回撤(U)]:")
(initget "U")
)
);if
(setq PT (getpoint (car LST) STR))
)
(command "NON" PT)
(if (= PT "U")
(setq LST (cdr LST))
(setq LST (cons PT LST))
);if
);while
(command "")
)
);if
(princ)
)
(defun DRAW_PLINE2 ( / PT LST STR)
(if (setq PT (getpoint "\n指定起点:"))
(progn
(command "_.PLINE" "NON" PT)
(setq LST (list PT))
(while (progn (if (= (length lst) 1)
(setq STR "\n下一点:")
(progn
(setq STR "\n下一点或[闭合(C)/回退(U)]:")
(initget "C U")
)
);if
(if (/= PT "C")(setq PT (getpoint (car LST) STR)) nil)
)
(command "NON" PT)
(cond
((= PT "U")(setq LST (cdr LST)));
(T (setq LST (cons PT LST)));
);cond
);while
(if (not PT)(command ""))
)
);if
(princ)
)
LISP清除命令行窗口::
(repeat 50 (princ "\n"))(princ)
