批量打断直线交点，如何不改变直线图层（求修改）
现在的程序可以完成批量打断，但改变了直线的图层，特求高手出手修改，谢谢！！代码如下：
(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 内存128winXPAutoCAD2006.
(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 "秒")
)
按此思路进行修改量就大了，还不如直接用坛子里现有的好程序。
可参考下这个帖子http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85947的三楼大作 本帖最后由 xskfq 于 2014-1-16 13:58 编辑
那个速度不行，100条直线直接卡死，而且总出错。 http://bbs.xdcad.net/forum.php?mod=viewthread&tid=519459 q3_2006 发表于 2014-1-16 15:30 static/image/common/back.gif
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=519459
这个我试过，会产生小短线，点等成多余图元。。 没有人帮忙吗 可以试试。。
ol直线(仅直线)交点打断
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=109067&fromuid=338795
(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 内存128winXPAutoCAD2006.
(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 "秒")
) 直接break
页:
[1]