[VLISP函数]：获得包含点表的凸包点表

wkai

2. 
   
3. ;;from [email]wkai@xdcad.net[/email]
   
4. ;;20050928
   
5. ;;Graham扫描法
   
6. ;;参数lst:坐标点表
   
7. ;;返回值:凸包点表(逆时针)
   
8. (defun XD_convex_hull (lst / re tblst AN BG RESULT)
   
9.   ;;按与pt的角度对点表排序
   
10.   (defun XD_convex_hull_sort_an(pt an ls / re)
    
11.   (setq re (mapcar '(lambda(x) (list (rem (+ (* 2 pi)(- (angle pt x) an))(* 2 pi))(distance pt x) x)) ls))
    
12.     (setq re ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=465887][U][COLOR=red]XDL-SORT[/COLOR][/U][/URL] re '((0 <)(1 >))))
    
13.   (last(car re));;取与pt的角度与an差最小的距离最远的点
    
14.   )
    
15.   ;;
    
16.   (setq lst ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=451886][U][COLOR=red]xd-remove-dups[/COLOR][/U][/URL] lst))  
    
17.   (setq lst ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=465887][U][COLOR=red]XDL-SORT[/COLOR][/U][/URL] lst '((0 <)(1 <))));;按XY增排序
    
18.   (setq        bg (car lst)
    
19.         an (/ pi -2)
    
20.   )
    
21.   (setq tblst (list bg))
    
22.   (while
    
23.     (and (> (length lst) 2)
    
24.          (not (and (> (length tblst) 1) (= (car tblst) (last tblst)))
    
25.          )
    
26.     )
    
27.      (setq result (XD_convex_hull_sort_an (car tblst) an (vl-remove (car tblst) lst)))
    
28.      (setq an (angle (car tblst) result))
    
29.      (setq tblst (cons result tblst))
    
30.   )
    
31.   tblst
    
32. )
    
33. 
    

<br /> ;;from [email]wkai@xdcad.net[/email]<br /> ;;20050928<br /> ;;Graham扫描法<br /> ;;参数lst:坐标点表<br /> ;;返回值:凸包点表(逆时针)<br /> (defun XD_convex_hull (lst / re tblst AN BG RESULT)<br />   ;;按与pt的角度对点表排序<br />   (defun XD_convex_hull_sort_an(pt an ls / re)<br />   (setq re (mapcar '(lambda(x) (list (rem (+ (* 2 pi)(- (angle pt x) an))(* 2 pi))(distance pt x) x)) ls))<br />     (setq re ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=465887][U][COLOR=red]XDL-SORT[/COLOR][/U][/URL] re '((0 <)(1 >))))<br />   (last(car re));;取与pt的角度与an差最小的距离最远的点<br />   )<br />   ;;<br />   (setq lst ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=451886][U][COLOR=red]xd-remove-dups[/COLOR][/U][/URL] lst))  <br />   (setq lst ([URL=http://www.xdcad.net/forum/showthread.php?s=&threadid=465887][U][COLOR=red]XDL-SORT[/COLOR][/U][/URL] lst '((0 <)(1 <))));;按XY增排序<br />   (setq        bg (car lst)<br />         an (/ pi -2)<br />   )<br />   (setq tblst (list bg))<br />   (while<br />     (and (> (length lst) 2)<br />          (not (and (> (length tblst) 1) (= (car tblst) (last tblst)))<br />          )<br />     )<br />      (setq result (XD_convex_hull_sort_an (car tblst) an (vl-remove (car tblst) lst)))<br />      (setq an (angle (car tblst) result))<br />      (setq tblst (cons result tblst))<br />   )<br />   tblst<br /> )<br /> <br />

wkai

测试:

2. 
   
3. (defun c:tt(/ lst re tblst ss n)
   
4.   ;;
   
5.   (defun ss_for (item ss fun / cn)
   
6.   (repeat (setq cn (sslength ss))
   
7.     (set item (ssname ss (setq cn (1- cn))))
   
8.     (eval fun)
   
9.     )
   
10.   )
    
11.   ;;  
    
12.   (command "undo" "be")
    
13.   (setq ss (ssget '((0 . "LINE"))))
    
14.   (ss_for 'n ss
    
15.           '(setq lst (append lst
    
16.                              (list (cdr (assoc 10 (entget n)))
    
17.                                    (cdr (assoc 11 (entget n)))
    
18.                              )
    
19.                      ))
    
20.   )
    
21.   (setq tblst (XD_convex_hull lst))
    
22.   (command "._pline" )
    
23.   (foreach n tblst
    
24.     (command "non" n)
    
25.     )
    
26.   (command)
    
27.   (command "undo" "e")
    
28.   (print tblst)
    
29.   (princ)
    
30.   )
    

<br /> (defun c:tt(/ lst re tblst ss n)<br />   ;;<br />   (defun ss_for (item ss fun / cn)<br />   (repeat (setq cn (sslength ss))<br />     (set item (ssname ss (setq cn (1- cn))))<br />     (eval fun)<br />     )<br />   )<br />   ;;  <br />   (command "undo" "be")<br />   (setq ss (ssget '((0 . "LINE"))))<br />   (ss_for 'n ss<br />           '(setq lst (append lst<br />                              (list (cdr (assoc 10 (entget n)))<br />                                    (cdr (assoc 11 (entget n)))<br />                              )<br />                      ))<br />   )<br />   (setq tblst (XD_convex_hull lst))<br />   (command "._pline" )<br />   (foreach n tblst<br />     (command "non" n)<br />     )<br />   (command)<br />   (command "undo" "e")<br />   (print tblst)<br />   (princ)<br />   )<br />

lifei1979

XD-REMOVE-DUPS 在哪呢