【炫翔】根据点表生成直线最快方法

炫翔

方法一用ENTMAKE

2. ;点集生成直线
   
3. ;(xx-mk-line-pts '((0 0 0)(0 5 0)(5 0 0)(0 10 5)))
   
4. ;(xx-mk-line-pts (list(getpoint)(getpoint)(getpoint)))
   
5. (DEFUN xx-mk-line-pts(pts / lst)
   
6.   (setq lst (xx-lst-DengFen pts 2))
   
7.   (mapcar(function(lambda (x)(xx-mk-line (car x) (cadr x)))) lst)
   
8. )
   
9. 
   
10. (defun xx-lst-DengFen (Lst mun / flag i k n rl tmp)
    
11. (IF(AND(= (type LST) 'LIST)(= (type MUN) 'INT) )
    
12.   (progn
    
13.     (setq i 0)
    
14.     (setq n (- (length lsT) (1- MUN)));表的长度减去MUN减去1
    
15.    (repeat n;循环上面的次数
    
16.       (setq k i flag t tmp nil);初始化
    
17.     (while (and flag (nth k lsT));当表的第K个值为真时，循环
    
18.       (setq tmp(cons (nth k lsT) tmp ));组合第K个表元素
    
19.       (setq k (1+ k))
    
20.      (if (zerop(rem (- k i) MUN));直到表中元素为MUN的个数时，?
    
21.         (setq flag nil;退出循环
    
22.                rl (cons (reverse tmp) rl);将表依次加入表
    
23.          )
    
24.       )
    
25.      )
    
26.     (setq i (1+ i))
    
27.    )
    
28.    (reverse rl);跌倒表
    
29.   )
    
30.   (princ "\n xx-lst-DengFen  错了！")
    
31. )
    
32. )
    
33. 
    
34. (defun xx-mk-line (pt1 pt2)
    
35. (if(and pt1 pt2)
    
36.   (progn
    
37.    (entmake(list '(0 . "line")(cons 10 pt1)(cons 11 pt2)))
    
38.   )
    
39.   (princ "\n xx-mk-line  错了！")
    
40. )(entlast)
    
41. )
    
42. 
    
43. 
    
44. 
    

;点集生成直线<br /> ;(xx-mk-line-pts '((0 0 0)(0 5 0)(5 0 0)(0 10 5)))<br /> ;(xx-mk-line-pts (list(getpoint)(getpoint)(getpoint)))<br /> (DEFUN xx-mk-line-pts(pts / lst)<br />   (setq lst (xx-lst-DengFen pts 2))<br />   (mapcar(function(lambda (x)(xx-mk-line (car x) (cadr x)))) lst)<br /> )<br /> <br /> (defun xx-lst-DengFen (Lst mun / flag i k n rl tmp)<br /> (IF(AND(= (type LST) 'LIST)(= (type MUN) 'INT) )<br />   (progn<br />     (setq i 0)<br />     (setq n (- (length lsT) (1- MUN)));表的长度减去MUN减去1<br />    (repeat n;循环上面的次数<br />       (setq k i flag t tmp nil);初始化<br />     (while (and flag (nth k lsT));当表的第K个值为真时，循环<br />       (setq tmp(cons (nth k lsT) tmp ));组合第K个表元素<br />       (setq k (1+ k))<br />      (if (zerop(rem (- k i) MUN));直到表中元素为MUN的个数时，?<br />         (setq flag nil;退出循环<br />                rl (cons (reverse tmp) rl);将表依次加入表<br />          )<br />       )<br />      )<br />     (setq i (1+ i))<br />    )<br />    (reverse rl);跌倒表<br />   )<br />   (princ "\n xx-lst-DengFen  错了！")<br /> )<br /> )<br /> <br /> (defun xx-mk-line (pt1 pt2)<br /> (if(and pt1 pt2)<br />   (progn <br />    (entmake(list '(0 . "line")(cons 10 pt1)(cons 11 pt2)))<br />   )<br />   (princ "\n xx-mk-line  错了！")<br /> )(entlast)<br /> )<br /> <br /> <br /> <br />

方法二：用CAD命令

