用VLISP开发cad的批量处理框架

下面为框架的代码：(arxload"acetutil.arx"NIL);;需要相应版本的ET(ExpressTools)工具支持(vl-load-com)(defunc:GText(/OLDECHAPPDWGNApOE2numdwgnameOLDIdSPent);;主程序定义(setqOLDECHOetvar"cndecho"));;保存系统变量值(setvar"cmdecho0)(setqpath(strcat(vl-string-right-trim"\\"(strcase(acet-ui-pickdir”选择目录”(vl-string-right-trim"\\"(getvar"dwgprefix"))"批量修改”)))"\\"))(setqOLDLSPgetvar"ACADLSPAOD'));;保存系统变量值(setvar"acadlspasdoc"0)(setqdwgnamevl-directory-filespath"*.DVG"))(setqnum0)(if(/=dwgnameiL)(progn(setqAPP(vlax-get-acad-object));获得Acad对象(repeat(lengthdwgname)(setqDWGNAM；E2rcase(strcatpath(nthnumdwgname))))(setqdoc(vla-open(vla-get-documentsAPP)D/GNAME2)打开图形并获得其对象;;以下用省略号代表具体处理程序，用户可在此处添加自己所需的处理的代码。;; …;; …(vla-closedoc:vlax-false);关闭图形(不检查是否保存)(setqnum(1+num)))(vlax-release-objectdoc)(vlax-release-objectAPP))(prompt"\n所选目录中未有任何图形 !!"))(setvar"acadlspasdoc"CLDLSP);;恢复系统变量值(setvar"cmdechoOLDECQd;;恢复系统变量值(princ))应用实例：1•将框架中的省略号换为如下三行即可实现图纸的批量清理(repeat5(vla-purgeallDOC(vla-saveDOC);保存图形(promp(strcat"\n"DWGNME2"＜PURG完成＞!!!"))2•将框架中的省略号换为如下几行即可实现图纸中图层颜色的批量修改(vlax-forENT_LAYvla-get-layersDCC)(vla-put-colorENT_LAYOL))(vla-saveDCC)(prompt(strcat"\n"DWNAM2"＜修改图层颜色完成＞!!!"))其中CO为要修改的颜色代码变量，可将其作为主程序的参数。主程序的定义行改为：(defunCHCOLOCO)用法：(CHCOLORcad_colordlg7))或(CHCOLOR3•将框架中的省略号换为如下几行即可实现图纸中字符串的替换，可用于批量工程名称的修改。(setqmsp(vla-get-ModelSpcedoc))(vlax-forENTmsp(if(and(vlax-property-available-pENT'TEXTSTRING)(wcmatch(setqSTR(vla-get-textstringENT)(strcat"*"OLDTXT*")))(progn(setqSTR(vl-string-substNEWTXTLDTXST))(vla-put-textstringENTSR))))(vla-saveDOC)(prompt(strcat"\n"DWGNAME2修改Text完成>!!!"))其中NEWTXOLDTX分别为的新旧文字，可将其作为主程序的参数。主程序的定义行改为：(defunCH_TXT(NEWTXLDTX用法：(CH_TX，AAA"BBB")4•将框架中的省略号换为如下代码，实现将图形种特定层(本例为"DATA”层)的字符串按顺序写入文件text.txt中，该程序用于我单位的一个材料统计软件中，可将图形中的材料表内容写入文本文件中。(setqmsp(vla-get-ModelSpcedoc))(vlax-forentmsp(if(and(="DAT"(vla-get-layerent))(vlax-property-available-pENT'TEXTSTNG)(progn(setqtext(vla-get-TextStringent))(setqpt(list(vlax-safearray-get-elenent(vlax-variant-value(vla-get-Insertionpointent))0)(vlax-safearray-get-elenent(vlax-variant-value(vla-get-Insertionpointent))1)(vlax-safearray-get-elenent(vlax-variant-value(vla-get-Insertionpointent))2)))(setqtlist(appendtlist(list(appendpt(listtext))))))))(setql(lengthtlist))(setqi1)(while(<il)(setqji)(while(<jl)(setqy1(cadr(nth(1-i)tlist)))(setqy2(cadr(nthjtlist)))(if(and(<y1y2)(>(abs(-y2y1))1))(progn(setqm0)(setqtlist2nil)(while(<ml)(if(=m(1-i))(setqtlist2(appendtlist2(list(nthjtlist))))(progn(if(=mj)(setq tlis t2(appendtlist 2(list (nth (1-i)tlist))))(setq tlis t2(appendtlist 2(list (nth mtlist)))))))(setqm(1+m)))(setqtlisttlist2))(progn(setqx1(car(nth(1-i)tlist)))(setqx2(car(nthjtlist)))(if(and(<x2x1)(>(abs(-x1x2))2)(<(abs(-y2y1))1))(progn(setqm0)(setqtlist2nil)(while(<ml)(if(=m(1-i))(setqtlist2(appendtlist2(list(nthjtlist))))(progn(if(=mj)(setq tli st2 (appendtlis t2(list (nth(1-i)tlist))))(setq tli st2 (appendtlis t2(list (nthmtlist)))))))(setqm(1+m)))(setqtlisttlist2)))(setqj(1+j)))(setqi(1+i)))(if(>l0)(progn(setqfn(open(strcat(getvar"dwgorefix")"text.txt")"r"))(iffn(progn(closefn)(setqfn(open(strcat(getvar"dwgprefix")"text.txt")"a")))(setqfn(open(strcat(getvar"dwgprefix")"text.txt")"w")))(setqi0)(while(<il)(setqone"")(setqstr(cadddr(nthitlist)))(princstrfn)(if(<i(1-l))(princ","fn))(setqi(1+i)))(princ"\n"fn)(closefn)(setqtlistnil)(prompt"\n该图中的data层的数据已写入文件text.txt中!")))从上面的这些例子可看出利用该批量处理框架可以完成许多工作用户可编制自己的处理程序实现所需的功能，极大的提高工作效率。这是本人的一点编程心得，供大家参考。注：本文程序的执行需先安装AutoCAD相应版本的Expresstools工具。文件说明：Visual