插入图片及修正

iLisp · 发表于 2016-12-13 11:11:34

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

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

×

;|
GEOTiff.LSP
Copyright ?2004 Michel Loftus
----------------------------------------------------------------|;
(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:tfw (/ img file res pt xres yres xrot yrot left top minpt maxpt
im) ;define the function name and variables
(princ
"\nSelect Image or return to select image file to insert"
)
(if (or (setq im (ssget ":s" '((0 . "IMAGE"))))
(findfile (setq im (getfiled "Select Image File"
(getvar "dwgprefix")
"png;tif;jpg;ecw"
16
)
)
)
) ;select the image to scale
(progn
(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
".jpw"
(vl-filename-extension (vla-get-imagefile img))
(vla-get-imagefile img)
)
)
(setq
file (vl-string-subst
".jpw"
(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
"Select World File"
(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
)
;;;图片插入信息写出
(defun c:worldfile (/ sel filename file xscale yscale ang pt)
(if (setq sel (ssget ":s" '((0 . "IMAGE"))))
(progn
(setq sel (vlax-ename->vla-object (ssname sel 0)))
(if (setq filename
(getfiled
"Save World File As"
(strcat
(vl-filename-directory (vla-get-imagefile sel))
"\"
(vl-filename-base (vla-get-imagefile sel))
(cdr (assoc
(vl-filename-extension
(vla-get-imagefile sel)
)
(list (cons ".tif" ".tfw")
(cons ".png" ".pgw")
(cons ".jpg" "jpw")
)
)
)
)
(cdr
(assoc
(vl-filename-extension (vla-get-imagefile sel))
(list (cons ".tif" "tfw")
(cons ".png" "pgw")
(cons ".jpg" "jpw")
)
)
)
1
)
)
(progn
(setq xscale (/ (vla-get-imagewidth sel) (vla-get-width sel))
yscale (/ (vla-get-imageheight sel)
(vla-get-height sel)
-1.0
)
ang (vla-get-rotation sel)
pt (polar
(safearray-value (variant-value (vla-get-origin sel)))
(+ ang (/ pi 2))
(vla-get-imageheight sel)
)
)
(setq file (open filename "w"))
(princ (rtos xscale 2 6) file)
(princ "\n" file)
(princ (rtos (raddeg ang) 2 6) file)
(princ "\n" file)
(princ (rtos (raddeg (+ ang (/ pi 2.0))) 2 6) file)
(princ "\n" file)
(princ (rtos yscale 2 6) file)
(princ "\n" file)
(princ (rtos (car pt) 2 6) file)
(princ "\n" file)
(princ (rtos (cadr pt) 2 6) file)
(princ "\n" file)
(close file)
)
)
)
)
(princ)
)

;| 
    GEOTiff.LSP 
    Copyright ?2004 Michel Loftus 
  ----------------------------------------------------------------|; 
(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:tfw (/        img file res pt        xres yres xrot yrot left top minpt maxpt 
              im)                        ;define the function name and variables 
  (princ 
    "\nSelect Image or return to select image file to insert" 
  ) 
  (if (or (setq im (ssget ":s" '((0 . "IMAGE")))) 
          (findfile (setq im (getfiled "Select Image File" 
                                       (getvar "dwgprefix") 
                                       "png;tif;jpg;ecw" 
                                       16 
                             ) 
                    ) 
          ) 
      )                                        ;select the image to scale 
    (progn 
      (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 
                        ".jpw" 
                        (vl-filename-extension (vla-get-imagefile img)) 
                        (vla-get-imagefile img) 
                      ) 
            ) 
             (setq 
               file (vl-string-subst 
                      ".jpw" 
                      (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 
                     "Select World File" 
                     (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 
) 
;;;图片插入信息写出 
(defun c:worldfile (/ sel filename file xscale yscale ang pt) 
  (if (setq sel (ssget ":s" '((0 . "IMAGE")))) 
    (progn 
      (setq sel (vlax-ename->vla-object (ssname sel 0))) 
      (if (setq        filename 
                 (getfiled 
                   "Save World File As" 
                   (strcat 
                     (vl-filename-directory (vla-get-imagefile sel)) 
                     "\" 
                     (vl-filename-base (vla-get-imagefile sel)) 
                     (cdr (assoc 
                            (vl-filename-extension 
                              (vla-get-imagefile sel) 
                            ) 
                            (list (cons ".tif" ".tfw") 
                                  (cons ".png" ".pgw") 
                                  (cons ".jpg" "jpw") 
                            ) 
                          ) 
                     ) 
                   ) 
                   (cdr 
                     (assoc 
                       (vl-filename-extension (vla-get-imagefile sel)) 
                       (list (cons ".tif" "tfw") 
                             (cons ".png" "pgw") 
                             (cons ".jpg" "jpw") 
                       ) 
                     ) 
                   ) 
                   1 
                 ) 
          ) 
        (progn 
          (setq        xscale (/ (vla-get-imagewidth sel) (vla-get-width sel)) 
                yscale (/ (vla-get-imageheight sel) 
                          (vla-get-height sel) 
                          -1.0 
                       ) 
                ang    (vla-get-rotation sel) 
                pt     (polar 
                         (safearray-value (variant-value (vla-get-origin sel))) 
                         (+ ang (/ pi 2)) 
                         (vla-get-imageheight sel) 
                       ) 
          ) 
          (setq file (open filename "w")) 
          (princ (rtos xscale 2 6) file) 
          (princ "\n" file) 
          (princ (rtos (raddeg ang) 2 6) file) 
          (princ "\n" file) 
          (princ (rtos (raddeg (+ ang (/ pi 2.0))) 2 6) file) 
          (princ "\n" file) 
          (princ (rtos yscale 2 6) file) 
          (princ "\n" file) 
          (princ (rtos (car pt) 2 6) file) 
          (princ "\n" file) 
          (princ (rtos (cadr pt) 2 6) file) 
          (princ "\n" file) 
          (close file) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

auva · 发表于 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豆]

newer · 发表于 2016-12-13 20:39:54

auva 发表于 2016-12-13 20:26

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

请点击此处下载

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

您的用户组是：游客

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

/db_自贡黄明儒_ · 发表于 2017-10-1 22:36:20

踩一下，留下脚印; 说一声，感谢分享；赞一下，不错不错。。。

kqqt6236 · 发表于 2017-10-2 00:05:56

感谢楼主分享

许锦华_gHav7 · 发表于 2020-4-21 20:04:52

正在学习这方面的内容，谢谢

h117564598 · 发表于 2021-5-10 09:09:54

大佬牛逼，找了好久了，万分感谢

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

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

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

相关帖子