找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1435|回复: 6

[他山之石] 插入图片及修正

[复制链接]

已领礼包: 264个

财富等级: 日进斗金

发表于 2016-12-13 11:11:34 | 显示全部楼层 |阅读模式

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

您需要 登录 才可以下载或查看,没有账号?立即注册

×

  1. ;|
  2.     GEOTiff.LSP
  3.     Copyright ?2004 Michel Loftus
  4.   ----------------------------------------------------------------|;
  5. (vl-load-com)

  6. (if (null degrad)
  7.   (defun degrad        (ang)
  8.     (* pi (/ ang 180.0))
  9.   )
  10. )

  11. (if (null raddeg)
  12.   (defun raddeg        (ang)
  13.     (* 180.0 (/ ang pi))
  14.   )
  15. )
  16. ;;;重新插入图片(根据记录的图片位置、大小、角度等)或者根据信息文件修正图片
  17. (defun c:tfw (/        img file res pt        xres yres xrot yrot left top minpt maxpt
  18.               im)                        ;define the function name and variables
  19.   (princ
  20.     "\nSelect Image or return to select image file to insert"
  21.   )
  22.   (if (or (setq im (ssget ":s" '((0 . "IMAGE"))))
  23.           (findfile (setq im (getfiled "Select Image File"
  24.                                        (getvar "dwgprefix")
  25.                                        "png;tif;jpg;ecw"
  26.                                        16
  27.                              )
  28.                     )
  29.           )
  30.       )                                        ;select the image to scale
  31.     (progn
  32.       (if (= (type im) 'str)
  33.         (progn
  34.           (setq        img
  35.                  (vla-addraster
  36.                    (vla-get-block
  37.                      (vla-get-activelayout
  38.                        (vla-get-activedocument (vlax-get-acad-object))
  39.                      )
  40.                    )
  41.                    im
  42.                    (vlax-make-variant
  43.                      (vlax-safearray-fill
  44.                        (vlax-make-safearray vlax-vbdouble (cons 0 2))
  45.                        '(0.0 0.0 0.0)
  46.                      )
  47.                    )
  48.                    1.0
  49.                    0.0
  50.                  )
  51.           )
  52.           (if (snvalid (vl-filename-base im))
  53.             (vla-put-name img (vl-filename-base im))
  54.           )
  55.           (setq im (vlax-vla-object->ename img))
  56.         )
  57.         (setq imG (vlax-ename->vla-object (ssname im 0)))
  58.       )
  59.       (if (findfile (vl-string-subst
  60.                       ".ers"
  61.                       (vl-filename-extension (vla-get-imagefile img))
  62.                       (vla-get-imagefile img)
  63.                     )
  64.           )
  65.         (setq file (vl-string-subst
  66.                      ".ers"
  67.                      (vl-filename-extension (vla-get-imagefile img))
  68.                      (vla-get-imagefile img)
  69.                    )
  70.         )
  71.         (if (findfile (vl-string-subst
  72.                         ".tfw"
  73.                         (vl-filename-extension (vla-get-imagefile img))
  74.                         (vla-get-imagefile img)
  75.                       )
  76.             )
  77.           (setq        file (vl-string-subst
  78.                        ".tfw"
  79.                        (vl-filename-extension (vla-get-imagefile img))
  80.                        (vla-get-imagefile img)
  81.                      )
  82.           )
  83.           (if
  84.             (findfile (vl-string-subst
  85.                         ".jpw"
  86.                         (vl-filename-extension (vla-get-imagefile img))
  87.                         (vla-get-imagefile img)
  88.                       )
  89.             )
  90.              (setq
  91.                file (vl-string-subst
  92.                       ".jpw"
  93.                       (vl-filename-extension (vla-get-imagefile img))
  94.                       (vla-get-imagefile img)
  95.                     )
  96.              )
  97.              (if
  98.                (findfile (vl-string-subst
  99.                            ".pgw"
  100.                            (vl-filename-extension (vla-get-imagefile img))
  101.                            (vla-get-imagefile img)
  102.                          )
  103.                )
  104.                 (setq
  105.                   file (vl-string-subst
  106.                          ".pgw"
  107.                          (vl-filename-extension (vla-get-imagefile img))
  108.                          (vla-get-imagefile img)
  109.                        )
  110.                 )
  111.              )
  112.           )
  113.         )
  114.       )
  115.       (if
  116.         (or file
  117.             (setq
  118.               file (getfiled
  119.                      "Select World File"
  120.                      (vl-string-subst
  121.                        ""
  122.                        (vl-filename-extension (vla-get-imagefile img))
  123.                        (vla-get-imagefile img)
  124.                      )
  125.                      "tfw;jgw;pgw;ers"
  126.                      0
  127.                    )
  128.             )
  129.         )
  130.          (if (= (vl-filename-extension file) ".ers")
  131.            (progn
  132.              (setq file (open file "r"))
  133.              (repeat 19 (read-line file))
  134.              (setq left        (atof (last (split (read-line file) " ")))
  135.                    top        (atof (last (split (read-line file) " ")))
  136.              )
  137.              (close file)
  138.              (vla-put-origin
  139.                img
  140.                (vlax-make-variant
  141.                  (vlax-safearray-fill
  142.                    (vlax-make-safearray 5 (cons 0 2))
  143.                    (list left (- top (vla-get-height img)) 0.0)
  144.                  )
  145.                )
  146.              )
  147.              (vla-put-imagewidth img (vla-get-width img))
  148.              (vla-put-imageheight img (vla-get-height img))
  149.              (vla-getboundingbox img 'minpt 'maxpt)
  150.              (vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
  151.            )
  152.            (progn
  153.              (setq file        (open file "r")
  154.                    xres        (atof (read-line file))
  155.                    xrot        (atof (read-line file))
  156.                    yrot        (atof (read-line file))
  157.                    yres        (atof (read-line file))
  158.                    ins        (list (atof (read-line file))
  159.                               (atof (read-line file))
  160.                               0.0
  161.                         )
  162.                    ins        (polar ins
  163.                                (* (/ (+ xrot 90.0) 180.0) pi)
  164.                                (* (vla-get-height img) yres)
  165.                         )
  166.              )
  167.              (close file)
  168.              (vla-put-rotation img (degrad xrot))
  169.              (vla-put-origin
  170.                img
  171.                (vlax-make-variant
  172.                  (vlax-safearray-fill
  173.                    (vlax-make-safearray 5 (cons 0 2))
  174.                    ins
  175.                  )
  176.                )
  177.              )
  178.              (vla-put-imageheight
  179.                img
  180.                (* (vla-get-height img) (abs yres))
  181.              )
  182.              (vla-put-imagewidth img (* (vla-get-width img) (abs xres)))
  183.              (vla-getboundingbox img 'minpt 'maxpt)
  184.              (vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
  185.            )
  186.          )
  187.       )
  188.     )
  189.   )
  190.   (princ)                                ;exit quietly
  191. )
  192. ;;;图片插入信息写出
  193. (defun c:worldfile (/ sel filename file xscale yscale ang pt)
  194.   (if (setq sel (ssget ":s" '((0 . "IMAGE"))))
  195.     (progn
  196.       (setq sel (vlax-ename->vla-object (ssname sel 0)))
  197.       (if (setq        filename
  198.                  (getfiled
  199.                    "Save World File As"
  200.                    (strcat
  201.                      (vl-filename-directory (vla-get-imagefile sel))
  202.                      "\"
  203.                      (vl-filename-base (vla-get-imagefile sel))
  204.                      (cdr (assoc
  205.                             (vl-filename-extension
  206.                               (vla-get-imagefile sel)
  207.                             )
  208.                             (list (cons ".tif" ".tfw")
  209.                                   (cons ".png" ".pgw")
  210.                                   (cons ".jpg" "jpw")
  211.                             )
  212.                           )
  213.                      )
  214.                    )
  215.                    (cdr
  216.                      (assoc
  217.                        (vl-filename-extension (vla-get-imagefile sel))
  218.                        (list (cons ".tif" "tfw")
  219.                              (cons ".png" "pgw")
  220.                              (cons ".jpg" "jpw")
  221.                        )
  222.                      )
  223.                    )
  224.                    1
  225.                  )
  226.           )
  227.         (progn
  228.           (setq        xscale (/ (vla-get-imagewidth sel) (vla-get-width sel))
  229.                 yscale (/ (vla-get-imageheight sel)
  230.                           (vla-get-height sel)
  231.                           -1.0
  232.                        )
  233.                 ang    (vla-get-rotation sel)
  234.                 pt     (polar
  235.                          (safearray-value (variant-value (vla-get-origin sel)))
  236.                          (+ ang (/ pi 2))
  237.                          (vla-get-imageheight sel)
  238.                        )
  239.           )
  240.           (setq file (open filename "w"))
  241.           (princ (rtos xscale 2 6) file)
  242.           (princ "\n" file)
  243.           (princ (rtos (raddeg ang) 2 6) file)
  244.           (princ "\n" file)
  245.           (princ (rtos (raddeg (+ ang (/ pi 2.0))) 2 6) file)
  246.           (princ "\n" file)
  247.           (princ (rtos yscale 2 6) file)
  248.           (princ "\n" file)
  249.           (princ (rtos (car pt) 2 6) file)
  250.           (princ "\n" file)
  251.           (princ (rtos (cadr pt) 2 6) file)
  252.           (princ "\n" file)
  253.           (close file)
  254.         )
  255.       )
  256.     )
  257.   )
  258.   (princ)
  259. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 3031个

财富等级: 富可敌国

发表于 2016-12-13 20:26:25 | 显示全部楼层
本帖最后由 auva 于 2016-12-13 20:29 编辑

感谢楼主分享,经测试:位置会有像素的偏差,差了半个相素。
                                       如果座标檔有旋转参数,结果会出错。
以上是跟Global Mapper执行比较的。

我用http://www.cadstudio.cz/georefimg的Georefimg这个的vlx,
功能及执行步骤类似(这个是支援旋转),结果跟Global Mapper结果是相同的。


以上是测试结果。
请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:GeoRefImg2.9.zip 
下载次数:15  文件大小:61.79 KB 
下载权限: 不限 以上  [免费赚D豆]





论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-12-13 20:39:54 | 显示全部楼层

层主,我这有个LISP,处理TFW文件,然后拼接影像图的,我不是这个专业,你测试下,精度如何

请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:TFW文件影响处理.lsp 
下载次数:25  文件大小:2.37 KB 
下载权限: 不限 以上  [免费赚D豆]


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2017-10-1 22:36:20 | 显示全部楼层
踩一下,留下脚印; 说一声,感谢分享;赞一下,不错不错。。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6056个

财富等级: 富甲天下

发表于 2017-10-2 00:05:56 | 显示全部楼层
感谢楼主分享
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 9个

财富等级: 恭喜发财

发表于 2020-4-21 20:04:52 | 显示全部楼层
正在学习这方面的内容,谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2021-5-10 09:09:54 | 显示全部楼层
大佬牛逼,找了好久了,万分感谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 23:22 , Processed in 0.434698 second(s), 48 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表