批量打断直线交点，如何不改变直线图层（求修改）

xskfq

现在的程序可以完成批量打断，但改变了直线的图层，
特求高手出手修改，谢谢！！代码如下：
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object))
(setq AcadDocument (vla-get-ActiveDocument Acadobject))
(setq mSpace (vla-get-ModelSpace Acaddocument)) ;_获得模型空间指针
(defun c:OL (/ lineObjNames) ;_主函数
  (setq lineObjNames (ssget '((0 . "LINE")))) ;_获取模型空间的直线
  (LinePointOrder (FindIntersections lineObjNames))
  (princ)
)
;;找出所有直线上的交点
(defun FindIntersections (lineObjNames              /                lineCol
                          linePointCol              tmpEnt        i
                          j            n              p                this
                          next            StartPoint                EndPoint
                          p1            p2              p3        p4
                         )
  (setq        s         (getvar "DATE")
        seconds1 (* 86400.0 (- s (fix s)))
  )
  (setq        lineCol        (list) ;_定义直线集
        tmpEnt        (list)
        i        -1
  )
  (setq n (sslength lineObjNames))
  (repeat n
    (setq tmpEnt (cons (ssname lineObjNames (setq i (1+ i))) tmpEnt))
  )
  (setq j 0)
  (repeat n ;_找出直线上所有的交点，但不包括开始点和结束点
    (setq this (nth j tmpEnt))
    (setq linePointCol (list)) ;_定义在直线上的点集
    (setq p1 (vlax-curve-getStartPoint this))
    (setq p2 (vlax-curve-getEndPoint this))
    (setq linePointCol (cons p2 linePointCol)) ;加入结束点
    (setq i 0)
    (repeat (- n 1)
      (if (= i j)
        (setq i (1+ i))
      ) ;_如果是本身跳过
      (setq next (nth i tmpEnt))
      (setq p3 (vlax-curve-getStartPoint next))
      (setq p4 (vlax-curve-getEndPoint next)) ;_求开始点和结束点
      (setq p (inters p1 p2 p3 p4))
      (if p ;_正确的点存入点集
        (if (JudgeAnastomosis p1 p2 p)
          (setq linePointCol (cons p linePointCol))
        )
      )
      (setq i (1+ i))
    )
    (setq lineCol (cons
                    (cons p1 linePointCol)
                    lineCol
                  )
    ) ;_加入开始点
    (setq this (nth
                 (setq j (1+ j))
                 tmpEnt
               )
    ) ;_提取下一个点  
  )
  (setq i -1)
  (repeat n ;_删原有直线。
    (setq tmp (nth (setq i (1+ i)) tmpEnt))
    (entdel tmp)
  )
  (setq s (getvar "DATE"))
  (setq seconds2 (* 86400.0 (- s (fix s)))) ;_计算消耗时间
  (princ "\n找出所有交点用时:")
  (princ (- seconds2 seconds1))
  (princ "秒")
  lineCol
)
;;这个函数主要处理首尾相接的那种直线，因为vla-IntersectWith认为那种形式也算相交。
;;在大多数情况，不需要那种类型的。
(defun JudgeAnastomosis        (p1 p2 p)
  (if (or (equal p1 p 0.01)
          (equal p2 p 0.01)
      )
    (setq result nil)
    (setq result T)
  )
  result
)
;;给直线上交点排序，要不会重叠的。
;;说明我的算法，1、判断直线是否垂直，如果垂直由Y来排序；如果不垂直用X来排序。
;;              2、选出一个生成一个直线。
;;打断20000交点用22s，我的机器配置为:Ce850 内存128  winXP  AutoCAD2006.
(defun LinePointOrder (lineCol /       num     line    n       i
                       j       tmp     tmpLine StartPoint      EndPoint
                       on      this    L
                      )
  (setq num 0)
  (repeat (vl-list-length lineCol) ;_根据直线多少来确定次数
    (setq line          (nth num lineCol)
          n          (vl-list-length line) ;_根据直线上的点确定数
          i          -1
          j          0
          tmpLine (list)
    )
    (if        (equal (car (nth 0 line)) (car (nth 1 line)) 0.0005) ;_分两种情况讨论。
      (setq tmpLine (vl-sort line
                             '(lambda (l1 l2) ;_用vl-sort排序
                                (< (cadr l1) (cadr l2))
                              )
                    )
      )
      (setq tmpLine (vl-sort line
                             '(lambda (l1 l2)
                                (< (car l1) (car l2))
                              )
                    )
      )
    )
    (repeat (1- n)
      (setq StartPoint ;_连接成直线
             (vlax-3d-point
               (nth
                 (setq i (1+ i))
                 tmpLine
               )
             )
      )
      (setq EndPoint
             (vlax-3d-point
               (nth
                 (setq j (1+ j))
                 tmpLine
               )
             )
      )
      (vla-addLine mSpace StartPoint EndPoint)
      ;;这块是用来对比 vla-addLine方法的        
      ;;(entmake (list(cons 0 "line")
      ;;              (cons 10 (nth (setq i (1+ i)) tmpLine))  
      ;;              (cons 11 (nth (setq j (1+ j)) tmpLine))
      ;;           )
      ;;      )
    )
    (setq num (1+ num))
  )
  (setq s (getvar "DATE"))
  (setq seconds3 (* 86400.0 (- s (fix s)))) ;计算消耗时间
  (princ "\n排序生成直线消耗时间:")
  (princ (- seconds3 seconds2))
  (princ "秒")
)

