编程档案之LISP

王咣生 发表于 2007-12-29 21:27:00

(By:王咣生)目录:<a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206641">分割文件路径... 1</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206642">在多文档间传递变量... 1</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206644">对具有XDATA属性的实体作选择集... 2</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206645">应用ADO时如何取得记录总数... 2</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206646">用LISP实现Windows选择目录对话框... 3</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206647">用LISP实现CommonDialog对话框... 3</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206648">原子转字符串... 4</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206649">VLISP编译器的监视窗口无法显示解决办法... 4</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206650">Getfiled用法VLISP编译器的监视窗口无法显示解决办法... 4</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206651">在命令行显示进度... 4</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206652">AutoCAD2008激活错误解决... 5</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206653">启动AutoCAD时出现下面对话框的解决办法... 5</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206654">LISP调用DOS命令... 5</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206655">静态命令行提示... 5</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206656">LISP向MDB中添加记录注意事项:
6</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206657">LISP控制PLINE命令:
6</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206658">LISP打开密码保护的mdb:
6</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206659">LISP绘制多义线完整解决方案:
8</a><a href="http://www.mjtd.com/bbs/post.asp?action=new&boardid=16#_Toc186206660">LISP清除命令行窗口::
9</a><h2 style="MARGIN: 13pt 0cm;"> </h2><h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206641">分割文件路径</a></h3>AutoCAD提供了fnsplitl函数，将文件完全路径字符串分解为包含3个字符串元素的表：（路径
文件名
扩展名），如：(fnsplitl "C:\\Program Files\\AutoCAD 2004\\acad.exe")返回("C:\\Program Files\\AutoCAD 2004\\" "acad" ".exe")<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206642"></a><a name="_Toc154244316">在多文档间传递变量</a></h3>Visual LISP函数(vl-propagate 'symbol)可以将符号变量传递到当前AutoCAD进程的所有文档中（包括已经打开的和后来打开的）。如：(setq var 3)(vl-propagate 'var)那么其它文档中就可以使用var变量的值了。<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206644"></a><a name="_Toc154244318">对具有</a>XDATA属性的实体作选择集</h3>选择含扩展属性的实体，格式为：(setq ss (ssget "cp" pts (list (list -3 '("APP"))(cons 0 "INSERT"))))这里"APP"是扩展属性应用程序名，(cons 0 "INSERT")是其它过滤条件。而目前在ARX程序中，仅能对应用程序名进行过滤。 <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206645"></a><a name="_Toc154244319">应用</a>ADO时如何取得记录总数</h3>要注意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)) <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206646">用</a>LISP实现Windows选择目录对话框</h3>方法一:(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<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206647">用</a>LISP实现CommonDialog对话框</h3>;(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"))<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206648">原子转字符串</a></h3>使用vl-prin1-to-string或vl-princ-to-string。(vl-prin1-to-string 'aaa)         返回"AAA"(vl-princ-to-string 'aaa)         返回"AAA" <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206649">VLISP</a>编译器的监视窗口无法显示解决办法</h3>删除C:\Documents and Settings\用户名\Application Data\Autodesk\AutoCAD 2004\R16.0\enu（或chs）下的VLIDE_DS、VLIDE.DSK两个文件。 <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206650">Getfiled</a>用法VLISP编译器的监视窗口无法显示解决办法</h3>选择多种类型的文件：(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 8))   ;打开模式(setq file (getfiled "选择需要提取信息的文件" "" "dat;txt" 18))
;保存打开模式<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206651">在命令行显示进度</a></h3>(defun progress(); Indicate progess on the command line.        (setq i 0)       (while (              ; 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)       ) )<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206652">AutoCAD2008</a>激活错误解决</h3>删除C:\Documents and Settings\All Users\Application Data\Autodesk\Software Licenses目录下的*.dat文件，然后重新使用注册机计算激活码，激活产品。 <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206653">启动</a>AutoCAD时出现下面对话框的解决办法</h3>启动AutoCAD时出现Fail to get CommCntrController!的原因是：
“通讯控制中心”出了问题，通讯中心会收集计算机的用户信息是发送到Autodesk,所以建议关闭，修改注册表内即可：Windows Registry Editor Version 5.00 "LOADER"="C:\\Program Files\\AutoCAD 2004\\WSCommCntrAcCon.arx""DESCRIPTION"="WSCommCntrAcCon""LOADCTRLS"=dword:00000000<shapetype id="_x0000_t75" stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" opreferrelative="t" ospt="75" coordsize="21600,21600"><stroke joinstyle="miter"></stroke><formulas><f eqn="if lineDrawn pixelLineWidth 0"></f><f eqn="sum @0 1 0"></f><f eqn="sum 0 0 @1"></f><f eqn="prod @2 1 2"></f><f eqn="prod @3 21600 pixelWidth"></f><f eqn="prod @3 21600 pixelHeight"></f><f eqn="sum @0 0 1"></f><f eqn="prod @6 1 2"></f><f eqn="prod @7 21600 pixelWidth"></f><f eqn="sum @8 21600 0"></f><f eqn="prod @7 21600 pixelHeight"></f><f eqn="sum @10 21600 0"></f></formulas><path oconnecttype="rect" gradientshapeok="t" oextrusionok="f"></path><lock aspectratio="t" vext="edit"></lock></shapetype><shape id="_x0000_i1025" type="#_x0000_t75" style="WIDTH: 173.25pt; HEIGHT: 92.25pt;"><imagedata otitle="" src="file:///C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\msohtml1\01\clip_image001.png"></imagedata></shape> <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206654">LISP</a>调用DOS命令</h3>(command "shell" "c:\\test.bat")Bat文件内容如:       Regsvr32.exe /s vbapi.dll<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206655">静态命令行提示</a></h3>      (prompt "\n正在处理,请稍候...")      (princ)
;如果不加这句,命令行不显示“正在处理,请稍候…”信息<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206656">LISP</a>向MDB中添加记录注意事项:</h3>  ;连接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)<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206657">LISP</a>控制PLINE命令:</h3> (defun C:MYPOLY()  (command "_.PLINE")  (while (= (getvar "CMDNAMES") "PLINE")    (command pause)  )  (princ "\nEntity name of polyline: ")  (princ (entlast))  (princ))<h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206658">LISP</a>打开密码保护的mdb:</h3>  (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"))     <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206659">LISP</a>绘制多义线完整解决方案:</h3>  (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))   <h3 style="MARGIN: 13pt 0cm;"><a name="_Toc186206660">LISP</a>清除命令行窗口::</h3>(repeat 50 (princ "\n"))(princ)

vladimirputin 发表于 2016-10-20 10:56:13

谢谢楼主分享这么好的程序，真是太感谢了。

gvtutewang 发表于 2020-11-23 20:51:24

非常好的东东。。。大力支持。。。。

yjc 发表于 2008-5-2 17:22:00

谢谢您，辛苦学习了

caoyin 发表于 2008-5-12 00:15:00

本帖最后由作者于 2008-5-12 0:18:16 编辑

好东西！！斑竹是个有心胸、诲人不倦的高手，有此同感的献花！！！

英雄无敌 发表于 2008-5-29 10:21:00

感谢分享，很多是CAD帮助中没有的

pvcad 发表于 2008-9-10 08:43:00

很有用的代码,谢谢斑竹!

samshs 发表于 2008-12-23 18:37:00

感谢分享學習一下

jxphklibin 发表于 2009-1-7 10:29:00

楼主的资料很好，希望大家能补充更多的函数上来！

qcw911 发表于 2010-11-18 21:29:00

<a target="_blank" name="_Toc186206659">LISP</a>绘制多义线完整解决方案 非常经典

another2121 发表于 2010-11-20 19:09:00

非常好的东东。。。大力支持。。。。

自贡黄明儒 发表于 2010-11-21 20:54:00

(vl-prin1-to-string 'aaa)仅这一句,我想了很久,认为lisp没有这功能呢

页: [1] 2 3

明经CAD社区's Archiver

编程档案之LISP