交点断线程序求优化！

theisland

以下是在明经社区找到的一个通过图层顺序来打断直线的程序，实际工作中发现不仅只有直线，还有弧线，希望能在这个程序基础上增加如下功能：
1.增加对弧线的识别
2.除了可以在图中选择各图层的先后顺序外，还能默认一个顺序。比如说图层a、b、c，a层上的弧线或直线能打断b、c层上的弧线或者直线，b层上的弧线或直线只能打断c层上的弧线或直线，即排序靠前的对象能打断排序靠后的所有对象

非常实用的一个功能，希望有人能让这个程序锦上添花，谢谢！
-------------------------------------------------------------------------------------------------------------------------------------------------------
;;; 按选取图层的先后顺序打断直线
;;;BY wkq004 2013-01-11    http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99967

(defun c:dx (/           +ANG         -ANG  D     E           EL         ELST  EPT   INT
             INTLST         LAY   LAYLST           LEN         O1    O2    OE
             ONEL  ONELAY      ONELL PT1   PT2         PTLST SS    T1
             T2           TWO         X
            )

  ;;参考;;画线打断于交点处 By Gu_xl 2012.12.11
  (defun sjzl (e / EL LAY LAYL PT1 PT2)
    (setq el (entget e))
    (setq lay (cdr (assoc 8 el)))
    (setq pt1 (cdr (assoc 10 el)))
    (setq pt1 (list (car pt1) (cadr pt1)))
    (setq pt2 (cdr (assoc 11 el)))
    (setq pt2 (list (car pt2) (cadr pt2)))
    (if        (setq layl (assoc lay elst))
      (if (not (member e (cadr layl)))
        (setq
          elst (subst (append layl (list (list e pt1 pt2))) layl elst)
        )
      )
      (setq elst   (cons (list lay (list e pt1 pt2)) elst)
            laylst (cons lay laylst)
      )
    )
  )
  ;;1.依次选图层（a、b、c、d）
  (while (setq ept (entsel "\n选择直线,确定图层顺序->"))
    (sjzl (car ept))
  )
  (if (cdr elst)
    (progn
      ;;2.框选范围
      (princ "\n框选范围:")
      (setq ss
             (ssget
               (list
                 '(0 . "LINE")
                 (cons 8
                       (apply 'strcat
                              (mapcar '(lambda (x) (strcat x ",")) laylst)
                       )
                 )
               )
             )
      )
      (if ss
        (repeat        (setq len (sslength ss))
          (sjzl (ssname ss (setq len (1- len))))
        )
      )
      ;|3.选图层e--4.a、b、c、d图层上的直线打断e
      (if
        (setq e           (car ept)
              el   (entget e)
              lay  (cdr (assoc 8 el))
              pt1  (cdr (assoc 10 el))
              pt1  (list (car pt1) (cadr pt1))
              pt2  (cdr (assoc 11 el))
              pt2  (list (car pt2) (cadr pt2))
              elst (cons (list lay (list e pt1 pt2)) elst)
        )
      )|;
      ;;程序部分
      (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))
      (while (and (setq onell (car elst)) (setq elst (cdr elst)))
        (progn
          (setq onelay (car onell))
          (setq onel (cdr onell))
          (foreach one onel
            (setq intlst '())
            (setq oe (car one))
            (setq o1 (cadr one))
            (setq o2 (caddr one))
            (foreach twoll elst
              (foreach two (cdr twoll)
                (setq t1 (cadr two))
                (setq t2 (caddr two))
                (setq int (inters t1 t2 o1 o2 T))
                (if int
                  (setq intlst (cons int intlst))
                )
              )
            )
            (if        intlst
              (progn (entdel oe)
                     (setq intlst
                            (vl-sort intlst
                                     (function
                                       (lambda (a b)
                                         (< (distance o1 a) (distance o1 b)) ;_mapcar apply改写
                                       )
                                     )
                            )
                     )
                     (setq one (car intlst))
                     (setq +ang (angle o1 o2))
                     (setq -ang (angle o2 o1))
                     (setq ptlst '())
                     (foreach two intlst
                       (if (> (distance one two) *d*)
                         (entmake (list        '(0 . "LINE")
                                        (cons 8 onelay)
                                        (cons 10 (polar one +ang d))
                                        (cons 11 (polar two -ang d))
                                  )
                         )
                       )
                       (setq one two)
                     )
                     (if (> (distance o1 (setq one (car intlst))) d)
                       (entmake        (list '(0 . "LINE")
                                      (cons 8 onelay)
                                      (cons 10 o1)
                                      (cons 11 (polar one -ang d))
                                )
                       )
                     )
                     (if (> (distance o2 (setq two (last intlst))) d)
                       (entmake        (list '(0 . "LINE")
                                      (cons 8 onelay)
                                      (cons 10 (polar two +ang d))
                                      (cons 11 o2)
                                )
                       )
                     )
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

theisland

怎么没人搭理啊

陨落

因为你只有一个币，却发布了两个的悬赏

暗夜贵族

(defun c:3()
        (vl-load-com)
        (SETQ SS (SSGET))
        (setq ss_count 0 ss_total (sslength ss))
        (WHILE (< ss_count ss_total )
          (setq e1 (ssname ss ss_count))
          (SETQ EH1 (atof (cdr (cadr (cadr (assoc -3 (entget e1 '("pipeh")))))) ))
    ( SETQ X1   (car (get_pl-pb0 e1)))
                ( SETQ X2   (caDr (get_pl-pb0 e1)))
          (setq ss_count1 (+ 1 ss_count ))
          (WHILE (< ss_count1 ss_total )
                        (setq e2 (ssname ss ss_count1))
            (SETQ EH2 (atof (cdr (cadr (cadr (assoc -3 (entget e2 '("pipeh")))))) ))
                  ( SETQ Y1   (car (get_pl-pb0 e2)))
                  ( SETQ Y2   (caDr (get_pl-pb0 e2)))
           (setq obj1 (vlax-ename->vla-object e1)  obj2 (vlax-ename->vla-object e2))
                        (setq brkpt  (vlax-invoke obj1 'IntersectWith obj2 acExtendNone))
                        (if  brkpt
                                (progn
                                        (cond
                                                ((< EH1 EH2 )(setq brk_e e1) )
                                                ; ((= EH1 EH2)(princ "Alarm:管道打架") )
                                                ((> EH1 EH2 )(setq brk_e e2) )
                                        )
                            (setq para (vlax-curve-getParamAtPoint brk_e brkpt))
                (setq dir1 (vlax-curve-getFirstDeriv brk_e para))
          (setq dir1_ang(angle '(0 0) dir1))
                      (command "._break" brk_e "_non" (POLAR  brkpt  dir1_ang 30) "_non" (POLAR  brkpt  (+ PI dir1_ang) 30))
                                  (sSadd  (entlast) ss)
                            (setq ss_total (+ 1 ss_total))
                    )
                        )
           (setq ss_count1 (+ 1 ss_count1))
                )
                (setq ss_count (+ 1 ss_count) )
        )
)

暗夜贵族

我把高度写入扩展信息，通过扩展信息来比较进行打断。

theisland

暗夜贵族 发表于 2015-7-1 14:43
(defun c:3()
        (vl-load-com)
        (SETQ SS (SSGET))

选择对象:  ; 错误: 参数类型错误: stringp nil  没反应啊，而且程序中没有设定图层顺序，也没有选择图层顺序的提示（实际要求是默认设定的图层顺序，同时还能选择顺序）

bai2000

我只需要划线断开后短段的线性变为虚线