论坛 › 每日插件 › 批量根据TFW文件导入拼接卫星影像图

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

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

本帖最后由 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)
)

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

牛逼的功能，收藏了！！{:1_12:}

查看完整版本: 批量根据TFW文件导入拼接卫星影像图