[LISP函数]：判断Pline自相交

eachy

2. 
   
3. ;;       a-->(1 2 3 4 5 6 7 8)
   
4. ;;       (split 2 a)-->((1 2) (3 4) (5 6) (7 8))
   
5. ;;       (split 3 a)-->((1 2 3) (4 5 6) (7 8))
   
6. ;;By Aeo From [url]www.xdcad.net[/url]
   
7. (defun lst-split (n li / return a len)
   
8.   (while li
   
9.     (setq a   nil
   
10.           len (length li)
    
11.     )
    
12.     (repeat (if        (<= n len)
    
13.               n
    
14.               len
    
15.             )
    
16.       (setq a  (cons (car li) a)
    
17.             li (cdr li)
    
18.       )
    
19.     )
    
20.     (setq return (cons (reverse a) return))
    
21.   )
    
22.   (reverse return)
    
23. )
    
24. ;; Form [url]www.xdcad.net[/url] eachy 2005.9.21
    
25. ;;获取LightweightPolyline Polyline顶点
    
26. ;;返回值: 顶点列表
    
27. (defun xd-getplvertex (e / n i ptl)
    
28.   (setq        n (1+ (fix (vlax-curve-getendparam e)))
    
29.         i -1
    
30.   )
    
31.   (repeat n
    
32.     (setq ptl (cons (vlax-curve-getpointatparam e (setq i (1+ i))) ptl))
    
33.   )
    
34.   (reverse ptl)
    
35. )
    
36. (defun c:tt (/ e obj ints n m pts  pls)
    
37.   (if (setq e (car (entsel)))
    
38.     (progn
    
39.       (setq obj (vlax-ename->vla-object e))
    
40.       (if (setq ints (vla-intersectwith obj obj acextendnone))
    
41.         (progn
    
42.           (setq        n (/
    
43.                     (1+        (vlax-safearray-get-u-bound
    
44.                           (setq var (variant-value ints))
    
45.                           1
    
46.                         )
    
47.                     )
    
48.                     3
    
49.                   )
    
50.                 m (fix (vlax-curve-getendparam e))
    
51.           )
    
52.           (if (> n m)
    
53.             (progn
    
54.               (setq pts        (lst-split 3 (safearray-value var))
    
55.                     pls        (xd-getplvertex e)
    
56.               )
    
57.               (mapcar '(lambda (x) (setq pts (vl-remove x pts))) pls)
    
58.               (mapcar '(lambda (x) (command ".point" x)) pts)
    
59.             )
    
60.           )
    
61.         )
    
62.       )
    
63.     )
    
64.   )
    
65.   (princ)
    
66. )

<br /> ;;       a-->(1 2 3 4 5 6 7 8)<br /> ;;       (split 2 a)-->((1 2) (3 4) (5 6) (7 8))<br /> ;;       (split 3 a)-->((1 2 3) (4 5 6) (7 8))<br /> ;;By Aeo From [url]www.xdcad.net[/url]<br /> (defun lst-split (n li / return a len)<br />   (while li<br />     (setq a   nil<br />           len (length li)<br />     )<br />     (repeat (if        (<= n len)<br />               n<br />               len<br />             )<br />       (setq a  (cons (car li) a)<br />             li (cdr li)<br />       )<br />     )<br />     (setq return (cons (reverse a) return))<br />   )<br />   (reverse return)<br /> )<br /> ;; Form [url]www.xdcad.net[/url] eachy 2005.9.21<br /> ;;获取LightweightPolyline Polyline顶点<br /> ;;返回值: 顶点列表<br /> (defun xd-getplvertex (e / n i ptl)<br />   (setq        n (1+ (fix (vlax-curve-getendparam e)))<br />         i -1<br />   )<br />   (repeat n<br />     (setq ptl (cons (vlax-curve-getpointatparam e (setq i (1+ i))) ptl))<br />   )<br />   (reverse ptl)<br /> )<br /> (defun c:tt (/ e obj ints n m pts  pls)<br />   (if (setq e (car (entsel)))<br />     (progn<br />       (setq obj (vlax-ename->vla-object e))<br />       (if (setq ints (vla-intersectwith obj obj acextendnone))<br />         (progn<br />           (setq        n (/<br />                     (1+        (vlax-safearray-get-u-bound<br />                           (setq var (variant-value ints))<br />                           1<br />                         )<br />                     )<br />                     3<br />                   )<br />                 m (fix (vlax-curve-getendparam e))<br />           )<br />           (if (> n m)<br />             (progn<br />               (setq pts        (lst-split 3 (safearray-value var))<br />                     pls        (xd-getplvertex e)<br />               )<br />               (mapcar '(lambda (x) (setq pts (vl-remove x pts))) pls)<br />               (mapcar '(lambda (x) (command ".point" x)) pts)<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

狂刀

爱简单

2. 
   
3. ;;　(plinsp e) = 判断Pline自相交 ---by-- 狂刀 .2005.9
   
4. ;;  参数: e = 多义线实体.
   
5. ;; (plinsp (car(entsel)))
   
6. (defun plinsp (e / pts)
   
7.   (setq o (vlax-ename->vla-object e))
   
8.   (setq pts (vlax-invoke o 'intersectwith o 0))
   
9.   (if (< (vlax-curve-getendparam e) (+ 1 (vlax-get o 'closed)(/ (length pts) 3))) T nil)
   
10. )
    

<br /> ;;　(plinsp e) = 判断Pline自相交 ---by-- 狂刀 .2005.9<br /> ;;  参数: e = 多义线实体.<br /> ;; (plinsp (car(entsel)))<br /> (defun plinsp (e / pts)<br />   (setq o (vlax-ename->vla-object e))<br />   (setq pts (vlax-invoke o 'intersectwith o 0))<br />   (if (< (vlax-curve-getendparam e) (+ 1 (vlax-get o 'closed)(/ (length pts) 3))) T nil)<br /> )<br />

jx2008

我的这个函数
或到我的网盘下载 http://muzicad.ys168.com