【悬赏！！！】画多段线打断于交点处
本帖最后由 yeahyeah 于 2013-8-21 21:23 编辑昨晚看到一个很好的帖子《求画直线相交断己》，也看到了G版老师的程序。昨晚内心欣喜之情真是说不出来的好。
我是做建筑工程电气电信设计的，画施工图时，常常会遇到管线“交叉”（其实是交点处交叉分层布置）的情况，所以画多段线打断于交点处这样的程序真是饥渴啊。
由于G版的原程序是不包括处理多段线的，我就在他的程序的基础上，试着改了下（我改的程序见二楼），结果遇到些很棘手的问题。
我才学LISP没到一个月，能力实在有限，现特悬赏征集画多段线打断于交点处的解决方案。
下面我把问题交代清楚：
两条交叉的线都是多段线，一条已经存在，另一条是新画的，要达到的效果是新画的多段线自动断口经过，程序中需要能设置打短距离。
我把G版的程序改完之后遇到的问题如下图：
在要打断的多段线上总是还会生成一段多段线。而且导致打断距离和预想的不相等，总是相差一个经过的那条多段线线宽的距离。
当遇到下图这种线型时，能碰到的，会出现下图中左边那条红线的情况；没碰到的时候，就会完全穿越而过，导致彻底失败，连个断点也没有了。
我希望遇到这种线型时能够像下图这样。而且，如果旁边有两条多段线与穿越而过的这条多段线距离很近时，穿越的多段线不会断掉。
另，附加的期望要求（如果实在达不到也就算了，但是我希望大家接着研究，让它达到）：
1、G版的程序只能在一个图层中操作，可是我们画施工图时，往往有个建筑底图（一般我把图层放在251图层，颜色251），我希望画多段线与底图有相交时不会对多段线有任何影响。
2、经过文字时，能够很好地断掉，不要在比如“0”的文字中间还有多段线的断线。
本帖最后由 yeahyeah 于 2013-8-21 21:12 编辑
;;画多段线打断于交点处
(defun c:kk (/ LA P0 PT S PL A d)
(if (null *d*)
(setq *d* 0)
)
(setq d (getdist (strcat "\n打断距离<" (rtos *d* 2 2) ">:")))
(if (null d)
(setq d *d*)
(setq *d* d)
)
(setq d (* 0.5 d))
(setq xww (getvar 'Plinewid)) ;线宽
(setq la (getvar 'clayer))
(setq p0 (getpoint "\n第一点:"))
(while (setq pt (getpoint p0 "\n下一点:"))
(setq s
(ssget "f"
(list p0 pt)
(list (cons 0 "*line,LWPOLYLINE,arc,circle,ellipse")
(cons 8 la);只能在一个图层里
)
)
)
(if s
(progn
(setq pl ;我感觉问题就出在这个setq语句里
(vl-sort
(apply 'append ;apply function
(mapcar
'(lambda (x) (mapcar 'cadr (cdddr x)))
;mapcar function
(ssnamex s) ;mapcar list1
) ;apply list
) ;end apply ;vl-sort list
'(lambda (a b)
(< (distance a p0) (distance b p0))
) ;lambda:参数是两个点 ;vl-sort comparison-function
) ;end vl-sort
)
(setq a p0)
(foreach b pl
(if (not (equal p0 b (* 0.1 d)))
(progn
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
(cons 43 xww)
(cons 10 a)
(cons 10 (polar b (angle pt p0) d))
)
)
(setq a (polar b (angle p0 pt) d))
)
) ;整个if是foreach的求值表达式
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
(cons 43 xww)
(cons 10 a)
(cons 10 pt)
)
)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
(cons 43 xww)
(cons 10 p0)
(cons 10 pt)
)
)
)
(setq p0 pt)
)
(princ)
) 悬赏呢！晚安美好的各位！ 我觉得需要对经过的对象做二次判断，看看是不是同一个图元，如果是，取先后两次经过的点的中点。 各位下班了吗？来看看帖子呀，可好看了，要快！！快快快！yeah！ 您今天还有没接受、没完成的任务哟~~~ 看附件。。。
最近怎么这么多人号外号外，悬赏悬赏呢？
都把伦家欺负到底层弃了。。。 帮楼主顶起。 楼主要有耐心，高手一般都很忙。