[求助]：急用，选择一个图元，画一条线后，该图元层所有的线在相交点被打断。

lixuedong

急用，选择一个图元，画一条线后，该图元层所有的线在相交点被打断。

雨箭风刀

论坛有单独的交点打断程序，把内容合并到你的lsp就可以了

lixuedong

谢谢楼上指点，程序编出来了

2. 
   
3. (VL-LOAD-COM)
   
4. (setq AcadObject (vlax-get-acad-object))
   
5. (setq AcadDocument (vla-get-ActiveDocument Acadobject))
   
6. (setq mSpace (vla-get-ModelSpace Acaddocument)) ;_获得模型空间指针
   
7. (defun c:brk_Line (/             lineObjNames           lay-name
   
8.                   lyspt1     i                p1           p2
   
9.                   linePointCol                P3           p4
   
10.                   p             tmpEnt        lineObjNames
    
11.                  ) ;_主函数
    
12.   (while (null lay-name)
    
13.     (setq lay-name (entsel "\n选择打断图层:"))
    
14.   )
    
15.   (setq lay-name (entget (car lay-name)))
    
16.   (setq lay-name (cdr (assoc 8 lay-name)))
    
17. 
    
18.   (setq lyspt1 (getpoint "\n起点:"))
    
19.   (if lyspt1
    
20.     (setq lyspt2 (getpoint lyspt1 "\n第终点: "))
    
21.   )
    
22. 
    
23.   (if lyspt1
    
24.     (command "line" lyspt1 lyspt2 "")
    
25.   )
    
26.   (setq        lyspt1 (list lyspt1
    
27.                      lyspt2
    
28.                      (list (nth 0 lyspt2) (1+ (nth 0 lyspt2)) 0)
    
29.                )
    
30.   )
    
31. 
    
32.   (setq        lineObjNames
    
33.          (ssget        "CP"
    
34.                 lyspt1
    
35.                 (list '(0 . "LINE") (cons 8 lay-name))
    
36.          )
    
37.   )
    
38.   (setq n (sslength lineObjNames))
    
39.   (setq p1 (nth 0 lyspt1))
    
40.   (setq p2 (nth 1 lyspt1))
    
41.   (setq i 0)
    
42.   (repeat n
    
43.     (setq next (ssname lineObjNames i))
    
44.     (setq p3 (vlax-curve-getStartPoint next))
    
45.     (setq p4 (vlax-curve-getEndPoint next)) ;_求开始点和结束点
    
46.     (setq p (inters p1 p2 p3 p4))
    
47.     (vl-cmdf "_.break" (ssadd next) P "@")
    
48.     (setq i (1+ i))
    
49.   )
    
50.   (princ)
    
51. )

<br /> (VL-LOAD-COM)<br /> (setq AcadObject (vlax-get-acad-object))<br /> (setq AcadDocument (vla-get-ActiveDocument Acadobject))<br /> (setq mSpace (vla-get-ModelSpace Acaddocument)) ;_获得模型空间指针<br /> (defun c:brk_Line (/             lineObjNames           lay-name<br />                   lyspt1     i                p1           p2<br />                   linePointCol                P3           p4<br />                   p             tmpEnt        lineObjNames<br />                  ) ;_主函数<br />   (while (null lay-name)<br />     (setq lay-name (entsel "\n选择打断图层:"))<br />   )<br />   (setq lay-name (entget (car lay-name)))<br />   (setq lay-name (cdr (assoc 8 lay-name)))<br /> <br />   (setq lyspt1 (getpoint "\n起点:"))<br />   (if lyspt1<br />     (setq lyspt2 (getpoint lyspt1 "\n第终点: "))<br />   )<br /> <br />   (if lyspt1<br />     (command "line" lyspt1 lyspt2 "")<br />   )<br />   (setq        lyspt1 (list lyspt1<br />                      lyspt2<br />                      (list (nth 0 lyspt2) (1+ (nth 0 lyspt2)) 0)<br />                )<br />   )<br /> <br />   (setq        lineObjNames<br />          (ssget        "CP"<br />                 lyspt1<br />                 (list '(0 . "LINE") (cons 8 lay-name))<br />          )<br />   )<br />   (setq n (sslength lineObjNames))<br />   (setq p1 (nth 0 lyspt1))<br />   (setq p2 (nth 1 lyspt1))<br />   (setq i 0)<br />   (repeat n<br />     (setq next (ssname lineObjNames i))<br />     (setq p3 (vlax-curve-getStartPoint next))<br />     (setq p4 (vlax-curve-getEndPoint next)) ;_求开始点和结束点<br />     (setq p (inters p1 p2 p3 p4))<br />     (vl-cmdf "_.break" (ssadd next) P "@")<br />     (setq i (1+ i))<br />   )<br />   (princ)<br /> )

创佳

效率太低，浪费时间