Création Fichier TFW depuis une image insérée

[lecrabe]

 

Hello

 

Micro amélioration d'un programme bien pratique qui permet de générer le fichier TFW de GéoRéférencement à partir d'une image Raster insérée dans un dessin AutoCAD

 

 

;; http://georezo.net/forum/viewtopic.php?id=45805&action=new

;; GBTFW.LSP pour une IMAGE

;; Creation d'un".TFW" par GB le 10/11/03

;; mirroir en Y des paramètres AutoCAD

;; Micro-Modif par Le Crabe (Le Decapode) pour AutoCAD/MAP/CIVIL 2006 et plus

 

(defun c:GBTFW ()

 

;;; Pour AutoCAD/MAP 2000-2005

;;; (command "_imageframe" "_on" )

 

;;; Pour AutoCAD/MAP/CIVIL 2006-2009

(command "_imageframe" "1" )

 

(setq index "")

(setq ent (entget (CAR(ENTSEL "Montrer l'IMAGE: "))))

(setq ent340 (cdr (assoc 1 (entget (cdr (assoc 340 ent))))))

(setq ef (strcat (substr ent340 1 (- (strlen ent340) 4)) index ".TFW"))

(setq ftfw (open ef "w"))

(setq X10 (car (cdr (assoc 10 ent))) )

(setq Y10 (cadr (cdr (assoc 10 ent))) )

(setq X11 (car (cdr (assoc 11 ent))) )

(setq Y11 (cadr (cdr (assoc 11 ent))) )

(setq X12 (car (cdr (assoc 12 ent))) )

(setq Y12 (cadr (cdr (assoc 12 ent))) )

(setq X13 (car (cdr (assoc 13 ent))) )

(setq Y13 (cadr (cdr (assoc 13 ent))) )

(setq line1 (rtos X11 2 9))

(write-line line1 ftfw)

(setq line2 (rtos Y11 2 9))

(write-line line2 ftfw)

(setq line3 (rtos (* -1 X12) 2 9))

(write-line line3 ftfw)

(setq line4 (rtos (* -1 Y12) 2 9))

(write-line line4 ftfw)

(setq line5 (rtos (+ X10 (* X12 Y13)) 2 9))

(write-line line5 ftfw)

(setq line6 (rtos (+ Y10 (* Y12 Y13)) 2 9))

(write-line line6 ftfw)

(close ftfw)

 

)

 

Le Decapode