编程档案之LISP

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

(By:王咣生)

分割文件路径... 1

在多文档间传递变量... 1

对具有XDATA属性的实体作选择集... 2

应用ADO时如何取得记录总数... 2

用LISP实现Windows选择目录对话框... 3

用LISP实现CommonDialog对话框... 3

原子转字符串... 4

VLISP编译器的监视窗口无法显示解决办法... 4

Getfiled用法VLISP编译器的监视窗口无法显示解决办法... 4

在命令行显示进度... 4

AutoCAD2008激活错误解决... 5

启动AutoCAD时出现下面对话框的解决办法... 5

分割文件路径

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)

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

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

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

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

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

谢谢您，辛苦学习了

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

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

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

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

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

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

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

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

感谢分享學習一下

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

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

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

LISP绘制多义线完整解决方案非常经典

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

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

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

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

账号		自动登录	找回密码
密码			注册