大家一起来玩优化，用最短的时间画一个bmp图片

baitang36

下面函数c:tt的作用是画一个图片，把tt.txt中的像素数据画到坐标0,0处。
现有程序大约需要十几秒时间，有时间玩的朋友优化一下，看看谁的程序最快。
像素数据是用高飞鸟的工具提取的。

1. (defun c:tt(/ pt r x lst x1 x2)
   
2.            (setq f (open "c:/00/tt.txt" "R")))
   
3. (setq t0  (getvar "TDUSRTIMER" ) )
   
4.       (while (setq s (read-line f))
   
5.         (setq k (read s))
   
6.         (if (and k (= (type k) (quote LIST)) (= (length k) 6))
   
7.           (progn
   
8.             (setq x (car k)
   
9.                   y (cadr k)
   
10.                   r (caddr k)
    
11.                   g (cadddr k)
    
12.                   b (car (cddddr k))
    
13.                   c (lm:rgb->true r g b)
    
14.                   )
    
15.             (entmake
    
16.                 (list
    
17.                   (cons 0 "LWPOLYLINE")
    
18.                   (cons 100 "AcDbEntity")
    
19.                   (cons 100 "AcDbPolyline")
    
20.                   (cons 8 "Image2PL")
    
21.                   (cons 90 2)
    
22.                   (cons 43 1.0)
    
23.                   (cons 420 c)
    
24.                   (cons 10 (list x y))
    
25.                   (cons 10 (list (1+ x) y))
    
26.                   )))
    
27.       (close f)
    
28. (princ "\n程序共用时" )
    
29. (princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  )
    
30. (princ "秒" )
    
31. (princ)
    
32. )
    
33. 
    
34. (defun LM:RGB->True ( r g b )
    
35.   (+
    
36.     (lsh (fix r) 16)
    
37.     (lsh (fix g)  8)
    
38.     (fix b)
    
39.   )
    
40. )
    

(defun c:tt(/ pt r x lst x1 x2)<br />            (setq f (open "c:/00/tt.txt" "R")))<br /> (setq t0  (getvar "TDUSRTIMER" ) )<br />       (while (setq s (read-line f))<br />         (setq k (read s))<br />         (if (and k (= (type k) (quote LIST)) (= (length k) 6))<br />           (progn<br />             (setq x (car k)<br />                   y (cadr k)<br />                   r (caddr k)<br />                   g (cadddr k)<br />                   b (car (cddddr k))<br />                   c (lm:rgb->true r g b)<br />                   )<br />             (entmake<br />                 (list<br />                   (cons 0 "LWPOLYLINE")<br />                   (cons 100 "AcDbEntity")<br />                   (cons 100 "AcDbPolyline")<br />                   (cons 8 "Image2PL")<br />                   (cons 90 2)<br />                   (cons 43 1.0)<br />                   (cons 420 c)<br />                   (cons 10 (list x y))<br />                   (cons 10 (list (1+ x) y))<br />                   )))<br />       (close f)<br /> (princ "\n程序共用时" ) <br /> (princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  ) <br /> (princ "秒" ) <br /> (princ)<br /> )<br /> <br /> (defun LM:RGB->True ( r g b )<br />   (+<br />     (lsh (fix r) 16)<br />     (lsh (fix g)  8)<br />     (fix b)<br />   )<br /> )<br />

baitang36

;用上一个保留函数 syz-read-list
;改成这样后是7.784秒，改前是10.3秒

(defun c:tt (/ pt r x lst x1 x2 r g b c lc strc )
(setq f (open "c:/00/tt.txt" "R"))
(setq f1 (open "c:/00/tt6.txt" "w"))
(setq list1 nil)
(while (setq s (read-line f))
  (setq k (read s))
     (setq
            r (caddr k)
            g (cadddr k)
            b (car (cddddr k))
            c (lm:rgb->true r g b)
      )

(setq list1 (cons c list1 ))
)
(setq list1 (reverse list1))
(setq strc (vl-prin1-to-string list1))
(write-line strc f1)
(close f1)
(close f)

(setq f (open "c:/00/tt6.txt" "R"))
(setq t0 (getvar "TDUSRTIMER"))
(load "c:/00/syz-read-list.fas")
(setq lc (syz-read-list f))
(setq x 0 y 0)
(while  (< x 512 ) ;宽512像素   ;while比repeat快0.1秒
  (while (< y 654) ;高654像素
  (setq c (car lc))
  (setq lc(cdr lc))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 8 "Image2PL")
        (cons 90 2)
        (cons 43 1.0)
        (cons 420 c)
        (cons 10 (list x y))
        (cons 10 (list (+ 1 x) y))
      )
    )
    (setq y (+ 1 y))
  )
  (setq y 0)
  (setq x (+ 1 x))
)
(close f)
(princ "\n程序共用时" )
(princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  )
(princ "秒" )
(princ)
)

