高程点计算土石方量lisp程序源码

;;;»ñÈ¡¶àÒåÏ߶¥µã;;;Code:(vl-load-com)(defunc:nihe();;;ÌáÈ¡ÄâºÏ·¶Î§(setvarcmdecho0)(setqosmode-save(getvarOSMODE))(setvarOSMODE0);;;(setvarbilpmode1)(setqf1(getfiledabcd:/txt1))(setqf1(openf1w))(setqent(car(entsel\nÑ¡È¡·¶Î§½çÏß:)))(setqjd-lstnil);;½¨Á¢¸ñÍøÓë±ß½ç½»µã±í2d(setqptlst(get-ploy-versent));;;È¡ptlstÖÐxy¼«ÖµµÄ·½·¨(setqxmax(apply'max(mapcar'carptlst))xmin(apply'min(mapcar'carptlst))ymax(apply'max(mapcar'cadrptlst))ymin(apply'min(mapcar'cadrptlst)))(setqdx(getreal\n·½¸ñÍø±ß³¤:)half-dx(/dx2.0))(setqdydx)(commandoffsetdxent(list(+xmax2)(+ymax3)))(setqent2(entlast))(setqptlst2(get-ploy-versent2))(entdelent2)(setqlname(getstring\nÊäÈëͼ²ãÃû:))(setqss0(ssgetCPptlst2(list(cons8lname))))(ifss0(progn(setqslen(sslengthss0))(setqss-lstnil))(exit))(setqbgcolor130)(setqzsumcolor6)(setqlinecolor7)(setqvcolor30)(setqi0)(while(islen)(setqe1(ssnamess0i))(setqpt(cdr(assoc10(entgete1))))(setqss-lst(consptss-lst));;;(printptf1)(setqi(1+i)));;;(setqx0(+xminhalf-dx))(setqx00(-xminhalf-dx);;;»æÖÆ×ø±êÖµÓÃy00(-yminhalf-dx))(setqx0x00)(while(x0xmax)(setqpt1(listx0ymin)pt2(listx0ymax));;;¼ÆËãÖ±Ïßpt1pt2Óë¶à±ßÐεĽ»µã²¢ÅÅÐò(setqcpt(get-crossptptlstpt1pt2x))(ifcpt(setqjd-lst(appendcptjd-lst)))(if(and(=(lengthcpt)2)(=(rem(lengthcpt)2)0))(progn(while(/=cptnil)(setqpmin(carcpt)cpt(cdrcpt)pmax(carcpt)cpt(cdrcpt))(get-point-nihepmindxss-lst)(commandcolorlinecolor);;;(commandlinepminpmax)(progn(setqy0(cadrpmin)ym(cadrpmax)x0(carpmin))(setqyushu(rem(-y0y00)dy)cha(-dyyushu))(setqy0(+y0cha))(while(y0ym)(setqpt0(listx0y0));;;(printpt0f1)(get-point-nihept0dxss-lst)(setqy0(+y0dy))));;;endprogn(get-point-nihepmaxdxss-lst));;;endwhile);;;endifprogn)(setqx0(+x0dx)));;;¼ÆËã½»µã»æºáÖᣬͬʱÄâºÏÊ×β½»µã;;;(setqx0(+xminhalf-dx))(setqx00(-xminhalf-dx);;;»æÖÆ×ø±êÖµÓÃy00(-yminhalf-dx))(setqy0y00);;;(setqy0(+y00dx))(while(y0ymax)(setqpt1(listxminy0)pt2(listxmaxy0))(setqcpt(get-crossptptlstpt1pt2y))(ifcpt(setqjd-lst(appendcptjd-lst)))(if(and(=(lengthcpt)2)(=(rem(lengthcpt)2)0))(progn(while(/=cptnil)(setqpmin(carcpt)cpt(cdrcpt)pmax(carcpt)cpt(cdrcpt))(get-point-nihepmindxss-lst)(commandcolorlinecolor);;;(commandlinepminpmax)(get-point-nihepmaxdxss-lst));;;endwhile);;;endifprogn)(setqy0(+y0dy)));;;ÍâΧÂÖÀª½»µãÄâºÏ(setqjd-lst(appendptlstjd-lst))(foreachptptlst(get-point-niheptdxss-lst));;;ÄâºÏ¹ý³Ì½áÊø£»£»£»£»£»£»£»£»£»£»£»£»£»£»;;;½»µã±íÔªËض¨Î»£º;;;(setqx0x00);;;(while(x0xmax);;;(setqy0y00);;;ÍÁ·½Á¿¼ÆË㿪ʼ(setqrectangle-layer0);;(getstring\nÊäÈë¸ñÍø¸ß³ÌËùÔÚͼ²ã:))(setqbg(getreal\nÊäÈëÉè¼Æ±ê¸ß:))(setqx0x00)(setqvsum0.0)(setqm-num0m-zong0.0)(while(x0xmax)(setqy0y00)(setqsy0.0);;ÁÐÌå»ýÇóºÍ(while(y0ymax)(setqleft-bottom-pt(listx0y0)centerpt(list(+x0half-dx)(+y0half-dx)))(commandcolorGREEN)(setqptlst2(reverse(cons(consc(reverse(consplineptlst))))))(mapcar'commandptlst2)(setqr1(entlast))(commandregionr1)(setqr1(entlast));;;ÐγÉÒƶ¯·½¿ò(setqrectangle-lst(make-rectangle-listleft-bottom-ptdx))(setqrectangle-lst2(reverse(cons(consc(reverse(consplinerectangle-lst))))))(mapcar'commandrectangle-lst2)(setqr2(entlast))(commandregionr2)(setqr2(entlast))(commandintersectr1r2)(setqjj(entlast))(commandareaojj)(ifjj(setqarea(getvarAREA)));;;CPÑ¡ÔñÓë·½¿òÏཻºÍ±»°üΧµÄʵÌå(setqss0nil)(setqss0(ssgetCPrectangle-lst))(if(/=ss0nil)(progn(setqlen(sslengthss0))(setqi0ss-lstnile1nil);;;¹ýÂ˳öÄâºÏµãÊý¾Ý±£´æÔÚss-lstÖÐ(while(ilen)(setqe1(ssnamess0i))(setqpt(cdr(assoc10(entgete1))))(setqx(carpt)y(cadrpt));;;Èç¹ûʵÌåÔÚÄâºÏ¸ß³ÌµãËùÔڲ㡢¿éÃû³ÆΪ¡°gcwu¡±¸ß³ÌÎó²î£¬Ôò¼ÓÈëÑ¡Ôñ¼¯(if(and(=(cdr(assoc8(entgete1)))rectangle-layer)(=(cdr(assoc0(entgete1)))INSERT)(=(cdr(assoc2(entgete1)))gcwc))(if(or(and((abs(-xx0))0.001)((abs(-yy0))0.001));;left-bottom(and((abs(-x(+x0dx)))0.001)((abs(-yy0))0.001));;rigth-bottom(and((abs(-x(+x0dx)))0.001)((abs(-y(+y0dx)))0.001));;rigth-top(and((abs(-xx0))0.001)((abs(-y(+y0dx)))0.001));;left-top(and((abs(-xx0))0.001)(and(yy0)(y(+y0dx))));;onx0edge(and((abs(-x(+dxx0)))0.001)(and(yy0)(y(+y0dx))));;onx0+dxedge(and(and(xx0)(x(+x0dx)))((abs(-yy0))0.001));;ony0edge(and(and(xx0)(x(+x0dx)))((abs(-y(+y0dx)))0.001));;ony0+dxedge(and(and(xx0)(x(+x0dx)))(and(yy0)(y(+y0dx))));;intherectangle)(setqss-lst(conse1ss-lst))))(setqi(1+i))));;;(setqlen0))(setqlen(lengthss-lst))(if(=len3)(progn;;;//////////////////////////////////////////////////////////////////////////////////////;;;ÇóÃæ»ý¼°¸ß³Ì¾ùÖµ;(setqi0len(lengthss-lst)zsum0.0v2sum0.0)(setqunit-m0.0)(while(ilen)(setqe1(nthiss-lst))(setqpt(cdr(assoc10(entgete1))))(setqlst(VxGetAttse1));;¸ß³ÌÇóºÍ(setqzsum(+zsum(caddrpt)));;Îó²îƽ·½ÇóºÍ(setqvi(atof(cdr(assocWClst))))(setqv2sum(+v2sum(*vivi)))(setqi(1+i)));;ƽ¾ù¸ß(setqzsum(/zsumlen));;Çó¸ñÍøµ¥ÔªÖÐÎó²î(setqunit-m(sqrt(/v2sumlen)))(commandcolorzsumcolor)(commandtextJBR(list(+x0dx)y0)(*(/4.0100.0)dx)0(strcat¾ù¸ß=(rtoszsum22)))(commandcolorbgcolor)(commandtextJTR(list(+x0dx)y0)(*(/5.0100.0)dx)0(strcatÉè¼Æ=(rtosbg22)))(commandcolorYELLOW)(commandtextJTL(listx0y0)(*(/5.0100.0)dx)0(strcatÎó²î=(rtosunit-m22)))(setqm-num(1+m-num))(setqm-zong(+m-zong(*unit-munit