I have used the same lisp, only changed the block name area. Please have a look and correct me, that will be appreciated. Thank you.
;; 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 - Lee Mac
;; 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 "IMAGEDIR" ;<-- the block to insert for all photo locations (do NOT use dynamic block)
;;blkDWG "C:\\users\\my folder\\IMAGEDIR.dwg" ;<-- if block not in current dwg, where to find it
blkDWG "C:\\FIMGDR\\IMAGEDIRECTION.dwg"
lyrName "_Geo-Photos" ;<-- layer where blocks will be inserted
lyrColor 11 ;<-- if necessary to create layer
defaultBrowseLocation "C:\\" ;<-- 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
