批量插入影像到CAD

qingchao · 发表于 2018-5-18 17:39

本帖最后由 qingchao 于 2018-6-4 16:28 编辑

可以批量或单张插入影像到CAD中，支持tif、jpg、png、ecw格式。坐标文件可以和影像不在同一目录下，可以手动选择。效果如下图所示。

注意：重复插入或删除后再插入之前的影像可能会报错，解决办法是，运行image命令，把状态显示未参照的图像选中，然后拆离就可以了！再次插入就可以正常插入了。

(vl-load-com)
(if (null degrad)
(defun degrad (ang)
(* pi (/ ang 180.0))
)
)
(if (null raddeg)
(defun raddeg (ang)
(* 180.0 (/ ang pi))
)
)
(defun c:inimg()
(initget "1 2")
(princ "\n选择插入影像方式:")
(setq key (getkword "\n1单张\\2批量\\<1>:"))
(cond ((not key) (dz)) ;
((= key "1") (dz)) ;
((= key "2") (pl)) ;
);cond
)
(defun dz()
(findfile (setq im (getfiled "选择影像文件"
(getvar "dwgprefix")
"tif;jpg;png;ecw"
16
)
)
)
(tfw im)
)
(defun pl()
(setq dir (LM:getfiles "选择文件" "" "tif;jpg;png;ecw"))
(repeat (setq n (length dir))
(setq kk (length dir))
(setq n (1- n))
(setq e (nth n dir))
(setq k (- kk n))
(princ (strcat "\n正在插入 " (itoa k) "张影像......"))
(tfw e)
)
(princ (strcat "\n完成！成功插入 " (itoa (length dir)) "张影像！"))
(princ)
)
(defun tfw ( im / img file res pt xres yres xrot yrot left top minpt maxpt)
;define the function name and variables
(if (= (type im) 'str)
(progn
(setq img
(vla-addraster
(vla-get-block
(vla-get-activelayout
(vla-get-activedocument (vlax-get-acad-object))
)
)
im
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 2))
'(0.0 0.0 0.0)
)
)
1.0
0.0
)
)
(if (snvalid (vl-filename-base im))
(vla-put-name img (vl-filename-base im))
)
(setq im (vlax-vla-object->ename img))
)
(setq imG (vlax-ename->vla-object (ssname im 0)))
)
(if (findfile (vl-string-subst
".ers"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(setq file (vl-string-subst
".ers"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(if (findfile (vl-string-subst
".tfw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(setq file (vl-string-subst
".tfw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(if (findfile (vl-string-subst
".jgw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(setq file (vl-string-subst
".jgw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(if (findfile (vl-string-subst
".pgw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(setq file (vl-string-subst
".pgw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
)
)
)
)
(if (or file
(setq file (getfiled "选择坐标文件"
(vl-string-subst
""
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
"tfw;jgw;pgw;ers"
0
)
)
)
(if (= (vl-filename-extension file) ".ers")
(progn
(setq file (open file "r"))
(repeat 19 (read-line file))
(setq left (atof (last (split (read-line file) " ")))
top (atof (last (split (read-line file) " ")))
)
(close file)
(vla-put-origin
img
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray 5 (cons 0 2))
(list left (- top (vla-get-height img)) 0.0)
)
)
)
(vla-put-imagewidth img (vla-get-width img))
(vla-put-imageheight img (vla-get-height img))
(vla-getboundingbox img 'minpt 'maxpt)
(vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
)
(progn
(setq file (open file "r")
xres (atof (read-line file))
xrot (atof (read-line file))
yrot (atof (read-line file))
yres (atof (read-line file))
ins (list (atof (read-line file)) (atof (read-line file)) 0.0)
ins (polar ins
(* (/ (+ xrot 90.0) 180.0) pi)
(* (vla-get-height img) yres)
)
)
(close file)
(vla-put-rotation img (degrad xrot))
(vla-put-origin
img
(vlax-make-variant
(vlax-safearray-fill (vlax-make-safearray 5 (cons 0 2)) ins)
)
)
(vla-put-imageheight
img
(* (vla-get-height img) (abs yres))
)
(vla-put-imagewidth img (* (vla-get-width img) (abs xres)))
(vla-getboundingbox img 'minpt 'maxpt)
(vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
)
)
)
(princ) ;exit quietly
)
;;------------------------=={ Get Files Dialog }==----------------------;;
;; ;;
;; An analog of the 'getfiled' function for multiple file selection. ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2012 - [url=http://www.lee-mac.com]www.lee-mac.com[/url] ;;
;;----------------------------------------------------------------------;;
;; Arguments: ;;
;; msg - [str/nil] Dialog box label; 'Select Files' if nil or "". ;;
;; def - [str/nil] Default directory; dwgprefix if nil or "". ;;
;; ext - [str/nil] File extension filter (e.g. "dwg;lsp"); "*" if nil ;;
;;----------------------------------------------------------------------;;
;; Returns: List of selected files, else nil ;;
;;----------------------------------------------------------------------;;
;; Version 1.6 - 2016-03-21 ;;
;;----------------------------------------------------------------------;;

复制代码

现在将多选放出来，配合本附件就可以批量插入了。本来这就是别人的程序，我是希望大家自己下载的，可是还是有人问，所以提供附件。

GetFilesV1-6.rar (3.28 KB, 下载次数: 2331)

wubenben0307 · 发表于 2018-5-18 19:32

为什么按照你写的程序输入xcz 没用啊？

bobest · 发表于 2018-5-27 16:56

本帖最后由 bobest 于 2018-5-27 17:20 编辑

批量加载不行，没有反应。提示“no function definition: LM:GETFILES”

qingchao · 发表于 2018-5-19 11:49

wubenben0307 发表于 2018-5-18 19:32
为什么按照你写的程序输入xcz 没用啊？

(defun c:inimg()
命令是：inimg，可以自己改的啊

guowenquan · 发表于 2019-3-17 16:23

复制出来保存了也加载了然后还是出现错误: Automation 错误。输入无效

游四方天地 · 发表于 2018-5-25 10:08

qingchao 发表于 2018-5-19 11:50
(defun c:inimg()
这个命令是：inimg，可以自己随便改的啊

兄弟。我知道了，再问下，坐标文件是什么意思的，能详细说下吗？

袁爱石 · 发表于 2018-5-18 17:55

兄弟，这代码怎么用啊

爱无止境 · 发表于 2018-5-18 18:06

看看-----

layamala · 发表于 2018-5-19 07:21

怎么用呀？期盼多年，CASS之外没找到可替代的东西。

skylfy110 · 发表于 2018-5-19 10:06

:zt:zt:zt

游四方天地 · 发表于 2018-5-19 11:26

wubenben0307 发表于 2018-5-18 19:32
为什么按照你写的程序输入xcz 没用啊？

一样啊。

qingchao · 发表于 2018-5-19 11:50

游四方天地发表于 2018-5-19 11:26
一样啊。

(defun c:inimg()
这个命令是：inimg，可以自己随便改的啊

qingchao · 发表于 2018-5-19 11:51

袁爱石发表于 2018-5-18 17:55
兄弟，这代码怎么用啊

兄弟，复制下来，保存在文本文件中，重命名为*.lsp，在CAD中用appload加载，然后运行inimg命令就可以了啊

[软件] 批量插入影像到CAD

评分

灌水勋章