曲线沿填充处打断

/db_自贡黄明儒_

今天做了一项工作，沿曲线有许多填充，要求在填充处打断。有几百个填充，临时写了个程序,很快完成了

1. (defun C:w1 (/ E E0 EN N P1 P2 SS SS0)
   
2.   (_StartUndo *DOC*)
   
3.   (if (and
   
4.         (setq ss0 (LM:ssget "\n 选择曲线:" (list "_+.:E:S" '((0 . "LWPOLYLINE")))))
   
5.         (setq e0 (ssname ss0 0))
   
6.       )
   
7.     (while
   
8.       (setq ss (LM:ssget "\n 填充处画线:" (list ":S" '((0 . "HATCH")))))
   
9.        (repeat (setq n (sslength ss))
   
10.          (setq e (ssname ss (setq n (1- n))))
    
11.          (setq en (member '(2 . "SOLID") (entget e)))
    
12.          (setq p1 (cdr (assoc 10 en)))
    
13.          (setq p2 (vlax-curve-getClosestPointTo e0 p1))
    
14.          (command "._break" e0 "_non" (trans p2 0 1) "_non" (trans p2 0 1))
    
15.          ;;打断后，离曲线终点最近的曲线为e0,新产生的线由(entlast)取得
    
16.          ;;(vlax-curve-getEndPoint e0)
    
17.          
    
18.          ;(setq e0 (entlast))
    
19.          ;;记号
    
20. ;;;         (if (equal p1 p2 0.0001)
    
21. ;;;           (_EntmakeLine p1 (mapcar '+ p1 '(50000 0 0)) "0")
    
22. ;;;           (_EntmakeLine p1 p2 "0")
    
23. ;;;         )
    
24.          (entdel e)
    
25.        )
    
26.     )
    
27.   )
    
28.   (_EndUndo *DOC*)
    
29.   (princ)
    
30. )

(defun C:w1 (/ E E0 EN N P1 P2 SS SS0)<br />   (_StartUndo *DOC*)<br />   (if (and<br />         (setq ss0 (LM:ssget "\n 选择曲线:" (list "_+.:E:S" '((0 . "LWPOLYLINE")))))<br />         (setq e0 (ssname ss0 0))<br />       )<br />     (while<br />       (setq ss (LM:ssget "\n 填充处画线:" (list ":S" '((0 . "HATCH")))))<br />        (repeat (setq n (sslength ss))<br />          (setq e (ssname ss (setq n (1- n))))<br />          (setq en (member '(2 . "SOLID") (entget e)))<br />          (setq p1 (cdr (assoc 10 en)))<br />          (setq p2 (vlax-curve-getClosestPointTo e0 p1))<br />          (command "._break" e0 "_non" (trans p2 0 1) "_non" (trans p2 0 1))<br />          ;;打断后，离曲线终点最近的曲线为e0,新产生的线由(entlast)取得<br />          ;;(vlax-curve-getEndPoint e0)<br />          <br />          ;(setq e0 (entlast))<br />          ;;记号<br /> ;;;         (if (equal p1 p2 0.0001)<br /> ;;;           (_EntmakeLine p1 (mapcar '+ p1 '(50000 0 0)) "0")<br /> ;;;           (_EntmakeLine p1 p2 "0")<br /> ;;;         )<br />          (entdel e)<br />        )<br />     )<br />   )<br />   (_EndUndo *DOC*)<br />   (princ)<br /> )