请教一个关于凸包的问题！
<P>通过参考wkai的凸包程序用lisp实现了求多条pline的凸包</P><P>但是当pline中包含曲线，且在边缘处时，就会出现曲线和凸包交叉的问题，因为我的凸包没有考虑出现曲线的情况，现在需要改进这个凸包程序，请问如何才能在出现曲线的地方将凸包也变成曲线呢？？？</P>UploadFile/2006-4/200641313596793.jpg <P>贴一下程序代码，小弟我刚学lisp不久，现在遇到问题，希望各位高手帮帮忙啊～～</P>
<P> </P>
<P>(vl-load-com)</P>
<P>;;表通用复合排序函数<BR>;;功能 :对表进行复合排序<BR>;;参数lst:需要被排序的表<BR>;;sortlst:排序命令序列表<BR>;;返回值 :排序后的表<BR>;;<BR>;;示例:(XDL-SORT '(0 2 3 7 8 5 7 ) '>)<BR>;; 从大到小排序<BR>;; --->>(8 7 5 3 2 0)<BR>;; (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '(0 >))<BR>;; 第0项从大到小排序<BR>;; --->>((9 6) (9 5) (8 7) (7 8) (6 9) (5 9) (1 0) (0 1))<BR>;; (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '((0 >)( 1 <)))<BR>;; 第0项从大到小第1项从小到大排序;;<BR>;; --->>((9 5) (9 6) (8 7) (7 8) (6 9) (5 9) (1 0) (0 1))<BR>;; (XDL-SORT '((0 1)(1 0)(9 6)(9 5)(5 9)(6 9)(7 8)(8 7)) '(( 1 <)(0 >)))<BR>;; 第1项从小到大第0项从大到小排序<BR>;; --->>((1 0) (0 1) (9 5) (9 6) (8 7) (7 8) (6 9) (5 9))<BR>(defun XDL-SORT(lst sortlst / n)<BR> (if (listp sortlst)<BR> (if (listp (car sortlst))<BR> (setq sortlst (reverse sortlst))<BR> (setq sortlst (list sortlst))<BR> )<BR> (setq sortlst (list (list nil sortlst)))<BR> )<BR> (foreach n sortlst<BR> (setq lst (vl-sort lst '(lambda (s1 s2)<BR> (apply (cadr n) (list (if (car n) (nth (car n) s1)s1)<BR> (if (car n) (nth (car n) s2)s2))))))<BR> )<BR> )</P>
<P>;;删除表相同元素<BR>;;pts:表 fuzz:精度 <BR>(defun lst-remove-dups(pts fuzz / pt x) <BR>(cond ((=(length pts)1) pts) <BR> (t(setq pt(car pts)) <BR> (cons pt(vl-remove-if '(lambda(x)(equal pt x fuzz)) <BR> (lst-remove-dups(cdr pts)fuzz)) <BR> ) <BR> )) <BR>)</P>
<P><BR>;;取与pt的角度与an差最小的距离最远的点<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 (XDL-SORT re '((0 <)(1 >))))<BR> (last(car re))<BR>)</P>
<P><BR>;;获得包含点表的凸包点表 <BR>;;Graham扫描法<BR>;;参数lst:坐标点表<BR>;;返回值:凸包点表(逆时针)<BR>(defun XD_convex_hull (lst / re tblst AN BG RESULT)<BR> ;;按与pt的角度对点表排序<BR> (setq lst (lst-remove-dups lst 0)) <BR> (setq lst (XDL-SORT 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>)</P>
<P>;;获得pline的所有点集</P>
<P>(defun GetPlinePts( name / ents pts)<BR> (setq ents (entget name))<BR> (while (setq ents (member (assoc 10 ents) ents))<BR> (setq pts (append pts (list (cdar ents))))<BR> (setq ents (cdr ents))<BR> )<BR> pts<BR>)</P>
<P><BR>;;测试:<BR>(defun c:tt(/ lst re tblst ss n)<BR> (command "undo" "be")<BR> (setq ss (ssget '((0 . "LWPOLYLINE"))))<BR> (setq slenall (sslength ss) index 0)<BR> (while (< index slenall)<BR> (setq name (ssname ss index) index (1+ index))<BR> (setq lst (append lst (GetPlinePts name))) <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> )</P> lemonbox 发表于 2006-4-13 16:12
贴一下程序代码，小弟我刚学lisp不久，现在遇到问题，希望各位高手帮帮忙啊～～
(vl-load-com)
顶起来。。。。
页:
[1]