(defun LM:RGB->True ( r g b )
  (+
    (lsh r 16)
    (lsh g  8)
    b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

baitang36

;改成一张大表，节省了读文件时间，总的反而慢了
;改成这样后是8.386秒，改前是10.3秒

(defun c:tt (/ pt r x lst x1 x2 r g b c lc strc )
(setq f (open "c:/00/tt.txt" "R"))
(setq f1 (open "c:/00/tt6.txt" "w"))
(setq list1 nil)
(while (setq s (read-line f))
  (setq k (read s))
     (setq
            r (caddr k)
            g (cadddr k)
            b (car (cddddr k))
            c (lm:rgb->true r g b)
      )

(setq list1 (cons c list1 ))
)
(setq list1 (reverse list1))
(setq strc (vl-prin1-to-string list1))
(write-line strc f1)
(close f1)
(close f)

(setq f (open "c:/00/tt6.txt" "R"))
(setq t0 (getvar "TDUSRTIMER"))
(setq s (read-line f))
(setq lc (read s))
(setq x 0 y 0)
(while  (< x 512 ) ;宽512像素   ;while比repeat快0.1秒
  (while (< y 654) ;高654像素
  (setq c (car lc))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 8 "Image2PL")
        (cons 90 2)
        (cons 43 1.0)
        (cons 420 c)
        (cons 10 (list x y))
        (cons 10 (list (+ 1 x) y))
      )
    )
    (setq y (+ 1 y))
  )
  (setq y 0)
  (setq x (+ 1 x))
)
(close f)
(princ "\n程序共用时" )
(princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  )
(princ "秒" )
(princ)
)

(defun LM:RGB->True ( r g b )
  (+
    (lsh r 16)
    (lsh g  8)
    b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

紫苏炒黄瓜

先顶后看

自贡黄明儒

一直以为entmake是最快的，您这个应该就是最快的了。
是不是可以不用判断(if (and k (= (type k) (quote LIST)) (= (length k) 6))，以便于加速？

菜卷鱼

你的电脑配置高，我这里：程序共用时60.748秒

baitang36

自贡黄明儒 发表于 2022-6-14 16:29
一直以为entmake是最快的，您这个应该就是最快的了。
是不是可以不用判断(if (and k (= (type k) (quote L ...

试试，这句是考虑数据文件的第一行写点别的，注释什么的.
去掉前6.198秒，去掉后5.991秒

baitang36

菜卷鱼 发表于 2022-6-14 16:49
你的电脑配置高，我这里：程序共用时60.748秒

我电脑的cpu主频4.5G的i5，acad2008用时10.3秒。acad2018是17秒，2022是19秒

baitang36

;改成这样后是5.723秒，改前是6.198秒 这是另一台电脑的测试，6.198面相当于一楼的10.3秒

(defun c:tt (/ pt r x lst x1 x2)
  (setq f (open "c:/00/tt.txt" "R"))

(setq t0 (getvar "TDUSRTIMER"))
(while (setq s (read-line f))
  (setq k (read s))
  
   
      (setq x (car k)
            y (cadr k)
            r (caddr k)
            g (cadddr k)
            b (car (cddddr k))
            c (lm:rgb->true r g b)
      )
      (entmake
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 8 "Image2PL")
          (cons 90 2)
          (cons 43 1.0)
          (cons 420 c)
          (cons 10 (list x y))
          (cons 10 (list (+ 1 x) y))
        
      
    )
  )
)
(close f)
(princ "\n程序共用时" )
(princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  )
(princ "秒" )
(princ)
)

(defun LM:RGB->True ( r g b )
  (+
    (lsh r 16)
    (lsh g  8)
    b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

baitang36

;先处理一下像素数据文件，省去计算过程
;改成这样后是8.157秒，改前是10.3秒

(defun c:tt (/ pt r x lst x1 x2 r g b c lc strc )
  (setq f (open "c:/00/tt.txt" "R"))
(setq f1 (open "c:/00/tt4.txt" "w"))
(while (setq s (read-line f))
  (setq k (read s))
     (setq
            r (caddr k)
            g (cadddr k)
            b (car (cddddr k))
            c (lm:rgb->true r g b)
      )
(setq strc (vl-prin1-to-string c))
(write-line strc f1)
)
(close f1)
(close f)

(setq f (open "c:/00/tt4.txt" "R"))
(setq t0 (getvar "TDUSRTIMER"))
(setq x 0 y 0)
(while  (< x 512 ) ;宽512像素   ;while比repeat快0.1秒
  (while (< y 654) ;高654像素
    (setq s (read-line f))
    (setq c (read s))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 8 "Image2PL")
        (cons 90 2)
        (cons 43 1.0)
        (cons 420 c)
        (cons 10 (list x y))
        (cons 10 (list (+ 1 x) y))    ;(+ 1 x)比(1+ x)略快
      )
    )
    (setq y (+ 1 y))
  )
  (setq y 0)
  (setq x (+ 1 x))
)
(close f)
(princ "\n程序共用时" )
(princ  (*  (-  (getvar "TDUSRTIMER" )  t0 )  86400 )  )
(princ "秒" )
(princ)
)

(defun LM:RGB->True ( r g b )
  (+
    (lsh r 16)
    (lsh g  8)
    b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

biya

看到了LM: ,回头试一下

USER2128

楼主雄才!
期待楼主做一个在DCL窗口中预览dwg的插件