shiyan001
发表于 2013-5-9 17:56:32
楼主讲的透彻。
chmenf087
发表于 2013-5-9 23:54:32
Mark,论坛为什么没有收藏功能。。。
linjian257
发表于 2013-8-12 12:03:17
谢谢高飞鸟无私的分享与精细的讲解
caoliu023
发表于 2013-8-14 22:33:06
受益匪浅,努力学习
tender138
发表于 2013-11-2 08:03:20
非常感谢这样无私高手!!!祝家庭幸福!!!
自贡黄明儒
发表于 2014-4-5 20:25:07
本帖最后由 自贡黄明儒 于 2014-4-5 20:29 编辑
有外就有内,那最大内接正方形该怎么求?
自贡黄明儒
发表于 2014-11-14 15:33:13
highflybir 发表于 2010-6-4 23:24 static/image/common/back.gif
在上篇帖子中我已经说明了这个算法的大致思想。下面我贴出源码,具体算法我要强调的一点是:
我构造了一个循 ...
正在研读你指引给我的这个链接。
前段时间之所以关心素数,觉得让使用者输入200~2000有点不知所措,故改成如下;;;The procedure for Test
(defun C:w1 (/ AREA1 AREA2 LST N PP PTLIST SCORE SEL T0 X)
(princ "\nPlease select LWPOLYLINE,LINE,SPLINE,POINT")
(cond
((setq
sel (ssget (list '(0 . "POINT,LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
)
(initget 7)
(setq n (getint "\n精度:"))
(setq t0 (getvar "TDUSRTIMER")) ;The start time of this algorithm
(setq lst (Sprime2 200 2000)) ;素数
(setq area1 0)
(while (and (setq x (car lst)) (not (equal area1 area2 n)))
(setq area2 area1)
(setq ptlist (Graham-scan (getpt sel x))) ;construct the CCW Hull of this set.
;|;扫描后的点本身就逆时针(sort-by-angle-distance),下面一句好象没有什么用处。
(if (<= (det (car ptlist) (cadr ptlist) (caddr ptlist)) 0.0)
;ensure the hull is CCW.
(setq ptlist (reverse ptlist)) ;if it isn't CCW,then reverse it
)|;
(setq score (MinAreaRectangle ptlist))
(setq area1 (cdr score))
(setq lst (cdr lst))
)
(princ "\nIt takes :")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400)) ;The End time
(princ "seconds")
(if (setq pp (car score)) ;start calculating
(make-poly pp) ;draw rectangle.
)
)
)
(princ)
)
;;[功能] 小于n的质数
;;(SPrime 100)=>(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
(defun Sprime (n / I K L LST ROOT)
(setq i 1)
(setq root (sqrt n))
(while (<= (setq i (+ i 2)) n) (setq l (cons i l)))
(setq l (reverse l))
(while (and (setq k (car l)) (<= k root))
(setq l (vl-remove-if '(lambda (x) (= (rem x k) 0)) (cdr l)))
(setq lst (cons k lst))
)
(append '(2) (reverse lst) l)
)
;;[功能] n1 n2之间的质数
;;(Sprime 200 2000)
(defun Sprime2 (n1 n2 / LST)
(setq lst (Sprime n2))
(vl-remove-if '(lambda (x) (< x n1)) lst)
)
拖拖_拉拉_
发表于 2014-12-16 11:09:39
太强了~~
自贡黄明儒
发表于 2014-12-17 20:45:17
vlisp2012 发表于 2013-4-1 19:48
想要批量实现任意四边形和三角形的最小包围盒,没成功。
哪位大师,帮一下忙!
这个扫锚程序很强大,用处多,加上最近的取点函数,就可对任意曲线求最小包围盒了
自贡黄明儒
发表于 2014-12-19 11:12:55
highflybir 发表于 2010-6-4 23:24 static/image/common/back.gif
在上篇帖子中我已经说明了这个算法的大致思想。下面我贴出源码,具体算法我要强调的一点是:
我构造了一个循 ...
(setq INF 1e309)
放在win7 编译后的lisp中,不认识,我改成(setq INF 1e200)就对了。是什么原因?