利用VLISP开发AutoCAD下的批量图纸处理框架

1、利用Visual LISP开发AutoCAD下的图纸批量处理程序张子引摘要 本文介绍了如何用Visual LISP语言编制AutoCAD下的图纸批量处理程序的框架及其应用实例。关键词 Visual LISP 图纸批量处理 Active X在工程设计各专业中，AutoCAD以其强大的图形支撑能力和开放的结构体系，无可争辩地成为CAD市场的龙头，几乎在工程设计的每个专业都有应用。随着时间的积累，每一个工程制图人员手上都积累了大量的图纸，对图纸批量处理的需求日显迫切，随着AutoCAD 2000 及2002版的推出，AutoCAD全面支持多文档处理，autoLISP语言也升级为Visual LISP

2、，增加了对Active X的支持，大大增强了autoLISP语言的处理能力，为批量图形处理的编程实现创造了条件。我参考多方的资料和Active X帮助文档编制了图纸批量处理框架，该框架在AutoCAD的多文档支持下，利用Active X技术打开图形并获得图形对象，对其进行处理，处理完成后将图形关闭再打开下一张图形，依次进行完成批量处理。上述处理过程中应注意在批量处理框架内打开的图形不能激活为当前图形，否则会造成自动化过程失败（automation failed），因为Visual LISP程序本身不能跨图档执行，实现批量处理的实质是利用Active X技术将其它图形作为对象进行处理。下面为框架

3、的代码：(arxload acetutil.arx NIL) ;需要相应版本的ET（Express Tools）工具支持 (vl-load-com)(defun c:GText (/ OLDECHO APP DWGNAME2 path num dwgname OLDLSP doc ent );主程序定义(setq OLDECHO (getvar cmdecho);保存系统变量值(setvar cmdecho 0)(setq path(strcat(vl-string-right-trim(strcase (acet-ui-pickdir选择目录(vl-string-right-trim (ge

4、tvar dwgprefix) 批量修改)(setq OLDLSP (getvar ACADLSPASDOC);保存系统变量值(setvar acadlspasdoc 0)(setq dwgname (vl-directory-files path *.DWG)(setq num 0)(if (/= dwgname NIL)(progn(setq APP (vlax-get-acad-object);获得Acad 对象(repeat (length dwgname)(setq DWGNAME2 (strcase (strcat path (nth num dwgname)(setq doc (

5、vla-open (vla-get-documents APP) DWGNAME2);打开图形并获得其对象;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。 ; ; (vla-close doc :vlax-false);关闭图形(不检查是否保存)(setq num (1+ num)(vlax-release-object doc)(vlax-release-object APP)(prompt n所选目录中未有任何图形!)(setvar acadlspasdoc OLDLSP);恢复系统变量值(setvar cmdecho OLDECHO) ;恢复系统变量值(princ)

6、应用实例：1将框架中的省略号换为如下三行即可实现图纸的批量清理(repeat 5 (vla-purgeall DOC)(vla-save DOC);保存图形(prompt (strcat n DWGNAME2 !)2将框架中的省略号换为如下几行即可实现图纸中图层颜色的批量修改(vlax-for ENT_LAY (vla-get-layers DOC)(vla-put-color ENT_LAY COL)(vla-save DOC)(prompt (strcat n DWGNAME2 !)其中COL为要修改的颜色代码变量，可将其作为主程序的参数。主程序的定义行改为：(defun CHCOLOR

7、(COL)用法： (CHCOLOR (acad_colordlg 7)或 (CHCOLOR 7)3将框架中的省略号换为如下几行即可实现图纸中字符串的替换，可用于批量工程名称的修改。(setq msp (vla-get-ModelSpace doc)(vlax-for ENT msp(if (and (vlax-property-available-p ENT TEXTSTRING)(wcmatch (setq STR (vla-get-textstring ENT)(strcat * OLDTXT *)(progn(setq STR (vl-string-subst NEWTXT OLDTXT

8、 STR)(vla-put-textstring ENT STR)(vla-save DOC)(prompt (strcat n DWGNAME2 !)其中NEWTXT OLDTXT分别为的新旧文字，可将其作为主程序的参数。主程序的定义行改为：(defun CH_TXT(NEWTXT OLDTXT)用法： (CH_TX AAA BBB)4将框架中的省略号换为如下代码，实现将图形种特定层（本例为“DATA”层）的字符串按顺序写入文件text.txt中，该程序用于我单位的一个材料统计软件中，可将图形中的材料表内容写入文本文件中。(setq msp (vla-get-ModelSpace doc)(

9、vlax-for ent msp(if (and (= DATA (vla-get-layer ent)(vlax-property-available-p ENT TEXTSTRING)(progn(setq text (vla-get-TextString ent)(setq pt(list(vlax-safearray-get-element(vlax-variant-value (vla-get-Insertionpoint ent)(vlax-safearray-get-element(vlax-variant-value (vla-get-Insertionpoint ent)1)

10、(vlax-safearray-get-element(vlax-variant-value (vla-get-Insertionpoint ent)2)(setq tlist (append tlist (list (append pt (list text)(setq l (length tlist)(setq i 1)(while ( i l)(setq j i)(while ( j l)(setq y1 (cadr (nth (1- i) tlist)(setq y2 (cadr (nth j tlist)(if (and ( (abs (- y2 y1) 1)(progn(setq

11、m 0)(setq tlist2 nil)(while ( m l)(if (= m (1- i)(setq tlist2 (append tlist2 (list (nth j tlist)(progn(if (= m j)(setq tlist2 (append tlist2 (list (nth (1- i) tlist) (setq tlist2 (append tlist2 (list (nth m tlist) )(setq m (1+ m)(setq tlist tlist2)(progn(setq x1 (car (nth (1- i) tlist)(setq x2 (car

12、(nth j tlist)(if(and ( (abs (- x1 x2) 2) ( (abs (- y2 y1) 1) (progn(setq m 0)(setq tlist2 nil)(while ( l 0)(progn(setq fn (open (strcat (getvar dwgprefix) text.txt) r) (if fn(progn(close fn)(setq fn (open (strcat (getvar dwgprefix) text.txt) a) )(setq fn (open (strcat (getvar dwgprefix) text.txt) w)

13、 )(setq i 0)(while ( i l)(setq one )(setq str (cadddr (nth i tlist)(princ str fn)(if ( i (1- l) (princ , fn)(setq i (1+ i)(princ n fn)(close fn)(setq tlist nil)(prompt n该图中的data层的数据已写入文件text.txt中!)从上面的这些例子可看出利用该批量处理框架可以完成许多工作，用户可编制自己的处理程序实现所需的功能，极大的提高工作效率。这是本人的一点编程心得，供大家参考。注：本文程序的执行需先安装AutoCAD相应版本的Express tools 工具。参考文献孙江宏 丁立伟 著 Visual LISP R142000编程与应用 科学出版社 1999二代龙震工作室 编著 AutoCAD LISP/VLISP 函数库查询词典 中国铁道出版社 2003文件说明：Visual L