;Geo-located Photo references, by CodeDing: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-autolisp-visual-lisp-to-geo-locate-geotagged-images/td-p/10242340
; mods by VM, CADforum.cz (UI, icons/photos, scale, hyperlinks, date, altitude)
; see: https://youtu.be/ORvxW68UPBM
; see: https://www.cadforum.cz/en/link-geo-tagged-photos-from-your-mobile-phone-to-autocad-dwg-map-tip14414
; 5/2025: added altitude, date

(vl-load-com)

;; Retrieves EXIF data from specified image file
;; From user, cwake: http://www.theswamp.org/index.php?topic=38072.30
(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")
          (caddr LL)
        );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; Z = object 'Value' of (cdr (assoc "GpsAltitude" data))
(defun PHOTOS_GetGeoData (file / data lon lat lonDir latDir Z date)
  (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
      (progn
       (if (assoc "GpsAltitude" data) ; rough altitude
         ;(setq Z (vla-get-value (cdr (assoc "GpsAltitude" data))))
         (if (vl-catch-all-error-p (setq Z (vl-catch-all-apply 'vlax-get (list (cdr (assoc "GpsAltitude" data)) 'Value))))(setq Z 0.0))
         (setq Z 0.0)
       )
       (setq date "??"); DateTime & ExifDTOrig
       (if (assoc "ExifDTOrig" data)(setq date (cdr (assoc "ExifDTOrig" data))))
       (if (assoc "DateTime" data)(setq date (cdr (assoc "ExifDTOrig" data))))
       (list file (list lon lat Z) date)
      )
  );if
);defun



; (setq __picscale 1.0) ; preset scale, e.g. 1.0, 100.0, 50000...

;; 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 o str mode mspace picscale HL)
  ;; Variable Inputs
  (setq blkName "CAMERA"             ;<-- the block to insert for all photo locations (do NOT use dynamic block)
        blkDWG "C:\\Users\\MYUSERNAME\\Documents\\CAMERA.dwg" ;<-- if block not in current dwg, where to find it
        lyrName "_Geo-Photos"        ;<-- layer where blocks will be inserted
        lyrColor 11                  ;<-- if necessary to create layer
        defaultBrowseLocation nil    ;<-- or "C:\\" - the default path that LM's folder browser opens to
  );setq
  (initget "Icons Photos")
  (setq mode (getkword "\nInsert placeholder icons/blocks or photos [Icons/Photos] <Icons>: "))
  (if (not mode)(setq mode "Icons"))
  (if (not __picscale) (initget 1))
  (setq picscale (getdist (strcat "\nRelative scale of the " mode " (pick 2 points or type)" (if __picscale (strcat " <" (rtos __picscale 2 2) ">") "") ": ")))
  (if picscale (setq __picscale picscale)(setq picscale __picscale))
  ;; 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 (= mode "Icons")
          (null (tblsearch "BLOCK" blkName))
          (not (and (setq blkPath (findfile blkDWG))
                    (null (progn (command "_-INSERT" blkPath) (command))))))
       (setq errMsg (strcat "\nUnable to locate block drawing, " blkDWG))
    )
  );cond
  (if errMsg
    (progn (prompt errMsg) (alert errMsg) (exit))
  );if
  ;; Begin work
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq strPrompt "Navigate to folder 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 'caddr 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
        (if (= mode "Icons")
         (setq o (vlax-ename->vla-object (entmakex (list (cons 0 "INSERT") (cons 2 blkName) (cons 8 lyrName)
                                                         (cons 41 picscale)(cons 42 picscale)(cons 43 picscale) (cons 10 (cadr photo))))))
        ;else
         (progn
          (setq o (vla-AddRaster mspace (car photo) (vlax-3d-point (cadr photo)) picscale 0.0))
          (vla-put-layer o lyrName)
         ) 
        );if mode
        (setq HL (vla-add
          (vlax-get-property
            o
            'Hyperlinks
          );vlax-get-property
          (car photo)
        ));vla-add
        (vla-put-URLDescription HL (strcat "Go to " (car photo) "\nshot on " (caddr photo))); tooltip string
      );foreach
      (setq str (strcat "\nPHOTOS Complete, " (itoa (length photoLinks)) " photos linked (see hyperlinks)."))
      (prompt str)
      (alert str)
    );progn
  );if
  (princ)
);defun

(princ "\nGeotagged PHOTOS linker loaded. Start by typing PHOTOS.")
(princ)