两个CAD专用lisp程序

整理文档很辛苦,赏杯茶钱您下走!

免费阅读已结束,点击下载阅读编辑剩下 ...

阅读已结束,您可以下载文档离线阅读编辑

资源描述

直接显示面积和亩数命令:mj:复制以下代码(defunc:mj();;;;getareaA1(setqos(getvarosmode))(setqcmd(getvarcmdecho))(setvarosmode0)(setvarcmdecho0)(setqp1(getpoint\n请在要标注封闭区域内点一下:))(command-boundaryp1)(setqbj(entlast))(commandareaobjectbj)(entdelbj)(setqmj(rtos(getvararea)23))(setqarea1(strcatmj{\\fSimSun|b0|i0|c134|p2;平方米(}));;;;changetoA2(setqans(*(/(atofarea1)10000.0)15.0))(setqans(rtosans23))(setqarea2(strcatarea1ans{\\fSimSun|b0|i0|c134|p2;亩)}));;;;writeanswer(entmake(list'(0.MTEXT)'(100.AcDbEntity)'(100.AcDbMText)(cons10p1)(cons405)(cons410)(cons710)(cons500)'(72.5)(cons1area2)))(setvarosmodeos)(setvarcmdechocmd);;;(setq*error*olderr)(princ))结束(此处不要复制)线段自动连接命令:KK;线连接合并(以最小距离连接)(defunetype(ent/ename)(setqename(cdr(assoc0(entgetent))))(cond((=POLYLINEename)(if((cdr(assoc70(entgetent)))7)8(if(=0(logand1(cdr(assoc70(entgetent)))))15)))((=LWPOLYLINEename)(if(=0(logand1(cdr(assoc70(entgetent)))))25))((=LINEename)3)((=ARCename)4)((=CIRCLEename)6)((=INSERTename)7)(T9)));判断对象是否为顶点(用于多义线)(defunisvertex(ent);;'en'isentityname(if(=VERTEX(cdr(assoc0(entgetent))))(cdr(assoc70(entgetent)))));找出对象距离选择点的最近一个端点(defunnearvtx(entetpp/p1p2lrf)(cond((=1etp)(setqent(entnextent))(setqp1(cdr(assoc10(entgetent))))(setqent(entnextent))(while(/=nil(setqf(isvertexent)))(setqlentent(entnextent)))(setqp2(cdr(assoc10(entgetl))))(if((distancep1p)(distancep2p))p2p1))((=2etp)(setqp1(cdr(assoc10(entgetent))))(setqp2(cdr(assoc10(reverse(entgetent)))))(if((distancep1p)(distancep2p))p2p1))((=3etp)(progn(setqent(entgetent))(setqp1(cdr(assoc10ent))p2(cdr(assoc11ent)))(if((distancep1p)(distancep2p))p2p1)))(T(progn(setqent(entgetent))(setql(cdr(assoc10ent))r(cdr(assoc40ent)))(setqp1(polarl(cdr(assoc50ent))r))(setqp2(polarl(cdr(assoc51ent))r))(if((distancep1p)(distancep2p))p2p1)))));主程序,对线进行连接(defunC:KK(/oldechooldsnapoldorthoenlersngcdpittp1p2)(setvarcmdecho0);指令执行过程不响应(PRINC\n以最小距离,线连接合并)(PRINC)(while(setqoldecho(getvarcmdecho))(setqoldsnap(getvarosmode))(setvarosmode0)(setqoldortho(getvarorthomode))(setvarorthomode0)(if(setqen(entsel\n--请选择进行连接的线(不需要变化的线):))(progn(while(4(setql(etype(caren))))(cond((=5l)(princ\n--不能选择闭合的线))((=8l)(princ\n--不能选择三维多义线))(T(princ\n--所选对象不是线)))(while(not(setqen(entsel\n--请重新选择进行连接的线(不需要变化的线):)))(princ\n--未选择对象)))(while(not(setqe(entsel\n--请选择去连接的线:)))(princ\n未选择对象))(while(4(setqr(etype(care))))(cond((=5l)(princ\n--不能选择闭合的线))((=8l)(princ\n--不能选择三维多义线))(T(princ\n--所选对象不是线)))(while(not(setqe(entsel\n--请重新选择去连接的线:)))(princ\n--未选择对象)))(setqs(entget(caren)))(setqn(cdr(assoc10s)))(setqg(caddrn))(setqc(entget(care)))(setqd(cdr(assoc10c)))(setqp(caddrd))(setqi(list00g))(setqtt(list00p))(commandmove(care)tti)(setqp1(nearvtx(caren)l(cadren)))(setqp2(nearvtx(care)r(cadre)))(if(l2)(progn(commandPEDIT(caren)YX)(setqen(entlast))))(if(not(equalp1p2))(commandPLINEp1p2))(commandpeditenjenL(care)))(princ\n--未选择对象,退出。))(setvarcmdechooldecho)(setvarosmodeoldsnap)(setvarorthomodeoldortho))(princ)(prin1)(PRINC\n线连接合并完成!)(PRINC))结束(此处不要复制)

1 / 5
下载文档,编辑使用

©2015-2020 m.777doc.com 三七文档.

备案号:鲁ICP备2024069028号-1 客服联系 QQ:2149211541

×
保存成功