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

革天明

每生成一个solid需要0.015秒，21*21个，还是6秒多，看来是快不起来了啊

革天明

下面是老外的程序，需要联网，运行速度比较快，但我不知道如何才有将我的程序改成也生成块，而且速度会提升。
;*********************************************************************************
; QRCODE for Autocad
; © 2010 swisscad / Ian Vogel
; V 0.91 released 2010.08.22
;*********************************************************************************
(defun c:QRcode ( / str)
(cond
((not (validstr (setq str (getstring "\nEnter Text to encode :" T))))
(princ "\nNo text entered")
)
((QRcode str (setq name "QRCode") 0)
(command "_REGENALL")
(command "_INSERT" name)
)
)
(princ)
)
(defun QRcode (string ; string to encode
blockname ; name of the block to create
options ; options
; 1 = perform only if block already exists
/ QR x y startx row)
(vl-load-com)
(cond
((not (validstr blockname)))
((or (zerop (logand 1 options))
(tblsearch "BLOCK" blockname)
)
(setq baseurl "www.xcad.ch/tests/getqrcode.php")
(setq QR (valstr (gethttp (strcat baseurl"%3Fstring=" (urlencode (urlencode string))) 0)))
(cond
((eq (substr QR 1 6) "111111");response OK
(setq QR (split QR "-")
y 0)
;create Qrcode block
(entmake (list '(0 . "BLOCK")
(cons 2 blockname)
'(8 . "0")
'(70 . 0)
'(10 0.0 0.0 0.0)
)
)
(foreach row QR
(setq x 0)
(while (< x (strlen row))
(cond
((eq (substr row (1+ x) 1) "1")
;memorize start of filled zone
(if (not startx)(setq startx x))
(if (not (eq (substr row (+ x 2) 1) "1"))
(progn
;draw filled zone
(entmake (list (cons 0 "SOLID")
(cons 8 "0")
(cons 10 (list startx y))
(cons 11 (list (1+ x) y))
(cons 12 (list startx (1- y)))
(cons 13 (list (1+ x)(1- y)))
(cons 62 0)
)
)
(setq startx nil)
))
))
(setq x (1+ x))
)
(setq y (1- y))
)
;end of block
(setq bl_a (entmake '((0 . "ENDBLK"))))
)
)
T
))
)
;-------------------------------------------------------
; Get an URL
;-------------------------------------------------------
(defun gethttp (lien
opt
/ fi line tmp util content)
(setq        util (vla-get-Utility
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(if (eq (vla-isurl util lien) :vlax-true)
(if        (vl-catch-all-error-p
(vl-catch-all-apply
'vla-GetRemoteFile
(list util lien 'tmp :vlax-true)
)
)
(princ "\nError getting http file.")
(progn
(setq fi (open tmp "r")
content "")
(while (setq line (read-line fi))
(setq content (strcat content line))
)
(close fi)
)
)
)
content
)
;-------------------------------------------------------
; Turn any var to a string
;-------------------------------------------------------
(defun valstr (val)
(cond
((eq (type val) 'STR) val)
((eq (type val) 'REAL) (rtos val))
((eq (type val) 'INT) (itoa val))
(T "")
))
;-------------------------------------------------------
; Check that a string is not empty
;-------------------------------------------------------
(defun validstr (str / tmp)
(if (> (strlen (setq tmp (trim (valstr str)))) 0) tmp nil)
)
;-------------------------------------------------------
; Remove blanks from a string
;-------------------------------------------------------
(defun trim ( str / )
(setq str (valstr str))
(while (eq (substr str 1 1) " ")
(setq str (substr str 2))
)
(while (and (> (strlen str) 1)
(eq (substr str (strlen str) 1) " ")
)
(setq str (substr str 1 (- (strlen str) 1)))
)
str
)

;-------------------------------------------------------
; 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))
)
)
;----------------------------------------------------------
; See PHP function
; http://ch2.php.net/manual/fr/function.htmlentities.php
;----------------------------------------------------------
(defun urlencode (str / result n len )
(setq result ""
n 1
len (strlen str))

(while (<= n len)
(setq result (strcat result (urlenc (substr str n 1)))
n (+ 1 n))
)
result
)
(defun urlenc (ch)
(cond
((eq ch " ") " ");+
((eq ch "!") "%21")
((eq ch "\"") "%22")
((eq ch "#") "%23")
((eq ch "$") "%24")
((eq ch "%") "%25")
((eq ch "&") "%26")
((eq ch "'") "%27")
((eq ch "(") "%28")
((eq ch ")") "%29")
((eq ch "*") "%2A")
((eq ch "+") "%2B")
((eq ch ",") "%2C")
((eq ch "/") "%2F")
((eq ch ":") "%3A")
((eq ch ";") "%3B")
((eq ch "<") "%3C")
((eq ch "=") "%3D")
((eq ch ">") "%3E")
((eq ch "?") "%3F")
((eq ch "@") "%40")
((eq ch "[") "%5B")
((eq ch "\\") "%5C")
((eq ch "]") "%5D")
((eq ch "^") "%5E")
((eq ch "`") "%60")
((eq ch "{") "%7B")
((eq ch "|") "%7C")
((eq ch "}") "%7D")
((eq ch "~") "%7E")
((eq ch "‘") "%91")
((eq ch "’") "%92")
((eq ch "&#161;") "%A1")
((eq ch "￠") "%A2")
((eq ch "￡") "%A3")
((eq ch "¤") "%A4")
((eq ch "￥") "%A5")
((eq ch "|") "%A6")
((eq ch "§") "%A7")
((eq ch "¨") "%A8")
((eq ch "&#169;") "%A9")
((eq ch "a") "%AA")
((eq ch "&#171;") "%AB")
((eq ch "&#172;") "%AC")
((eq ch "-") "%AD")
((eq ch "&#174;") "%AE")
((eq ch "ˉ") "%AF")
((eq ch "°") "%B0")
((eq ch "±") "%B1")
((eq ch "2") "%B2")
((eq ch "3") "%B3")
((eq ch "′") "%B4")
((eq ch "μ") "%B5")
((eq ch "&#182;") "%B6")
((eq ch "·") "%B7")
((eq ch "&#184;") "%B8")
((eq ch "1") "%B9")
((eq ch "o") "%BA")
((eq ch "&#187;") "%BB")
((eq ch "&#188;") "%BC")
((eq ch "&#189;") "%BD")
((eq ch "&#190;") "%BE")
((eq ch "&#191;") "%BF")
((eq ch "à") "%C0")
((eq ch "á") "%C1")
((eq ch "&#194;") "%C2")
((eq ch "&#195;") "%C3")
((eq ch "&#196;") "%C4")
((eq ch "&#197;") "%C5")
((eq ch "&#198;") "%C6")
((eq ch "&#199;") "%C7")
((eq ch "è") "%C8")
((eq ch "é") "%C9")
((eq ch "ê") "%CA")
((eq ch "&#203;") "%CB")
((eq ch "ì") "%CC")
((eq ch "í") "%CD")
((eq ch "&#206;") "%CE")
((eq ch "&#207;") "%CF")
((eq ch "D") "%D0")
((eq ch "&#209;") "%D1")
((eq ch "ò") "%D2")
((eq ch "ó") "%D3")
((eq ch "&#212;") "%D4")
((eq ch "&#213;") "%D5")
((eq ch "&#214;") "%D6")
((eq ch "×") "%D7")
((eq ch "&#216;") "%D8")
((eq ch "ù") "%D9")
((eq ch "ú") "%DA")
((eq ch "&#219;") "%DB")
((eq ch "ü") "%DC")
((eq ch "Y") "%DD")
((eq ch "T") "%DE")
((eq ch "&#223;") "%DF")
((eq ch "à") "%E0")
((eq ch "á") "%E1")
((eq ch "a") "%E2")
((eq ch "&#227;") "%E3")
((eq ch "&#228;") "%E4")
((eq ch "&#229;") "%E5")
((eq ch "&#230;") "%E6")
((eq ch "&#231;") "%E7")
((eq ch "è") "%E8")
((eq ch "é") "%E9")
((eq ch "ê") "%EA")
((eq ch "&#235;") "%EB")
((eq ch "ì") "%EC")
((eq ch "í") "%ED")
((eq ch "&#238;") "%EE")
((eq ch "&#239;") "%EF")
((eq ch "e") "%F0")
((eq ch "&#241;") "%F1")
((eq ch "ò") "%F2")
((eq ch "ó") "%F3")
((eq ch "&#244;") "%F4")
((eq ch "&#245;") "%F5")
((eq ch "&#246;") "%F6")
((eq ch "÷") "%F7")
((eq ch "&#248;") "%F8")
((eq ch "ù") "%F9")
((eq ch "ú") "%FA")
((eq ch "&#251;") "%FB")
((eq ch "ü") "%FC")
((eq ch "y") "%FD")
((eq ch "t") "%FE")
((eq ch "&#255;") "%FF")
(T ch)
)
)
(princ "\nType QRCODE")
(princ)
;*********************************************************************************

ll_j

不懂二维码，也就不太想研究程序，粗看一下，生成solid的部分无疑是很费时的，对此有两点建议，一是把生成solid改成生成PL试试，而是把这种重复循环的内容改成子函数。
重复的内容改成子函数，对我们而言，似乎只是写法上的不同，但程序处理实际上完全不一样。另外，不是必须的，不必都使用函数，如(cons 8 "0")应该直接写成'(8 . "0")，这其实是一样的道理，就是让程序少调用几遍函数。
个人意见，不对请海涵。

xiaxiang

老外的程序是使用php脚本实现核心功能的，除非你能用别的语言重写这部分代码以供lisp调用并得到返回值。。。还是换到.net/objectarx平台吧

海盗曹

厉害啊，学习一下~

革天明

ll_j 发表于 2013-3-11 15:40
不懂二维码，也就不太想研究程序，粗看一下，生成solid的部分无疑是很费时的，对此有两点建议，一是把生成s ...

我把老外的程序修改了一下，做成子函数，速度可以接受，感觉不到延迟
(defun YTM-QRcode-str (str                ; string to encode
                    blockname                ; name of the block to create
                    / QR x y startx row)
  (vl-load-com)
  (cond
    (t
     (setq strlst '("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"
                   )
     )
    )
  )
  (if (eq (substr (nth 0 strlst) 1 6) "111111") ;response OK
    (progn
      (setq QR strlst
            y  0
      )
      ;;create Qrcode block
      (entmake (list '(0 . "BLOCK")
                     (cons 2 blockname)
                     '(8 . "0")
                     '(70 . 0)
                     '(10 0.0 0.0 0.0)
               )
      )
      (foreach row QR
        (setq x 0)
        (while (< x (strlen row))
          (cond
            ((eq (substr row (1+ x) 1) "1")
             ;;memorize start of filled zone
             (if (not startx)
               (setq startx x)
             )
             (if (not (eq (substr row (+ x 2) 1) "1"))
               (progn
                 ;;draw filled zone
                 (entmake (list        (cons 0 "SOLID")
                                (cons 8 "0")
                                (cons 10 (list startx y))
                                (cons 11 (list (1+ x) y))
                                (cons 12 (list startx (1- y)))
                                (cons 13 (list (1+ x) (1- y)))
                                (cons 62 0)
                          )
                 )
                 (setq startx nil)
               )
             )
            )
          )
          (setq x (1+ x))
        )
        (setq y (1- y))
      )
      ;;end of block
      (setq bl_a (entmake '((0 . "ENDBLK"))))
    )
  )
)
目前此函数就只能生成固定的二维码，可做为研究看一下，还是老外的速度快啊，至于生成相应的二维码状态描述表是其它程序的事，上面程序只负责将二维码生成出来。

革天明

xiaxiang 发表于 2013-3-11 16:10
老外的程序是使用php脚本实现核心功能的，除非你能用别的语言重写这部分代码以供lisp调用并得到返回值。。。 ...

看下我最后更新的子函数，感觉不到速度上的延迟

xyp1964

2. (defun DBarCode (p0 str / p00 ll aa tx i s1)
   
3.   (setq p00 p0
   
4.         ll  0
   
5.   )
   
6.   (defun aaa (ll p0)
   
7.     (if        (> ll 0)
   
8.       (xyp-LwPlWide (list p0 (polar p0 0 ll)) nil 1)
   
9.     )
   
10.   )
    
11.   (foreach aa (xyp-Get-Str2Lstspr str "-")
    
12.     (setq i 0)
    
13.     (while (/= (setq tx (substr aa (setq i (1+ i)) 1)) "")
    
14.       (cond ((= tx "1") (setq ll (1+ ll)))
    
15.             ((= tx "0")
    
16.              (setq s1 (aaa ll p0)
    
17.                    p0 (polar p0 0 (1+ ll))
    
18.                    ll 0
    
19.              )
    
20.             )
    
21.       )
    
22.     )
    
23.     (setq s1  (aaa ll p0)
    
24.           p00 (polar p00 (* pi -0.5) 1)
    
25.           p0  p00
    
26.           ll  0
    
27.     )
    
28.   )
    
29. )
    

(defun DBarCode (p0 str / p00 ll aa tx i s1)<br />   (setq p00 p0<br />         ll  0<br />   )<br />   (defun aaa (ll p0)<br />     (if        (> ll 0)<br />       (xyp-LwPlWide (list p0 (polar p0 0 ll)) nil 1)<br />     )<br />   )<br />   (foreach aa (xyp-Get-Str2Lstspr str "-")<br />     (setq i 0)<br />     (while (/= (setq tx (substr aa (setq i (1+ i)) 1)) "")<br />       (cond ((= tx "1") (setq ll (1+ ll)))<br />             ((= tx "0")<br />              (setq s1 (aaa ll p0)<br />                    p0 (polar p0 0 (1+ ll))<br />                    ll 0<br />              )<br />             )<br />       )<br />     )<br />     (setq s1  (aaa ll p0)<br />           p00 (polar p00 (* pi -0.5) 1)<br />           p0  p00<br />           ll  0<br />     )<br />   )<br /> )<br />

xiabin68

这个够复杂哦，，，，，

革天明

xyp1964 发表于 2013-3-15 15:30

现在习惯了院长大人的高速度，还有伪源码，需要xcad.vlx支持，哈哈