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)就对了。是什么原因?
页: 1 2 3 4 5 [6] 7
查看完整版本: 【越飞越高讲堂12】最小包围盒和最大距离点对