zyhandw

按此思路进行修改量就大了，还不如直接用坛子里现有的好程序。
可参考下这个帖子http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85947的三楼大作

xskfq

那个速度不行，100条直线直接卡死，而且总出错。

q3_2006

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=519459

xskfq

q3_2006 发表于 2014-1-16 15:30
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=519459

这个我试过，会产生小短线，点等成多余图元。。

xskfq

没有人帮忙吗

edata

可以试试。。
ol直线(仅直线)交点打断
http://bbs.mjtd.com/forum.php?mo ... &fromuid=338795

yoyoho

(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object))
(setq AcadDocument (vla-get-ActiveDocument Acadobject))
(setq mSpace (vla-get-ModelSpace Acaddocument)) ;_获得模型空间指针
(defun c:OLL (/ lineObjNames) ;_主函数
  (SETQ OL0 (GETVAR "CLAYER")) ;;;保存目前使用的色层
  (setq lineObjNames (ssget '((0 . "LINE")))) ;_获取模型空间的直线
  (SETQ LAYER00 (cdr ( assoc 8 (entget (ssname lineObjNames 0)))))
  (SETVAR "CLAYER" LAYER00)
  (LinePointOrder (FindIntersections lineObjNames))
  (SETVAR "CLAYER" OL0)
  (princ)
)
;;找出所有直线上的交点
(defun FindIntersections (lineObjNames              /                lineCol
                          linePointCol              tmpEnt        i
                          j            n              p                this
                          next            StartPoint                EndPoint
                          p1            p2              p3        p4
                         )
  (setq        s         (getvar "DATE")
        seconds1 (* 86400.0 (- s (fix s)))
  )
  (setq        lineCol        (list) ;_定义直线集
        tmpEnt        (list)
        i        -1
  )
  (setq n (sslength lineObjNames))
  (repeat n
    (setq tmpEnt (cons (ssname lineObjNames (setq i (1+ i))) tmpEnt))
  )
  (setq j 0)
  (repeat n ;_找出直线上所有的交点，但不包括开始点和结束点
    (setq this (nth j tmpEnt))
    (setq linePointCol (list)) ;_定义在直线上的点集
    (setq p1 (vlax-curve-getStartPoint this))
    (setq p2 (vlax-curve-getEndPoint this))
    (setq linePointCol (cons p2 linePointCol)) ;加入结束点
    (setq i 0)
    (repeat (- n 1)
      (if (= i j)
        (setq i (1+ i))
      ) ;_如果是本身跳过
      (setq next (nth i tmpEnt))
      (setq p3 (vlax-curve-getStartPoint next))
      (setq p4 (vlax-curve-getEndPoint next)) ;_求开始点和结束点
      (setq p (inters p1 p2 p3 p4))
      (if p ;_正确的点存入点集
        (if (JudgeAnastomosis p1 p2 p)
          (setq linePointCol (cons p linePointCol))
        )
      )
      (setq i (1+ i))
    )
    (setq lineCol (cons
                    (cons p1 linePointCol)
                    lineCol
                  )
    ) ;_加入开始点
    (setq this (nth
                 (setq j (1+ j))
                 tmpEnt
               )
    ) ;_提取下一个点
  )
  (setq i -1)
  (repeat n ;_删原有直线。
    (setq tmp (nth (setq i (1+ i)) tmpEnt))
    (entdel tmp)
  )
  (setq s (getvar "DATE"))
  (setq seconds2 (* 86400.0 (- s (fix s)))) ;_计算消耗时间
  (princ "\n找出所有交点用时:")
  (princ (- seconds2 seconds1))
  (princ "秒")
  lineCol
)
;;这个函数主要处理首尾相接的那种直线，因为vla-IntersectWith认为那种形式也算相交。
;;在大多数情况，不需要那种类型的。
(defun JudgeAnastomosis        (p1 p2 p)
  (if (or (equal p1 p 0.01)
          (equal p2 p 0.01)
      )
    (setq result nil)
    (setq result T)
  )
  result
)
;;给直线上交点排序，要不会重叠的。
;;说明我的算法，1、判断直线是否垂直，如果垂直由Y来排序；如果不垂直用X来排序。
;;              2、选出一个生成一个直线。
;;打断20000交点用22s，我的机器配置为:Ce850 内存128  winXP  AutoCAD2006.
(defun LinePointOrder (lineCol /       num     line    n       i
                       j       tmp     tmpLine StartPoint      EndPoint
                       on      this    L
                      )
  (setq num 0)
  (repeat (vl-list-length lineCol) ;_根据直线多少来确定次数
    (setq line          (nth num lineCol)
          n          (vl-list-length line) ;_根据直线上的点确定数
          i          -1
          j          0
          tmpLine (list)
    )
    (if        (equal (car (nth 0 line)) (car (nth 1 line)) 0.0005) ;_分两种情况讨论。
      (setq tmpLine (vl-sort line
                             '(lambda (l1 l2) ;_用vl-sort排序
                                (< (cadr l1) (cadr l2))
                              )
                    )
      )
      (setq tmpLine (vl-sort line
                             '(lambda (l1 l2)
                                (< (car l1) (car l2))
                              )
                    )
      )
    )
    (repeat (1- n)
      (setq StartPoint ;_连接成直线
             (vlax-3d-point
               (nth
                 (setq i (1+ i))
                 tmpLine
               )
             )
      )
      (setq EndPoint
             (vlax-3d-point
               (nth
                 (setq j (1+ j))
                 tmpLine
               )
             )
      )
      (vla-addLine mSpace StartPoint EndPoint)
      ;;这块是用来对比 vla-addLine方法的
      ;;(entmake (list(cons 0 "line")
      ;;              (cons 10 (nth (setq i (1+ i)) tmpLine))
      ;;              (cons 11 (nth (setq j (1+ j)) tmpLine))
      ;;           )
      ;;      )
    )
    (setq num (1+ num))
  )
  (setq s (getvar "DATE"))
  (setq seconds3 (* 86400.0 (- s (fix s)))) ;计算消耗时间
  (princ "\n排序生成直线消耗时间:")
  (princ (- seconds3 seconds2))
  (princ "秒")
)

xyp1964

直接break