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

baitang36 · 发表于 2022-6-14 15:12:00

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

(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))
        (if (and k (= (type k) (quote LIST)) (= (length k) 6))
          (progn
            (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 (fix r) 16)
    (lsh (fix g)  8)
    (fix b)
  )
)

程序和bmp

像素数据

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

baitang36 · 发表于 2022-6-15 08:53:00

;用上一个保留函数 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  (True ( r g b )
  (+
(lsh r 16)
(lsh g  8)
b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:w0vyvjoyhnr.fas
下载次数:0 文件大小:89 Bytes 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:doo1ugapqyz.lsp
下载次数:0 文件大小:1.41 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

baitang36 · 发表于 2022-6-15 08:31:00

;改成一张大表，节省了读文件时间，总的反而慢了
;改成这样后是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  (True ( r g b )
  (+
(lsh r 16)
(lsh g  8)
b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")
tt6.lsp

紫苏炒黄瓜 · 发表于 2022-6-14 15:54:00

先顶后看

自贡黄明儒 · 发表于 2022-6-14 16:29:00

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

菜卷鱼 · 发表于 2022-6-14 16:49:00

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

baitang36 · 发表于 2022-6-14 21:08:00

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

baitang36 · 发表于 2022-6-14 21:11:00

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

baitang36 · 发表于 2022-6-14 21:26:00

;改成这样后是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 · 发表于 2022-6-15 07:51:00

;先处理一下像素数据文件，省去计算过程
;改成这样后是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  (True ( r g b )
  (+
(lsh r 16)
(lsh g  8)
b
  )
)
;(vlisp-compile 'st "c:/00/tt.lsp")

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

发表回复

精选推荐