CAD LISP 程序

1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(defunc:LL()(setvarcmdecho1)(setqen(ssget(list'(0.spline,arc,line,ellipse,LWPOLYLINE))))(setqi0)(setqll0)(repeat(sslengthen)(setqss(ssnameeni))(setqendata(entgetss))(commandlengthenss)(setqdd(getvarperimeter))(setqll(+ddll))(setqi(1+i)))(princ所选线条总长为：)(princll)(princ))2.标注所有线段(加载后只需框选所有线段便可得标注这些线段)(defunc:LLL()(COMMANDUCS)(setvarcmdecho1)(SETVAROSMODE0)(setqAcadObject(vlax-get-acad-object)AcadDocument(vla-get-ActiveDocumentAcadobject)mSpace(vla-get-ModelSpaceAcaddocument));;选取需要测量的样条曲线、圆弧、直线、椭圆(setqen(ssget(list'(0.spline,arc,line,ellipse,LWPOLYLINE))))(setqi0);;获取系统参数textsize(setqshh(getvartextsize))(setqstr_hh(strcat\n文字高度(rtosshh2):))(setqhh(getdiststr_hh))(whilehh(setvartextsizehh)(setqhhnil));;输入标注文字高度;;循环开始(repeat(sslengthen)(setqss(ssnameeni))(setqendata(entgetss))(commandlengthenss)(setqdd(getvarperimeter))(princ(strcat\n长度=(rtosdd2)));;寻找代表图层的字符串(setqaa(assoc0endata));;获取图层名称(setqaa1(cdraa));;判断线条种类(cond((=aa1SPLINE);;如果是spline(progn(setqarcObj(VLAX-ENAME-VLA-OBJECTss))(setqstartPnt1(vla-get-ControlPointsarcObj))(setqp1(vlax-safearray-list(vlax-variant-valuestartPnt1)))(setqx1(carp1))(setqy1(cadrp1))(setqz1(caddrp1))(setqpp1(listx1y1z1))(repeat(-(/(lengthp1)3)1);;循环，寻找最后一个控制点(setqp1(cdddrp1))(setqx2(carp1))(setqy2(cadrp1))(setqz2(caddrp1)))(setqpp2(listx2y2z2))))((=aa1LWPOLYLINE);;如果是LWPOLYLINE(progn(setqarcObj(VLAX-ENAME-VLA-OBJECTss))(setqstartPnt1(vla-get-CoordinatesarcObj))(setqp1(vlax-safearray-list(vlax-variant-valuestartPnt1)))(setqx1(carp1))(setqy1(cadrp1))(setqz1(caddrp1))(setqpp1(listx1y1z1))(repeat(-(/(lengthp1)3)1);;循环，寻找最后一个控制点(setqp1(cdddrp1))(setqx2(carp1))(setqy2(cadrp1))(setqz2(caddrp1)))(setqpp2(listx2y2z2))))(t;;如果是其他种类线条(progn(setqarcObj(VLAX-ENAME-VLA-OBJECTss))(setqstartPnt1(vla-get-StartPointarcObj));;获取起点(setqendPnt1(vla-get-EndPointarcObj));;获取终点(setqpp1(vlax-safearray-list(vlax-variant-valuestartPnt1)))(setqpp2(vlax-safearray-list(vlax-variant-valueendPnt1))))))(setqx1(carpp1))(setqy1(cadrpp1))(setqz1(caddrpp1))(setqx2(carpp2))(setqy2(cadrpp2))(setqz2(caddrpp2))(setqx(/(+x1x2)2))(setqy(/(+y1y2)2))(setqz(/(+z1z2)2))(setqpt(listxyz));;取得线段两端的中点(setqang(anglepp1pp2));;获取角度(if((*(/angpi)180)180)(setqang(+angpi)))(commandtextjbcpt(*(/angpi)180)(strcat(rtosdd2)))(setqi(1+i)))(prin1))(prompt\n在图中直接写出长度)(prin1)3.连续打断程序(defunc:br1()(commandbreakpausefpause@))4.将CAD文字导入Excel表格(defunc:Q2()(setqffn(getfiled写出文件xls1))(princ\n选取文字...)(setqss(ssget))(setqff(openffnw))(setqi0)(repeat(sslengthss)(setqssn(ssnamessi))(setqssdata(entgetssn))(setqsstyp(cdr(assoc0ssdata)))(if(or(=sstypTEXT)(=sstypMTEXT))(progn(setqtxt(cdr(assoc1ssdata)))(princtxtff)(princ\nff)))(setqi(1+i)))(closeff)(princ(strcat\n写出文件:ffn))(prin1))5删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.改颜色的LISP程序(defunc:c1()(ssget)(commandchproppc1)(princ))(defunc:c2()(ssget)(commandchproppc2)(princ))(defunc:c3()(ssget)(commandchproppc3)(princ))(defunc:c4()(ssget)(commandchproppc4)(princ))(defunc:c5()(ssget)(commandchproppc5)(princ))(defunc:c6()(ssget)(commandchproppc6)(princ))(defunc:c7()(ssget)(commandchproppc7)(princ))(defunc:c8()(ssget)(commandchproppc8)(princ))你用C1命令就可以将图元改为红色了.其余类似.删除红色图元(defunC:D1(/mAM)(setqm:err*error**error**merr*)(setvarcmdecho0)(commandUNDOG)(prompt选择图形)(setqA(ssget'((62.1))))(if(/=Anil)(progn(setqM(sslengthA))(commanderaseA)(princ\n共删除红色图元)(princM)(princ个)))(commandUNDOE)(princ))这样,键入D1命令,就可以删除红色的图元了.