批量根据TFW文件导入拼接卫星影像图

Lispboy · 发表于 2018-5-11 10:15:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有帐号？立即注册

x

本帖最后由 newer 于 2018-5-11 10:17 编辑

(defun c:XDTB_InPutTwf (/ a AcadDocument AcadObject b bl chat fn fp height i ii imageName imageNames
insertionPnt len len1 mSpace path pt RasterObj reco tfwname twfNames width x
)
(defun _process (fn imageName /)
(setq fp (open fn "r"))
(setq reco (read-line fp)
ii 1
)
(setq chat nil)
(while reco
(setq chat (append (list reco) chat))
(setq reco (read-line fp)
ii (1+ ii)
)
)
(close fp)
(setq pt (list (atof (nth 1 chat)) (atof (nth 0 chat)) 0))
(setq bl (atof (nth 5 chat)))
(setq insertionPnt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
(vlax-safearray-fill insertionPnt pt)
(setq RasterObj (vla-AddRaster mSpace imageName insertionPnt 1 0))
(setq width (vla-get-Width RasterObj))
(setq height (vla-get-height RasterObj))
(vla-put-ImageWidth RasterObj (* width bl))
(vla-put-Imageheight RasterObj (* height bl))
(xdrx_entity_move
(entlast)
(list 0 (* height bl))
(list 0 0)
)
)
(defun _gettfw (imagenames /)
(setq a (mapcar '(lambda (x)
(setq imageName x
path (xdrx_system_splitpath imageName)
tfwname (strcat (car path) (cadr path) (caddr path) ".tfw")
)
(if (findfile tfwname)
(list tfwname imageName)
)
)
imageNames
)
)
(setq b (vl-remove nil a))
)
(xdrx_begin)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)
)
(if (setq imageNames
(xdrx_system_selectfiles
"选取图像文件"
""
"jpg;tif;tiff"
4096
)
)
(progn (setq len1 (length imageNames))
(if (setq twfNames (_gettfw imageNames))
(progn (setq i 0
len (length twfNames)
)
(mapcar '(lambda (x)
(setq i (1+ i))
(xdrx_prompt
(if (= i 1)
"\n"
"\r"
)
"正在处理第 "
i
" of "
len
"个图像文件."
)
(_process (car x) (cadr x))
)
twfNames
)
(xdrx_prompt
"\n选择了" len1 "个图像文件,成功拼接了" i "个."
)
(command "zoom" "e" "zoom" "0.8x")
)
(xdrx_prompt "\n没有发现TFW文件.")
)
)
)
(xdrx_end)
(princ)
)

