从cad内部提取CAD的缩略图lisp源码分享，新鲜出炉2019.6.4
本帖最后由 xugaoming23 于 2019-7-12 21:39 编辑;;----------------将xrecord的内容生成文件------------------------------------------------
(defun xrecordtofile (vlaobj filepath)
(if (/= (vla-get-ObjectName vlaobj) "AcDbXrecord")
(exit)
)
(vla-getxrecorddata vlaobj 'xtypeOut 'xdataOut)
(setq x (vlax-safearray->list xtypeOut))
(setq y (vlax-safearray->list xdataOut))
(setq z nil)
(if (= (vlax-safearray-type xdataOut) vlax-vbVariant)
(progn
(foreach i y
(if (> (vlax-variant-type i) 8192)
(progn
(setq j (vlax-safearray->list (vlax-variant-value i)))
(foreach k j (setq z (cons k z)))
)
)
)
(setq z (reverse z))
;;28456
(setq k (list 77 66))
(setq l (length z))
(while (/= 0 l)
(setq
k (cons (rem l 16) k)
l (/ l 16)
)
)
;6 15 2 8
(setq k (cons 0 k))
(setq k (cons 0 k))
(setq k (cons 0 k))
(setq k (cons 0 k))
(setq k (cons 54 k))
(setq k (cons 0 k))
(setq k (cons 0 k))
(setq k (cons 0 k))
;(setq k (list 66 77 8 2 15 6 0 0 0 0 54 0 0 0))
;(setq k (reverse k))
(foreach i k (setq z (cons i z)))
(setq m (vlax-make-safearray 17 (cons 0 (1- (length z))))) ;17为vbbyte
(setq n (vlax-safearray-fill m z))
)
)
(setq ObjStream (vlax-get-or-create-object "Adodb.Stream"))
(vlax-put-property ObjStream 'Type 1) ;1为二进制模式读取 ，2为文本模式读取
(vlax-put-property ObjStream 'Mode 3) ;1为读，2为写，3为读写
(vlax-invoke ObjStream 'Open)
(vlax-invoke-method ObjStream 'Write n) ;还有一个方法是writetext
(vlax-put-property ObjStream 'Position 0) ;写文本时有效
;(vlax-put-property ObjStream 'Type 2);写文本时有效，编码调整
;(vlax-put-property ObjStream 'Charset 'unicode);写文本时有效 'unicode,utf-8,ascii,gb2312,big5,gbk
;(setq str (vlax-invoke-method ObjStream 'ReadText));生成字符串时有效
(vlax-invoke-method ObjStream 'SaveToFile filepath 2) ;adSaveCreateNotExist =1 , adSaveCreateOverWrite =2
(vlax-invoke-method ObjStream 'Close)
(vlax-release-object ObjStream)
)
;;--------------------------------end-------------------------------------------
(setq i (cdr (assoc -1(dictsearch (namedobjdict) "ACAD_LAYOUT"))))
(setq i (vla-Item (vla-GetExtensionDictionary (vla-Item (vlax-Ename->Vla-Object i) 0 ))0))
(xrecordtofile i "E:\\cad.bmp")
提供思路，不负责解释http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTA0NTk0fDU5ZWI3ZjMwfDE1NTk2Mzc2MTZ8NDA1OTI1fDE3OTY2Nw%3D%3D&noupdate=yes左侧为提取的缩略图片 看不出和直接输出BMP JPG有什么区别 怎么运行啊 liwen888888 发表于 2019-6-5 20:39
看不出和直接输出BMP JPG有什么区别
重点是提供了一些新的想法与思路，比如xrecord下的二进制，CAD自身储存的二进制格式如何翻译，还比如图像二进制没有头文件的添加问题，没提到的安全数组类型，如17为VBbyte bai2000 发表于 2019-6-7 13:10
怎么运行啊
你都两个太阳了不会运行，先看看cad文件有没有缩略图，然后复制粘贴就可以运行了 本帖最后由 xugaoming23 于 2019-6-9 23:13 编辑
bai2000 发表于 2019-6-7 13:10
怎么运行啊
主代码是这个：
(setq i (cdr (assoc -1(dictsearch (namedobjdict) "ACAD_LAYOUT"))))
(setq i (vla-Item (vla-GetExtensionDictionary (vla-Item (vlax-Ename->Vla-Object i) 0 ))0))
(xrecordtofile i "E:\\cad.bmp")
只提供思路，程序没有严谨的去写，只是大致部位提供下条件转折，但条件也没有一 一严禁，自己用的时候需要修改完善 楼主，能否提取图像为sld格式，这样就有办法在DCL中做到DWG预览 USER2128 发表于 2019-6-12 11:26
楼主，能否提取图像为sld格式，这样就有办法在DCL中做到DWG预览
这个程序本身就不完善，我也是猜测图像的格式为bmp，结果凑了出来，如果缩略图在布局里面，主程序还要调整下扩展字典的根，至于转码以及如何应用，这个靠你自己了:lol 补充： 今天偶尔测试，居然又不行了
1.原因为byte数不稳定 ，由于系统自身运行可能导致符号位的加入，需要调整
(foreach k j (setq z (cons k z)))调整为(foreach k j (setq z (cons (logand k 255) z)))
2.是否能提取缩略图取决于根ACAD_LAYOUT是否有Xrecord ，如果缩略图不是在这个根下，需要自己去找，cad版本的因素，可能缩略图不是Xrecord形式
页:
[1]