Extracting EXIF data from photos
So this code works but puts block coordinates in the improper location, My EXIF data is lat and longs in DMS, not sure if this is converting to DD? then I need to project that value forward into my current coordinate system in my drawing. Sample Photo EXIF Data Details and code, Block name is Test and it is not dynamic.
This is where it should end up at least in my drawing
;; Retrieves EXIF data from specified image file
(defun ExifData (file / err idata iprop oimg)
(if (and (setq file (findfile file))
(setq oimg (vlax-create-object "WIA.Imagefile"))
);and
(progn
(setq err
(vl-catch-all-apply
(function
(lambda nil
(vlax-invoke-method oimg 'loadfile file)
(setq iprop (vlax-get-property oimg 'properties))
(vlax-for x iprop
(setq idata
(cons
(cons
(vlax-get-property x 'name)
(vlax-variant-value (vlax-get-property x 'value))
);cons
idata
);cons
);setq
);vlax-for
);lambda
);function
);vl-catch
);setq
(foreach obj (list iprop oimg)
(if (= 'vla-object (type obj))
(vlax-release-object obj)
);if
);foreach
(if (null (vl-catch-all-error-p err)) (reverse idata))
);progn
);if
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browse for Folder
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; bit - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.
(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
(setq err
(vl-catch-all-apply
(function
(lambda ( / app hwd )
(if (setq app (vlax-get-acad-object)
shl (vla-getinterfaceobject app "shell.application")
hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
)
(setq slf (vlax-get-property fld 'self)
pth (vlax-get-property slf 'path)
pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
)
)
)
)
)
)
(if slf (vlax-release-object slf))
(if fld (vlax-release-object fld))
(if shl (vlax-release-object shl))
(if (vl-catch-all-error-p err)
(prompt (vl-catch-all-error-message err))
pth
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entmake's an arbitrary GeoMarker
;; returns - ename, of marker
(defun GeoMarker ( / )
(entmakex '((0 . "POSITIONMARKER") (100 . "AcDbEntity") (100 . "AcDbGeoPositionMarker") (90 . 0) (10 0.0 0.0 0.0) (40 . 1.0)
(1 . "") (40 . 0.5) (290 . 0) (280 . 0) (290 . 1) (101 . "Embedded Object") (100 . "AcDbEntity") (100 . "AcDbMText")
(10 0.1 0.1 0.0) (40 . 1.0) (1 . "") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 9761.9) (43 . 6666.67)))
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Turns a (long lat) into coordinates ..ONLY useable if dwg is Geo-Located.
;; pt - point as (long lat),
;; returns - point, as (X Y Z[0.0]) ...since longitudes represent "x" values & Latitudes represent "y" values
(defun LL->PT (LL / e ev return)
(if (and LL
(setq e (GeoMarker)))
(progn
(setq ev (vlax-ename->vla-object e))
(vlax-put-property ev 'Longitude (rtos (car LL) 2 7))
(vlax-put-property ev 'Latitude (rtos (cadr LL) 2 7))
(setq return
(list
(getpropertyvalue e "Position/X")
(getpropertyvalue e "Position/Y")
0.0
);list
);setq
(entdel e)
return
);progn
);if
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Returns full links for all jpg, png, and bmp photos inside provided folder and all subfolders.
(defun PHOTOS_GetPhotoLinks (folder / GetLinks)
(setq GetLinks
(lambda (fldr patt)
(apply
'append
(cons
(mapcar
'(lambda (f) (strcat fldr "\\" f))
(vl-directory-files fldr patt)
);mapcar
(mapcar
'(lambda (f) (GetLinks (strcat fldr "\\" f) patt))
(vl-remove ".." (vl-remove "." (vl-directory-files fldr nil -1)))
);mapcar
);cons
);apply
);lambda
);setq
(apply
'append
(mapcar
'(lambda (str) (GetLinks folder str))
'("*.jpg" "*.png" "*.bmp")
);mapcar
);apply
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Converts Vector from EXIF data to Decimal degrees.
(defun PHOTOS_Vec2Dec (vec / v dec m)
(vlax-for v vec
(setq v (vlax-get v 'Value))
(cond
((and dec m) (setq dec (+ dec (/ v 3600))))
(dec (setq dec (+ dec (setq m (/ v 60)))))
(t (setq dec v))
);cond
);vlax-for
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; If an image file has GPS data, return list of file & lon/lat
(defun PHOTOS_GetGeoData (file / data lon lat lonDir latDir)
(if (and (setq data (ExifData file))
(setq lon (cdr (assoc "GpsLongitude" data)))
(setq lat (cdr (assoc "GpsLatitude" data)))
(setq lonDir (cdr (assoc "GpsLongitudeRef" data)))
(setq latDir (cdr (assoc "GpsLatitudeRef" data)))
(setq lonDir (if (eq "E" (strcase lonDir)) + -))
(setq latDir (if (eq "N" (strcase latDir)) + -))
(setq lon (lonDir (PHOTOS_Vec2Dec lon)))
(setq lat (latDir (PHOTOS_Vec2Dec lat)))
);and
(list file (list lon lat))
);if
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Retrieves and Geo-Locates all geo-tagged photos from user-specified folder.
(defun c:PHOTOS ( / blkName blkDWG defaultBrowseLocation errMsg blkPath strPrompt folder photoLinks lyrName lyrColor e str)
;; Variable Inputs
(setq blkName "Test" ;<-- the block to insert for all photo locations (do NOT use dynamic block)
blkDWG "C:\Blocks\Test.dwg" ;<-- if block not in current dwg, where to find it
lyrName "Photo" ;<-- layer where blocks will be inserted
lyrColor 7 ;<-- if necessary to create layer
defaultBrowseLocation "C:\Blocks\" ;<-- the default path that LM's folder browser opens to
);setq
;; Initial check(s)
(cond
((eq "" (getvar 'CGEOCS)) (setq errMsg "\nDrawing must be Geo-Located."))
((zerop (getvar 'TILEMODE)) (setq errMsg "\nMust be in Model space layout."))
((and (null (tblsearch "BLOCK" blkName))
(not (and (setq blkPath (findfile blkDWG))
(null (progn (command "-INSERT" blkPath) (command))))))
(setq errMsg (strcat "\nUnable to locate drawing, " blkDWG))
)
);cond
(if errMsg
(progn (prompt errMsg) (alert errMsg) (exit))
);if
;; Begin work
(setq strPrompt "Navigate to foldere where you would like to retrieve all Geotagged photos.")
(if (and (setq folder (LM:browseforfolder strPrompt defaultBrowseLocation 512))
(setq photoLinks (PHOTOS_GetPhotoLinks folder))
(setq photoLinks (mapcar 'PHOTOS_GetGeoData photoLinks))
(setq photoLinks
(mapcar
'list
(mapcar 'car photoLinks)
(mapcar 'LL->PT (mapcar 'cadr photoLinks))
);mapcar
);setq
(setq photoLinks (vl-remove-if '(lambda (x) (null (cadr x))) photoLinks))
);and
(progn
;; Be sure layer exists
(if (not (tblsearch "LAYER" lyrName))
(entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord")
(cons 2 lyrName) (cons 70 0) (cons 62 lyrColor) (cons 290 0)))
);if
;; Place Blocks, Add hyperlink
(foreach photo photoLinks
(setq e (entmakex (list (cons 0 "INSERT") (cons 2 blkName) (cons 8 lyrName) (cons 10 (cadr photo)))))
(vla-add
(vlax-get-property
(vlax-ename->vla-object e)
'Hyperlinks
);vlax-get-property
(car photo)
);vla-add
);foreach
(setq str (strcat "\nPHOTOS Complete, " (itoa (length photoLinks)) " photos linked."))
(prompt str)
(alert str)
);progn
);if
(princ)
);defun
Hey this works good, couple of questions firstly I would love for this to insert a dynamic block so I can add a flip command for the text if I rotate the block and secondly I would like the photo name to be put into the Attribute of the block. This is looking great so far thanks for all the help in figuring this out.
