请教一个关于凸包的问题！

lemonbox

通过参考wkai的凸包程序用lisp实现了求多条pline的凸包

但是当pline中包含曲线，且在边缘处时，就会出现曲线和凸包交叉的问题，因为我的凸包没有考虑出现曲线的情况，现在需要改进这个凸包程序，请问如何才能在出现曲线的地方将凸包也变成曲线呢？？？

lemonbox

贴一下程序代码，小弟我刚学lisp不久，现在遇到问题，希望各位高手帮帮忙啊～～

 

(vl-load-com)

;;表通用复合排序函数
;;功能   :对表进行复合排序
;;参数lst:需要被排序的表
;;sortlst:排序命令序列表
;;返回值 :排序后的表
;;
;;示例XDL-SORT '(0 2 3 7 8 5 7 ) '>)
;;         从大到小排序
;;         --->>(8 7 5 3 2 0)
;;     (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '(0 >))
;;         第0项从大到小排序
;;         --->>((9 6) (9 5) (8 7) (7 8) (6 9) (5 9) (1 0) (0 1))
;;     (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '((0 >)( 1 <)))
;;         第0项从大到小第1项从小到大排序;;
;;         --->>((9 5) (9 6) (8 7) (7 8) (6 9) (5 9) (1 0) (0 1))
;;     (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '(( 1 <)(0 >)))
;;         第1项从小到大第0项从大到小排序
;;         --->>((1 0) (0 1) (9 5) (9 6) (8 7) (7 8) (6 9) (5 9))
(defun XDL-SORT(lst sortlst / n)
  (if (listp sortlst)
    (if (listp (car sortlst))
      (setq sortlst (reverse sortlst))
      (setq sortlst (list sortlst))
    )
    (setq sortlst (list (list nil sortlst)))
  )
  (foreach n sortlst
    (setq lst (vl-sort lst '(lambda (s1 s2)
         (apply (cadr n) (list (if (car n) (nth  (car n) s1)s1)
          (if (car n) (nth  (car n) s2)s2))))))
    )
  )

;;删除表相同元素
;;pts:表  fuzz:精度
(defun lst-remove-dups(pts fuzz / pt x)
(cond ((=(length pts)1) pts)
       (t(setq pt(car pts))
         (cons pt(vl-remove-if '(lambda(x)(equal pt x fuzz))
               (lst-remove-dups(cdr pts)fuzz))
         )
     ))
)

;;取与pt的角度与an差最小的距离最远的点
(defun XD_convex_hull_sort_an(pt an ls / re)
  (setq re (mapcar '(lambda(x) (list (rem (+ (* 2 pi)(- (angle pt x) an))(* 2 pi))(distance pt x) x)) ls))
    (setq re (XDL-SORT re '((0 <)(1 >))))
  (last(car re))
)

;;获得包含点表的凸包点表
;;Graham扫描法
;;参数lst:坐标点表
;;返回值:凸包点表(逆时针)
(defun XD_convex_hull (lst / re tblst AN BG RESULT)
  ;;按与pt的角度对点表排序
  (setq lst (lst-remove-dups lst 0)) 
  (setq lst (XDL-SORT lst '((0 <)(1 <))));;按XY增排序
  (setq bg (car lst)
 an (/ pi -2)
  )
  (setq tblst (list bg))
  (while
    (and (> (length lst) 2)
  (not (and (> (length tblst) 1) (= (car tblst) (last tblst)))
  )
    )
     (setq result (XD_convex_hull_sort_an (car tblst) an (vl-remove (car tblst) lst)))
     (setq an (angle (car tblst) result))
     (setq tblst (cons result tblst))
  )
  tblst
)

;;获得pline的所有点集

(defun GetPlinePts( name / ents pts)
  (setq ents (entget name))
  (while (setq ents (member (assoc 10 ents) ents))
    (setq pts (append pts (list (cdar ents))))
    (setq ents (cdr ents))
  )
  pts
)

;;测试:
(defun c:tt(/ lst re tblst ss n)
  (command "undo" "be")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (setq slenall (sslength ss) index 0)
  (while (< index slenall)
    (setq name (ssname ss index) index (1+ index))
    (setq lst (append lst (GetPlinePts name)))
  )
  (setq tblst (XD_convex_hull lst))
  (command "._pline" )
  (foreach n tblst
    (command "non" n)
    )
  (command)
  (command "undo" "e")
  (print tblst)
  (princ)
 
  )

尘缘一生

lemonbox 发表于 2006-4-13 16:12
贴一下程序代码，小弟我刚学lisp不久，现在遇到问题，希望各位高手帮帮忙啊～～
&nbsp;
(vl-load-com)

顶起来。。。。