【悬赏！！！】画多段线打断于交点处

yeahyeah

昨晚看到一个很好的帖子《求画直线相交断己》，也看到了G版老师的程序。昨晚内心欣喜之情真是说不出来的好。

我是做建筑工程电气电信设计的，画施工图时，常常会遇到管线“交叉”（其实是交点处交叉分层布置）的情况，所以画多段线打断于交点处这样的程序真是饥渴啊。

由于G版的原程序是不包括处理多段线的，我就在他的程序的基础上，试着改了下（我改的程序见二楼），结果遇到些很棘手的问题。

我才学LISP没到一个月，能力实在有限，现特悬赏征集画多段线打断于交点处的解决方案。

下面我把问题交代清楚：
两条交叉的线都是多段线，一条已经存在，另一条是新画的，要达到的效果是新画的多段线自动断口经过，程序中需要能设置打短距离。
我把G版的程序改完之后遇到的问题如下图：

在要打断的多段线上总是还会生成一段多段线。而且导致打断距离和预想的不相等，总是相差一个经过的那条多段线线宽的距离。


当遇到下图这种线型时，能碰到的，会出现下图中左边那条红线的情况；没碰到的时候，就会完全穿越而过，导致彻底失败，连个断点也没有了。



我希望遇到这种线型时能够像下图这样。而且，如果旁边有两条多段线与穿越而过的这条多段线距离很近时，穿越的多段线不会断掉。



另，附加的期望要求（如果实在达不到也就算了，但是我希望大家接着研究，让它达到）：
1、G版的程序只能在一个图层中操作，可是我们画施工图时，往往有个建筑底图（一般我把图层放在251图层，颜色251），我希望画多段线与底图有相交时不会对多段线有任何影响。
2、经过文字时，能够很好地断掉，不要在比如“0”的文字中间还有多段线的断线。

yeahyeah

;;画多段线打断于交点处

(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)
)

yeahyeah

悬赏呢！晚安美好的各位！

yeahyeah

我觉得需要对经过的对象做二次判断，看看是不是同一个图元，如果是，取先后两次经过的点的中点。来自: Android客户端

yeahyeah

各位下班了吗？来看看帖子呀，可好看了，要快！！快快快！yeah！来自: Android客户端

yeahyeah

您今天还有没接受、没完成的任务哟~~~

ucuc2003

看附件。。。

yeahyeah

最近怎么这么多人号外号外，悬赏悬赏呢？
都把伦家欺负到底层弃了。。。

sicky111

帮楼主顶起。

sicky111

楼主要有耐心，高手一般都很忙。