本帖最后由 hhc 于 2012-12-13 14:04 编辑
lisp调用dll,很好
<p>有个问题：</p><p>希望能调用DLL，生成一个随机排列数组的函数。</p><p>例如有一个数组，元素可能有上百万个，现在要对这个数组的元素随机排列，就像洗牌那样。生成这样一个函数，最后供Vlisp调用。算法上最好能对空间和时间都有照顾！</p><p>以前曾经考虑直接用lisp，但没有成功。下面我引用一段VB代码，只不过是一个特例：</p><p> Dim a(3) As Integer <br/> Private Sub Form_Load() <br/> a(0) = 3 <br/> a(1) = 6 <br/> a(2) = 8 <br/> a(3) = 9 <br/> End Sub <br/> Private Sub Command1_Click() <br/> <br/> Randomize <br/> <br/> Dim tmp <br/> Dim tmp_index As Integer <br/> Dim Lb As Integer, Ub As Integer <br/> Lb = LBound(a) <br/> Ub = UBound(a) <br/> <br/> Dim i As Integer <br/> For i = Lb To Ub <br/> tmp_index = Int((Ub - Lb + 1) * Rnd + Lb) <br/> tmp = a(i) <br/> a(i) = a(tmp_index) <br/> a(tmp_index) = tmp <br/> Next <br/> For i = Lb To Ub <br/> Debug.Print "a(" & i & ")=" & a(i) <br/> Next <br/> End Sub</p>
(defun rnd(rMin rMax / e)
(vla-eval (vlax-get-acad-object) "Randomize : ThisDrawing.setVariable \"USERR5\" ,CDbl((Rnd))" )
(setq e (+ rMin (* (getvar "userr5")(- rMax rMin))) )
(if (= 'INT (type rmin)(type rmax))
(fix e)
e
)
)
(defun rndsort (lst / len a lst2)
(repeat (setq len (length lst))
(while (member (setq a (rnd 0 len)) lst2));;这步算法可优化
(setq lst2 (cons a lst2))
)
(mapcar '(lambda (x) (nth x lst)) lst2)
);; 测试:
(defun c:tt (/ lst)
(setq lst '(-562969 777 -97 -389-827-197 -850-265
-933942 444 354 629 -95 612 909 -852
-267868 428 127 -324845 -834 -203962
142 561 721 305 347 314 -925 -154-845
-506575 688 427 -545-752-495 121 -886
-691364 -758 193 36 324 -762 174 -64
-182868 698 483 454 -167456 984 -628
812 861 -901 707 897 -745226 107 943
-79883 -18 -583327 589 -703 -154-461
263 -374449 -62 -962-567-764 -860-967
-139399 -271 772 -157573 -613 -964827
554
)
)
(repeat 10
(print (rndsort lst))
)
)
本帖最后由 作者 于 2007-1-19 2:23:57 编辑
(defun rnd(rMin rMax / e)
(vla-eval (vlax-get-acad-object) "Randomize : ThisDrawing.setVariable \"USERR5\" ,CDbl((Rnd))" )
(setq e (+ rMin (* (getvar "userr5")(- rMax rMin))) )
(if (= 'INT (type rmin)(type rmax))
(fix e)
e
)
)
(defun rndsort (lst / len a lst2)
(repeat (setq len (length lst))
(while (and
(member (setq a (rnd 0 len)) lst2);;这步算法可优化
(or(= 0 a)(member (setq a (1- a)) lst2))
(or(= a (1- len))(member (setq a (1+ a)) lst2))
)
)
(setq lst2 (cons a lst2))
)
(mapcar '(lambda (x) (nth x lst)) lst2)
)
;; 测试:
(defun c:tt (/ lst)
(setq lst '(-562969 777 -97 -389-827-197 -850-265-933942 444 354 629 -95 612 909 -852
-267868 428 127 -324845 -834 -203962142 561 721 305 347 314 -925 -154-845
-506575 688 427 -545-752-495 121 -886-691364 -758 193 36 324 -762 174 -64
-182868 698 483 454 -167456 984 -628812 861 -901 707 897 -745226 107 943
-79883 -18 -583327 589 -703 -154-461263 -374449 -62 -962-567-764 -860-967
-139399 -271 772 -157573 -613 -964827554))
(repeat 10
(print (rndsort lst))
)
)
这个快一点
(defun rndsort3 (lst / A b I LEN LEN2 LST2 LST3)
;;构造0~(表长-1)整数序列.
(setq len (length lst))
(repeat (setq b len)
(setq lst2 (cons (setq b (1- b)) lst2))
)
(repeat len
(setq i (rnd 0 (length lst2))
a (nth i lst2)
lst3 (cons a lst3)
lst2 (vl-remove a lst2))
)
(mapcar '(lambda (x) (nth x lst)) lst3)
)
这个帖子抛了块砖，没想到引来了一堆玉。真是不错。这个帖子就是给大家介绍LISP调用DLL文件。这只是个简单引用。但可以编些其他VB函数来供LISP调用。
试试我这个:
(defun rndsortlst (lst / rndlst)
(repeat (length lst)
(setq rndlst (cons (rnd) rndlst))
)
(setq rndlst (vl-sort-i rndlst '>))
(mapcar '(lambda (a) (nth a lst)) rndlst)
)
快吗？
<p>16樓(rnd)???</p><p>調用dll還會快嗎?</p><p>;;BY LUCAS (排1千個)</p><p>(defun RND_LAI (/ STR)<br/> (setq STR (rtos (getvar "cputicks") 2 0))<br/> (/ (atoi (substr STR (- (strlen STR) 3))) 10000.0)<br/>)</p><p>;;---------------------------------------------------<br/>(defun RNDSORT5 (LEN / A B I LST2 LST3)<br/> (repeat (setq B LEN)<br/> (setq LST2 (cons (setq B (1- B)) LST2))<br/> )<br/> (repeat LEN<br/> (setq I (fix (* LEN (RND_LAI)))<br/> LEN (1- LEN)<br/> A (nth I LST2)<br/> LST3 (cons A LST3)<br/> LST2 (vl-remove A LST2)<br/> )<br/> )<br/> LST3<br/>)</p><p>(defun C:TT (/ N LST)<br/> (setq N 0<br/> LST NIL<br/> )<br/> (repeat 1000<br/> (setq LST (cons (setq N (1+ N)) LST))<br/> )<br/> (setq STIME (getvar "date"))<br/> (setq LST (mapcar '(lambda (X) (nth X LST)) (RNDSORT5 (length LST))))<br/> (setq ETIME (getvar "date"))<br/> (prompt<br/> (strcat<br/> "\n程式共耗用時間: "<br/> (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME))))<br/> 2<br/> 3<br/> )<br/> "秒\n"<br/> )<br/> )<br/> LST<br/>)<br/></p>
<p>to fsxm：</p><p>的确比无痕的快，谢谢fsxm!但还没明白怎么回事，不知能否把那个rnd函数的源码贴上来呢？</p><p>to 龙版主：</p><p>从你这儿又学了一招!有一个问题是，如果利用cputicks来作随机数，是不是有一定局限性，譬如受浮点影响呢？</p><p></p><p></p>
本帖最后由 作者 于 2007-1-23 0:05:14 编辑
(defun C:TT2 (/ ETIME LST N STIME X)
(setq N 0
LST NIL
)
(repeat 10000
(setq LST (cons (setq N (1+ N)) LST))
)
(setq STIME (getvar "date"))
(setq LST (mapcar '(lambda (X) (nth X LST)) (rndsi (length lst))))
(setq ETIME (getvar "date"))
(prompt
(strcat
"\n程式共耗用時間: "
(rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME))))
2
3
)
"秒\n"
)
)
LST
)
程式共耗用時間: 0.469秒
程序也用了cputicks
rndsi和tt2已经打包,下载解压后调入cad可直接运行tt2