跪求同TWF文件导入TIF到CAD的源代码

canyangqing

前面看有个前辈写了一个这个程序，但用后发现图片例大了一倍，而且是封装过的，哪位大神有这个程序的源码能不能共享下啊

Atsai

GeoRefImg，这个是插入带座标图片的檔案，可以到下面的连结看一下！
不是批次的！
http://www.cadstudio.cz/georefimg

下面的代码如果worldfile的x旋转量及y旋转量不为0的话会跟GeoRefImg套出来的结果不同。

2. ;;; AUTHOR
   
3. ;;; Copyrightc 2011 Ron Perez (ronperez AT gmail DOT com)
   
4. ;;;
   
5. 
   
6. ;;;Reads world tiff file (.tfw) to scale and place image correctly in autocad.
   
7. ;;;First insert all tiff images into drawing at whatever scale and insertion point.
   
8. ;;;If the TFW exists in same directory and is named the same as the image selected,
   
9. ;;;it will automatically be found and the image will be scaled and placed. If it is
   
10. ;;;not in the same directory it can be browsed to.
    
11. ;;;03.23.2011 Added support to create TFW files as well as support rotated images :)
    
12. ;;;10.11.2011 *BUG FIX* Basepoint was off 1/2 the pixel resolution DOH!
    
13. ;;;Needs a file with 6 lines (ScaleX Rotation -Rotation -ScaleY TopLeftXCoord TopLeftYCoord)
    