2. (defun xxx (pts / os)
   
3. (setq os(getvar 'osmode))
   
4. (setvar "osmode" 0)
   
5.   (vl-cmdf "_.line")
   
6.   (mapcar 'vl-cmdf pts)
   
7.   (vl-cmdf "")
   
8.   (setvar "osmode" os)
   
9. )

(defun xxx (pts / os)<br /> (setq os(getvar 'osmode))<br /> (setvar "osmode" 0)<br />   (vl-cmdf "_.line")<br />   (mapcar 'vl-cmdf pts)<br />   (vl-cmdf "")<br />   (setvar "osmode" os)<br /> )

测试程序

2. (defun get-utime()(* 86400.0 (getvar"tdusrtimer")))
   
3. (defun c:xx ( / pt pts)
   
4.   (setq pt (getpoint) pts nil)
   
5.   (repeat 100000
   
6.    (setq pts(cons (setq pt1 (polar pt (* pi 0.5) 1)) pts))
   
7.    (setq pt pt1)
   
8.   )
   
9.   (setq t1(get-utime))
   
10.   (xxx pts)
    
11.   (setq t2(get-utime))
    
12.   (PRINC (list 0 0 (- t2 t1)))
    
13.   (princ)
    
14. )

(defun get-utime()(* 86400.0 (getvar"tdusrtimer")))<br /> (defun c:xx ( / pt pts)<br />   (setq pt (getpoint) pts nil)<br />   (repeat 100000<br />    (setq pts(cons (setq pt1 (polar pt (* pi 0.5) 1)) pts))<br />    (setq pt pt1)<br />   )<br />   (setq t1(get-utime))<br />   (xxx pts)<br />   (setq t2(get-utime))<br />   (PRINC (list 0 0 (- t2 t1)))<br />   (princ)<br /> )

st788796

(mapcar '(lambda (p1 p2) (mkline p1 p2)) pts (cdr pts))

snsj

肯定ENTMAKE快，VLA/VBA/.NET/COMMAND/VL-CMDF/ENTMAKE   比较，C++没有测试过

XDSoft

翔版，把测试数据贴出来啊。

Love-Lisp

炫翔版主的entmake 点表直线的代码写的太累赘了，肯定没效率！

1. (defun mkline (pts / p1 p2)
   
2.   (setq p1 (car pts)
   
3.   pts (cdr pts))
   
4.   (foreach p2 pts
   
5. (entmake      (list '(0 . "line")
   
6.             '(100 . "AcDbEntity")
   
7.             '(67 . 0)
   
8.             '(410 . "Model")
   
9.             '(100 . "AcDbLine")
   
10.             (cons 10 p1)
    
11.             (cons 11 p2)
    
12.             )
    
13.       )
    
14.     (setq p1 p2)
    
15.     )
    
16.   )

(defun mkline (pts / p1 p2)<br />   (setq p1 (car pts)<br />   pts (cdr pts))<br />   (foreach p2 pts<br /> (entmake      (list '(0 . "line")<br />             '(100 . "AcDbEntity")<br />             '(67 . 0)<br />             '(410 . "Model")<br />             '(100 . "AcDbLine")<br />             (cons 10 p1)<br />             (cons 11 p2)<br />             )<br />       )<br />     (setq p1 p2)<br />     )<br />   )

炫翔

另一种思路:测试时间为:2.0几秒

2. (defun makline (lst)
   
3.    (entmake
   
4.       (append   
   
5.          (list
   
6.            '(0 . "lwpolyline")
   
7.            '(100 . "AcDbEntity")
   
8.            '(100 . "AcDbPolyline")
   
9.            (cons 90 (length lst))
   
10.          )
    
11.       (mapcar (function (lambda (pt)(cons 10 pt))) lst )
    
12.      )
    
13.    )
    
14.    (vl-cmdf "_.EXPLODE" (entlast) "")
    
15. )

(defun makline (lst)<br />    (entmake <br />       (append    <br />          (list <br />            '(0 . "lwpolyline")<br />            '(100 . "AcDbEntity")<br />            '(100 . "AcDbPolyline")<br />            (cons 90 (length lst))<br />          )<br />       (mapcar (function (lambda (pt)(cons 10 pt))) lst )<br />      )<br />    )<br />    (vl-cmdf "_.EXPLODE" (entlast) "")<br /> )

就念鱼儿

st788796 发表于 2013-11-11 06:45
(mapcar '(lambda (p1 p2) (mkline p1 p2)) pts (cdr pts))

虽然不懂，但还是支持