如何提升此程序运行的速度？

革天明

(defun c:myqrcode ()
  (setq        str
         "1111111011101101001111111-1000001011100101001000001-1011101010110110001011101-1011101011010011001011101-1011101000000110101011101-1000001010011101101000001-1111111010101010101111111-0000000001001100000000000-1100111000010011000101111-0111110111101100101001110-1001101000011010010101011-0101010110110111001111001-1101111100101100110100111-1111010100000001001111110-0000011111000000101000101-0000000111001100111000001-1110101100010011111110001-0000000011101100100011101-1111111000111111101010101-1000001010010110100011001-1011101011101011111110111-1011101001100001110110111-1011101001100011010111110-1000001010101011001101010-1111111011111111110011111"
  )
  (setq strlst (split str "-"))
  (YTM-QRCODE strlst (getpoint))
  (redraw)
  (vl-cmdf "zoom" "e")
)
(defun YTM-QRCODE
       (strlst pt / YTM-solid str->lst pt-xlst pt-ylst x y m n)
  (defun YTM-solid (pt flag / os)
    (setq os (getvar "osmode"))
    (setvar "osmode" 0)
    (if        (= flag "1")
      (entmake (list (cons 0 "SOLID")
                     (cons 8 "0")
                     (cons 10 pt)
                     (cons 11 (polar pt 0 1))
                     (cons 12 (polar pt (* 1.5 pi) 1))
                     (cons 13 (polar (polar pt 0 1) (* 1.5 pi) 1))
                     (cons 62 0)
               )
      )
    )
    (setvar "osmode" os)
  )
  (defun str->lst (str / i istr strlst)
    (setq i 1
          strlst '()
    )
    (repeat (strlen str)
      (setq istr (substr str i 1))
      (setq strlst (cons istr strlst))
      (setq i (1+ i))
    )
    (reverse strlst)
  )
  (defun pt-xlst (pt n / i xlst pt1)
    (setq i    0
          xlst '()
    )
    (repeat n
      (setq pt1 (polar pt 0 (* i 1)))
      (setq xlst (cons pt1 xlst))
      (setq i (1+ i))
    )
    (reverse xlst)
  )
  (defun pt-ylst (pt n / i ylst pt1)
    (setq i    0
          xlst '()
    )
    (repeat n
      (setq pt1 (list (car pt) (- (cadr pt) (* i 1))))
      (setq ylst (cons pt1 ylst))
      (setq i (1+ i))
    )
    (reverse ylst)
  )
  (setq        strlst (mapcar '(lambda        (x)
                          (str->lst x)
                        )
                       strlst
               )
  )
  (setq        x (length strlst)
        y (length (nth 0 strlst))
  )
  (princ x)
  (princ y)
  (if (= x y)
    (setq ptlst        (mapcar        '(lambda (z)
                           (pt-xlst z x)
                         )
                        (pt-ylst pt y)
                )
    )
  )
  (setq        lastlst        (mapcar        '(lambda (x y)
                           (mapcar '(lambda (x1 y1)
                                      (list x1 y1)
                                    )
                                   x
                                   y
                           )
                         )
                        ptlst
                        strlst
                )
  )
  (foreach n lastlst
    (foreach m n
      (YTM-solid (car m) (cadr m))
    )
  )
)
;;-------------------------------------------------------;;    Split a string;;-------------------------------------------------------(defun split (str                        ; string to split              cara                        ; separator              /        n portion xstring seqstart chrcode portion)  (cond    ((and (= (type str) (type cara) 'STR) (eq (strlen cara) 1))     (setq n            -1           seqstart 1           chrcode  (ascii cara)     )     (while (setq n (vl-string-position chrcode str (+ n 1) nil))       (setq xstring  (append xstring                              (list (substr str seqstart (- n seqstart -1)))                      )             seqstart (+ n 2)       )     )     (setq xstring (append xstring (list (substr str seqstart))))     (if xstring       xstring       (list str)     )    )    ((= (type str) (type cara) 'STR)     (setq portion ""           n 1     )     (if (<= (strlen cara) (strlen str))       (progn         (while        (<= n (strlen str))           (if (eq (substr str n (strlen cara)) cara)             (setq xstring (append xstring (list portion))                   portion ""                   n           (+ n (strlen cara))             )             (setq portion (strcat portion (substr str n 1))                   n           (+ 1 n)             )           )         )         (if           (or (> (strlen portion) 0)               (eq (substr str (abs (- (strlen str) (strlen cara) -1)))                   cara               )           )            (setq xstring (append xstring (list portion)))         )       )       (setq xstring (list str))     )     (if xstring       xstring       (list "")     )    )    (T (list nil))  ))
目前程序运行比较慢，请教如何才有提高运行速度？如果想查看此二维码中的信息，请将CAD的背景调成白色（选项，显示，颜色）或打印出来后进行解码，不然黑色背景是无法解码的。

ll_j

革天明 发表于 2013-3-14 18:00
看下我最后更新的子函数，感觉不到速度上的延迟

仅仅是根据数组画图，应该是不难的，我写了一段代码，可以看看是不是你要的。

1. 
   
2. (defun c:tt()
   
3.   (setq        str
   
4.          "1111111011101101001111111-1000001011100101001000001-1011101010110110001011101-1011101011010011001011101-1011101000000110101011101-1000001010011101101000001-1111111010101010101111111-0000000001001100000000000-1100111000010011000101111-0111110111101100101001110-1001101000011010010101011-0101010110110111001111001-1101111100101100110100111-1111010100000001001111110-0000011111000000101000101-0000000111001100111000001-1110101100010011111110001-0000000011101100100011101-1111111000111111101010101-1000001010010110100011001-1011101011101011111110111-1011101001100001110110111-1011101001100011010111110-1000001010101011001101010-1111111011111111110011111"
   
5.   )
   
6.   (setq pt0 (getpoint "\n二维码左上角："))
   
7.   (setq pt0 (polar (polar pt0 (/ pi 2) 0.5) pi 1.0))
   
8.   (setq str0 str
   
9. ls1 nil
   
10.   )
    
11.   (while (wcmatch str0 "*-*")
    
12.     (setq n (vl-string-search "-" str0)
    
13.    ls1 (cons (substr str0 1 n) ls1)
    
14.    str0(substr str0 (+ 2 n))
    
15.     )
    
16.   )
    
17.   (setq ls1 (reverse (cons str0 ls1))
    
18. ls1 (mapcar 'vl-string->list ls1))
    
19.   (mapcar
    
20.     '(lambda(y)
    
21.        (setq pt1 (polar pt0 (/ pi -2) 1.0)
    
22.       pt0 pt1
    
23.        )
    
24.        (mapcar
    
25.   '(lambda(x)
    
26.      (setq pt1 (polar pt1 0.0 1.0))
    
27.      (if (= x 49)
    
28.        (mkpl pt1)
    
29.      )
    
30.    )
    
31.   y
    
32.        )
    
33.      )
    
34.     ls1
    
35.   )
    
36.   (princ)
    
37. )
    
38. (defun mkpl(pt)
    
39.   (entmake (list '(0 . "lwpolyline")
    
40.    '(100 . "AcDbEntity")
    
41.    '(100 . "AcDbPolyline")
    
42.    '(90 . 2)
    
43.    '(43 . 1.0)
    
44.    (cons 10 pt)
    
45.    (cons 10 (polar pt 0.0 1.0))
    
46.     )
    
47.   )
    
48. )
    

<br /> (defun c:tt()<br />   (setq        str<br />          "1111111011101101001111111-1000001011100101001000001-1011101010110110001011101-1011101011010011001011101-1011101000000110101011101-1000001010011101101000001-1111111010101010101111111-0000000001001100000000000-1100111000010011000101111-0111110111101100101001110-1001101000011010010101011-0101010110110111001111001-1101111100101100110100111-1111010100000001001111110-0000011111000000101000101-0000000111001100111000001-1110101100010011111110001-0000000011101100100011101-1111111000111111101010101-1000001010010110100011001-1011101011101011111110111-1011101001100001110110111-1011101001100011010111110-1000001010101011001101010-1111111011111111110011111"<br />   )<br />   (setq pt0 (getpoint "\n二维码左上角："))<br />   (setq pt0 (polar (polar pt0 (/ pi 2) 0.5) pi 1.0))<br />   (setq str0 str<br /> ls1 nil<br />   )<br />   (while (wcmatch str0 "*-*")<br />     (setq n (vl-string-search "-" str0)<br />    ls1 (cons (substr str0 1 n) ls1)<br />    str0(substr str0 (+ 2 n))<br />     )<br />   )<br />   (setq ls1 (reverse (cons str0 ls1))<br /> ls1 (mapcar 'vl-string->list ls1))<br />   (mapcar<br />     '(lambda(y)<br />        (setq pt1 (polar pt0 (/ pi -2) 1.0)<br />       pt0 pt1<br />        )<br />        (mapcar<br />   '(lambda(x)<br />      (setq pt1 (polar pt1 0.0 1.0))<br />      (if (= x 49)<br />        (mkpl pt1)<br />      )<br />    )<br />   y<br />        )<br />      )<br />     ls1<br />   )<br />   (princ)<br /> )<br /> (defun mkpl(pt)<br />   (entmake (list '(0 . "lwpolyline")<br />    '(100 . "AcDbEntity")<br />    '(100 . "AcDbPolyline")<br />    '(90 . 2)<br />    '(43 . 1.0)<br />    (cons 10 pt)<br />    (cons 10 (polar pt 0.0 1.0))<br />     )<br />   )<br /> )<br />

xiaxiang

替换split函数试试

2. 
   
3. (defun split  (source chars)
   
4. (mapcar (function (lambda (m n) (substr source (+ 2 m) (- n m 1))))
   
5.          (cons -1
   
6.                (setq chars
   
7.                       (vl-sort
   
8.                         (apply
   
9.                           'append
   
10.                           (mapcar
    
11.                             (function (lambda (code / result n)
    
12.                                         (setq n -1)
    
13.                                         (while (setq n (vl-string-position
    
14.                                                          code
    
15.                                                          source
    
16.                                                          (1+ n)))
    
17.                                           (setq result (cons n result)))
    
18.                                         result))
    
19.                             (vl-string->list chars)))
    
20.                         '<)))
    
21.          (append chars (list (strlen source)))))

<br /> (defun split  (source chars)<br /> (mapcar (function (lambda (m n) (substr source (+ 2 m) (- n m 1))))<br />          (cons -1<br />                (setq chars<br />                       (vl-sort<br />                         (apply<br />                           'append<br />                           (mapcar<br />                             (function (lambda (code / result n)<br />                                         (setq n -1)<br />                                         (while (setq n (vl-string-position<br />                                                          code<br />                                                          source<br />                                                          (1+ n)))<br />                                           (setq result (cons n result)))<br />                                         result))<br />                             (vl-string->list chars)))<br />                         '<)))<br />          (append chars (list (strlen source)))))

阿然

我也贴个lee大的split

1. ;;字符串=>字条串列表 By Lee Mac
   
2. ;;(BAtte:str->lst "A,B" ",")返回("A" "B")
   
3. (defun BAtte:str->lst (str del / pos)
   
4.   (if (setq pos (vl-string-search del str))
   
5.     (cons (substr str 1 pos)
   
6.           (BAtte:str->lst (substr str (+ pos 1 (strlen del))) del)
   
7.     )
   
8.     (list str)
   
9.   )
   
10. )
    

;;字符串=>字条串列表 By Lee Mac<br /> ;;(BAtte:str->lst "A,B" ",")返回("A" "B")<br /> (defun BAtte:str->lst (str del / pos)<br />   (if (setq pos (vl-string-search del str))<br />     (cons (substr str 1 pos)<br />           (BAtte:str->lst (substr str (+ pos 1 (strlen del))) del)<br />     )<br />     (list str)<br />   )<br /> )<br />

关于这个二维码，我的想法是不管三七二十八，所有的小solid阵列全画出来，然后根据二维码数据，控制小solid的visable就可以了，这样速度应该更快。

革天明

xiaxiang 发表于 2013-3-11 11:14
替换split函数试试

应该不是这个函数，是生成solid的有问题，此例中使用了entmake来生成solid，但是还是速度慢，不知道是什么原因

xiaxiang

革天明 发表于 2013-3-11 11:41
应该不是这个函数，是生成solid的有问题，此例中使用了entmake来生成solid，但是还是速度慢，不知道是什么 ...

已经测试不生成solid就不慢了吗？

阿然

革天明 发表于 2013-3-11 11:41
应该不是这个函数，是生成solid的有问题，此例中使用了entmake来生成solid，但是还是速度慢，不知道是什么 ...

关于这个二维码，我的想法是不管三七二十八，所有的小solid阵列全画出来，然后根据二维码数据，控制小solid的visable就可以了，这样速度应该更快

革天明

xiaxiang 发表于 2013-3-11 11:44
已经测试不生成solid就不慢了吗？

你说的对，
(if        (= flag "1")
;;;      (entmake (list (cons 0 "SOLID")
;;;                     (cons 8 "0")
;;;                     (cons 10 pt)
;;;                     (cons 11 (polar pt 0 1))
;;;                     (cons 12 (polar pt (* 1.5 pi) 1))
;;;                     (cons 13 (polar (polar pt 0 1) (* 1.5 pi) 1))
;;;                     (cons 62 0)
;;;               )
;;;      )
      (princ)
    )
现在还是慢，我得仔细研究一下哪个环节造成的运行速度慢

革天明

如何测试程序在某段代码的运行时间？

xiaxiang

革天明 发表于 2013-3-11 11:48
如何测试程序在某段代码的运行时间？

用benchmark，用法里面有说明