14. (defun c:tfw (/              ss->lst foo     _readfile              _writetofile    bpt
    
15.               data    ext     hgt     hs      imgpath imhgt   imwdth  l1
    
16.               mvpt    name    opt     pre     rot     ss      tfw     wdth
    
17.              )
    
18.   (vl-load-com)
    
19.   (defun ss->lst (ss / e n out)
    
20.     (setq n -1)
    
21.     (while (setq e (ssname ss (setq n (1+ n))))
    
22.       (setq out (cons (vlax-ename->vla-object e) out))
    
23.     )
    
24.   )
    
25.   (defun _writetofile (filename lst / file result)
    
26.     (cond ((and (eq 'str (type filename)) (setq file (open filename "w")))
    
27.            (foreach x lst
    
28.              (write-line
    
29.                (cond ((= (type x) 'str) x)
    
30.                      ((= (type x) 'int) (itoa x))
    
31.                      ((= (type x) 'real) (rtos x 2 16))
    
32.                      ((vl-prin1-to-string x))
    
33.                )
    
34.                file
    
35.              )
    
36.            )
    
37.            (close file)
    
38.            filename
    
39.           )
    
40.     )
    
41.   )
    
42.   (defun _readfile (filename / file line result)
    
43.     (cond
    
44.       ((and (eq 'str (type filename)) (setq file (open filename "r")))
    
45.        (while (setq line (read-line file))
    
46.          (setq result (cons (vl-string-trim " " line) result))
    
47.        )
    
48.        (close file)
    
49.        (reverse result)
    
50.       )
    
51.     )
    
52.   )
    
53.   (defun foo (file / ext)
    
54.     (if        (setq ext (strcase (vl-filename-extension file) t))
    
55.       (cond ((wcmatch ext ".tif*") ".tfw")
    
56.             ((wcmatch ext ".jp*g") ".jgw")
    
57.             ((eq ext ".png") ".pgw")
    
58.       )
    
59.     )
    
60.   )
    
61.   (setq opt "ReadIt")
    
62.   (initget 0 "ReadIt WriteIt")
    
63.   (setq        opt
    
64.          (cond
    
65.            ((getkword (strcat "\nImage World File [ReadIt/WriteIt] <" opt ">: "))
    
66.            )
    
67.            (opt)
    
68.          )
    
69.   )
    
70.   (princ "\nSelect image(s): ")
    
71.   (setq pre (getvar 'dwgprefix))
    
72.   (if (and (setq ss (ssget ":L" '((0 . "image")))) (setq ss (ss->lst ss)))
    
73.     (foreach image ss
    
74.       (setq name    (vlax-get image 'name)
    
75.             hgt            (vlax-get image 'height)
    
76.             wdth    (vlax-get image 'width)
    
77.             imhgt   (vlax-get image 'imageheight)
    
78.             imwdth  (vlax-get image 'imagewidth)
    
79.             rot            (vlax-get image 'rotation)
    
80.             bpt            (vlax-get image 'origin)
    
81.             imgpath (vlax-get image 'imagefile)
    
82.             ext            (foo imgpath)
    
83.             imgpath (vl-filename-directory imgpath)
    
84.             tfw            (strcat imgpath "\" name ext)
    
85.       )
    
86.       (if (= opt "ReadIt")
    
87.         (progn
    
88.           (if
    
89.             (and
    
90.               (or
    
91.                 (findfile tfw)
    
92.                 (setq tfw (findfile (strcat pre name ext)))
    
93.                 (setq tfw (getfiled (strcat "***Select <<" name ext ">>***")
    
94.                                     pre
    
95.                                     (substr ext 2)
    
96.                                     16
    
97.                           )
    
98.                 )
    
99.               )
    
100.               (setq data (mapcar 'atof (_readfile tfw)))
     
101.               (> (length data) 5)
     
102.               (setq l1 (abs (car data)))
     
103.               (setq hs (* l1 0.5))
     
104.               (setq mvpt (list (nth 4 data) (nth 5 data) 0.0))
     
105.             )
     
106.              (progn (vla-put-imageheight image (* hgt l1))
     
107.                     (vla-put-imagewidth image (* wdth l1))
     
108.                     (vla-put-rotation image (cadr data))
     
109.                     (setq rot (vlax-get image 'rotation))
     
110.                     (setq bpt (polar bpt (+ (/ pi 2.) rot) (* hgt l1)))
     
111.                     ;;Basepoint offset since it's the CENTER of the upper left pixel
     
112.                     (setq bpt (list (+ (car bpt) hs) (- (cadr bpt) hs) 0.0))
     
113.                     (vlax-invoke image 'move bpt mvpt)
     
114.                     (princ (strcat "\nTFW File Read - " tfw))
     
115.              )
     
116.              (princ "\nTFW file NOT found or not correctly formatted!")
     
117.           )
     
118.         )
     
119.         (progn (setq bpt (polar bpt (+ (/ pi 2.) rot) imhgt))
     
120.                (setq hs (* (abs (/ imhgt hgt)) 0.5))
     
121.                ;;Basepoint offset since it's the CENTER of the upper left pixel
     
122.                (setq bpt (list (+ (car bpt) hs) (- (cadr bpt) hs) 0.0))
     
123.                (if (setq tfw (_writetofile
     
124.                                (if (findfile (strcat imgpath "\" name ext))
     
125.                                  (strcat imgpath "\" name ext)
     
126.                                  (strcat pre name ext)
     
127.                                )
     
128.                                (list (/ imhgt hgt)
     
129.                                      rot
     
130.                                      (- (abs rot))
     
131.                                      (- (abs (/ imwdth wdth)))
     
132.                                      (car bpt)
     
133.                                      (cadr bpt)
     
134.                                )
     
135.                              )
     
136.                    )
     
137.                  (alert (princ tfw))
     
138.                  (alert (strcat "\n!!Error writing file... " tfw))
     
139.                )
     
140.         )
     
141.       )
     
142.     )
     
143.   )
     
144.   (princ)
     
145. )

;;; AUTHOR<br /> ;;; Copyrightc 2011 Ron Perez (ronperez AT gmail DOT com)<br /> ;;;<br /> <br /> ;;;Reads world tiff file (.tfw) to scale and place image correctly in autocad.<br /> ;;;First insert all tiff images into drawing at whatever scale and insertion point.<br /> ;;;If the TFW exists in same directory and is named the same as the image selected,<br /> ;;;it will automatically be found and the image will be scaled and placed. If it is<br /> ;;;not in the same directory it can be browsed to.<br /> ;;;03.23.2011 Added support to create TFW files as well as support rotated images :)<br /> ;;;10.11.2011 *BUG FIX* Basepoint was off 1/2 the pixel resolution DOH!<br /> ;;;Needs a file with 6 lines (ScaleX Rotation -Rotation -ScaleY TopLeftXCoord TopLeftYCoord)<br /> (defun c:tfw (/              ss->lst foo     _readfile              _writetofile    bpt<br />               data    ext     hgt     hs      imgpath imhgt   imwdth  l1<br />               mvpt    name    opt     pre     rot     ss      tfw     wdth<br />              )<br />   (vl-load-com)<br />   (defun ss->lst (ss / e n out)<br />     (setq n -1)<br />     (while (setq e (ssname ss (setq n (1+ n))))<br />       (setq out (cons (vlax-ename->vla-object e) out))<br />     )<br />   )<br />   (defun _writetofile (filename lst / file result)<br />     (cond ((and (eq 'str (type filename)) (setq file (open filename "w")))<br />            (foreach x lst<br />              (write-line<br />                (cond ((= (type x) 'str) x)<br />                      ((= (type x) 'int) (itoa x))<br />                      ((= (type x) 'real) (rtos x 2 16))<br />                      ((vl-prin1-to-string x))<br />                )<br />                file<br />              )<br />            )<br />            (close file)<br />            filename<br />           )<br />     )<br />   )<br />   (defun _readfile (filename / file line result)<br />     (cond<br />       ((and (eq 'str (type filename)) (setq file (open filename "r")))<br />        (while (setq line (read-line file))<br />          (setq result (cons (vl-string-trim " " line) result))<br />        )<br />        (close file)<br />        (reverse result)<br />       )<br />     )<br />   )<br />   (defun foo (file / ext)<br />     (if        (setq ext (strcase (vl-filename-extension file) t))<br />       (cond ((wcmatch ext ".tif*") ".tfw")<br />             ((wcmatch ext ".jp*g") ".jgw")<br />             ((eq ext ".png") ".pgw")<br />       )<br />     )<br />   )<br />   (setq opt "ReadIt")<br />   (initget 0 "ReadIt WriteIt")<br />   (setq        opt<br />          (cond<br />            ((getkword (strcat "\nImage World File [ReadIt/WriteIt] <" opt ">: "))<br />            )<br />            (opt)<br />          )<br />   )<br />   (princ "\nSelect image(s): ")<br />   (setq pre (getvar 'dwgprefix))<br />   (if (and (setq ss (ssget ":L" '((0 . "image")))) (setq ss (ss->lst ss)))<br />     (foreach image ss<br />       (setq name    (vlax-get image 'name)<br />             hgt            (vlax-get image 'height)<br />             wdth    (vlax-get image 'width)<br />             imhgt   (vlax-get image 'imageheight)<br />             imwdth  (vlax-get image 'imagewidth)<br />             rot            (vlax-get image 'rotation)<br />             bpt            (vlax-get image 'origin)<br />             imgpath (vlax-get image 'imagefile)<br />             ext            (foo imgpath)<br />             imgpath (vl-filename-directory imgpath)<br />             tfw            (strcat imgpath "\" name ext)<br />       )<br />       (if (= opt "ReadIt")<br />         (progn<br />           (if<br />             (and<br />               (or<br />                 (findfile tfw)<br />                 (setq tfw (findfile (strcat pre name ext)))<br />                 (setq tfw (getfiled (strcat "***Select <<" name ext ">>***")<br />                                     pre<br />                                     (substr ext 2)<br />                                     16<br />                           )<br />                 )<br />               )<br />               (setq data (mapcar 'atof (_readfile tfw)))<br />               (> (length data) 5)<br />               (setq l1 (abs (car data)))<br />               (setq hs (* l1 0.5))<br />               (setq mvpt (list (nth 4 data) (nth 5 data) 0.0))<br />             )<br />              (progn (vla-put-imageheight image (* hgt l1))<br />                     (vla-put-imagewidth image (* wdth l1))<br />                     (vla-put-rotation image (cadr data))<br />                     (setq rot (vlax-get image 'rotation))<br />                     (setq bpt (polar bpt (+ (/ pi 2.) rot) (* hgt l1)))<br />                     ;;Basepoint offset since it's the CENTER of the upper left pixel<br />                     (setq bpt (list (+ (car bpt) hs) (- (cadr bpt) hs) 0.0))<br />                     (vlax-invoke image 'move bpt mvpt)<br />                     (princ (strcat "\nTFW File Read - " tfw))<br />              )<br />              (princ "\nTFW file NOT found or not correctly formatted!")<br />           )<br />         )<br />         (progn (setq bpt (polar bpt (+ (/ pi 2.) rot) imhgt))<br />                (setq hs (* (abs (/ imhgt hgt)) 0.5))<br />                ;;Basepoint offset since it's the CENTER of the upper left pixel<br />                (setq bpt (list (+ (car bpt) hs) (- (cadr bpt) hs) 0.0))<br />                (if (setq tfw (_writetofile<br />                                (if (findfile (strcat imgpath "\" name ext))<br />                                  (strcat imgpath "\" name ext)<br />                                  (strcat pre name ext)<br />                                )<br />                                (list (/ imhgt hgt)<br />                                      rot<br />                                      (- (abs rot))<br />                                      (- (abs (/ imwdth wdth)))<br />                                      (car bpt)<br />                                      (cadr bpt)<br />                                )<br />                              )<br />                    )<br />                  (alert (princ tfw))<br />                  (alert (strcat "\n!!Error writing file... " tfw))<br />                )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

wkq004

谢谢楼上,先收藏了.
用AutoDesk Raster Design可在cad中方便的插入对应tfw坐标的图片.