(defun c:XDTB_InPutTwf (/ a AcadDocument AcadObject b bl chat fn fp height i ii imageName imageNames 
                        insertionPnt len len1 mSpace path pt RasterObj reco tfwname twfNames width x 
                       ) 
  (defun _process (fn imageName /) 
    (setq fp (open fn "r")) 
    (setq reco (read-line fp) 
          ii   1 
    ) 
    (setq chat nil) 
    (while reco 
      (setq chat (append (list reco) chat)) 
      (setq reco (read-line fp) 
            ii   (1+ ii) 
      ) 
    ) 
    (close fp) 
    (setq pt (list (atof (nth 1 chat)) (atof (nth 0 chat)) 0)) 
    (setq bl (atof (nth 5 chat))) 
    (setq insertionPnt (vlax-make-safearray vlax-vbDouble '(0 . 2))) 
    (vlax-safearray-fill insertionPnt pt) 
    (setq RasterObj (vla-AddRaster mSpace imageName insertionPnt 1 0)) 
    (setq width (vla-get-Width RasterObj)) 
    (setq height (vla-get-height RasterObj)) 
    (vla-put-ImageWidth RasterObj (* width bl)) 
    (vla-put-Imageheight RasterObj (* height bl)) 
    (xdrx_entity_move 
      (entlast) 
      (list 0 (* height bl)) 
      (list 0 0) 
    ) 
  ) 
  (defun _gettfw (imagenames /) 
    (setq a (mapcar '(lambda (x) 
                       (setq imageName x 
                             path      (xdrx_system_splitpath imageName) 
                             tfwname   (strcat (car path) (cadr path) (caddr path) ".tfw") 
                       ) 
                       (if (findfile tfwname) 
                         (list tfwname imageName) 
                       ) 
                     ) 
                    imageNames 
            ) 
    ) 
    (setq b (vl-remove nil a)) 
  ) 
  (xdrx_begin) 
  (setq AcadObject   (vlax-get-acad-object) 
        AcadDocument (vla-get-ActiveDocument Acadobject) 
        mSpace       (vla-get-ModelSpace Acaddocument) 
  ) 
  (if (setq imageNames 
             (xdrx_system_selectfiles 
               "选取图像文件" 
               "" 
               "jpg;tif;tiff" 
               4096 
             ) 
      ) 
    (progn (setq len1 (length imageNames)) 
           (if (setq twfNames (_gettfw imageNames)) 
             (progn (setq i   0 
                          len (length twfNames) 
                    ) 
                    (mapcar '(lambda (x) 
                               (setq i (1+ i)) 
                               (xdrx_prompt 
                                 (if (= i 1) 
                                   "\n" 
                                   "\r" 
                                 ) 
                                 "正在处理第 " 
                                 i 
                                 " of " 
                                 len 
                                 "个图像文件." 
                               ) 
                               (_process (car x) (cadr x)) 
                             ) 
                            twfNames 
                    ) 
                    (xdrx_prompt 
                      "\n选择了" len1 "个图像文件,成功拼接了" i "个." 
                     ) 
                    (command "zoom" "e" "zoom" "0.8x") 
             ) 
             (xdrx_prompt "\n没有发现TFW文件.") 
           ) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

w379106181 · 发表于 2018-5-12 22:44:54

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享

心会随爱飞 · 发表于 2018-7-17 17:46:34

这个东西可以哦，看上去不错的样子哦

yuanziyou · 发表于 2018-12-10 11:08:40

这个可以，正需要相关代码

kiwiairui · 发表于 2018-12-10 14:51:31

像这些卫星图像从哪里导出来？goole earth么？

Lisphk · 发表于 2018-12-10 14:52:47

kiwiairui 发表于 2018-12-10 14:51
像这些卫星图像从哪里导出来？goole earth么？

google earch 是一个
还有不少专业的卫星地图下载器

kiwiairui · 发表于 2018-12-10 15:31:05

Lisphk 发表于 2018-12-10 14:52
google earch 是一个
还有不少专业的卫星地图下载器

您有推荐的么？我们专业和这个卫星图关系还挺大。

zzp673771066 · 发表于 2019-6-26 18:35:11

怎么使用啊

kyky1002 · 发表于 2019-9-23 17:07:45

tfwname (strcat (car path) (cadr path) (caddr path) ".tfw")下面加行
tfwname (strcat (car path) (cadr path) (caddr path) ".jgw")就完美了，否则jpg的会提示找不到tfw

lsthz · 发表于 2019-9-25 00:33:53

看似很强大的功能
来自: 微社区

toki · 发表于 2020-11-17 22:41:15

运行不成功，是怎么回事

newer · 发表于 2020-11-17 23:51:11

toki 发表于 2020-11-17 22:41
运行不成功，是怎么回事

命令行输入
(vl-load-com)
回车，然后执行下代码试试

18176584376 · 发表于 2021-1-6 17:52:48

辛苦了谢谢分享谢谢

warrior2020 · 发表于 2021-1-7 08:04:32

很好很强大！

shejf58420 · 发表于 2021-1-21 14:54:08

牛逼的功能，收藏了！！

帐号		自动登录	找回密码
密码			立即注册

[工具] 批量根据TFW文件导入拼接卫星影像图

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评