Author Topic: Get_File_Properties  (Read 22191 times)

0 Members and 1 Guest are viewing this topic.

cwake

  • Guest
Re: Get_File_Properties
« Reply #30 on: March 04, 2014, 01:37:06 AM »
I don't have answers, sorry, but your question has intrigued me enough to do some research. It would appear that the GPS data is stored in a different manner to the typical windows properties? It would appear that it is "EXIF" data that you need to look into.
I found the following links including a way to access it using common LISP. I don't have time to look at it closer right now, but I am intrigued to find out if this is possible?

http://www.media.mit.edu/pia/Research/deepview/exif.html
http://www.theswamp.org/index.php?topic=41358.0
http://www.xach.com/lisp/zpb-exif/

ymg

  • Guest
Re: Get_File_Properties
« Reply #31 on: March 04, 2014, 03:39:27 AM »
Here's alink to what I use to get to the exif data.

ExifToolGUI v. 5.15

ymg

cwake

  • Guest
Re: Get_File_Properties
« Reply #32 on: March 04, 2014, 04:39:00 PM »
This could be a start... There are more things that you can do with the properties object eg. "IsVector" "Type".

Code - Auto/Visual Lisp: [Select]
  1. (defun exifdata ( file / err idata iprop oimg )
  2.   (if (and (setq file (findfile file))
  3.            (setq oimg (vlax-create-object "WIA.Imagefile"))
  4.            )
  5.     (progn
  6.       (setq err (vl-catch-all-apply
  7.                   (function
  8.                     (lambda nil
  9.                       (vlax-invoke-method oimg 'loadfile file)
  10.                       (setq iprop (vlax-get-property oimg 'properties))
  11.                       (vlax-for x iprop
  12.                         (setq idata (cons (cons (vlax-get-property x 'name) (vlax-variant-value (vlax-get-property x 'value))) idata))
  13.                         )
  14.                       )
  15.                     )
  16.                   )
  17.             )
  18.       (foreach obj (list iprop oimg)
  19.         (if (= 'vla-object (type obj))
  20.           (vlax-release-object obj)
  21.           )
  22.         )
  23.       (if (null (vl-catch-all-error-p err)) (reverse idata))
  24.       )
  25.     )
  26.   )
  27.  

Gemini

  • Mosquito
  • Posts: 6
Re: Get_File_Properties
« Reply #33 on: January 10, 2019, 04:04:21 PM »
This works perfectly cwake in my images with GPS information.
But I get something like this:
("GpsLatitudeRef" . "N") ("GpsLatitude" . #<VLA-OBJECT IVector 00000235c7ec2540>)
("GpsLongitudeRef" . "W") ("GpsLongitude" . #<VLA-OBJECT IVector 00000235c7ec1a50>)
How can I put the "GpsLatitude" and "GpsLongitude" with logical values, that I can understand.
Example: "41.352056°" and "8.180461°" or UTM coordinates.
Thank you.

Rod

  • Newt
  • Posts: 185
Re: Get_File_Properties
« Reply #34 on: January 10, 2019, 04:17:24 PM »
I have started on this. Here is my progress. Rough but working for me.
I looked up -windows image acquition-
If you develop it further please post your lsp.
Thanks, Rod.

[EDIT Should have cleaned this up and commented more. Sorry flat out at the moment, hope it's helpful]

Code - Auto/Visual Lisp: [Select]
  1. (defun exifdata (file / idata)
  2.   ;;/ err idata iprop imgObj )
  3.   (if (and (setq file (findfile file))
  4.            (setq imgObj (vlax-create-object "WIA.Imagefile"))
  5.       ) ;_ end of and
  6.     (progn
  7.       (setq
  8.         err (vl-catch-all-apply
  9.               (function
  10.                 (lambda nil
  11.                   (vlax-invoke-method imgObj 'loadfile file)
  12.                   (setq iprop (vlax-get-property imgObj 'properties))
  13.                   (princ "\nProperties")
  14.                 ) ;_ end of lambda
  15.               ) ;_ end of function
  16.             ) ;_ end of vl-catch-all-apply
  17.       ) ;_ end of setq
  18.       (if (null (vl-catch-all-error-p err))
  19.         (progn
  20.           ;;(dumpall iprop)
  21.           (setq idata (getall iprop))
  22.           (princ "\nData")
  23.           ;;(dumpall idata)
  24.         ) ;_ end of progn
  25.       ) ;_ end of if
  26.  ;_ end of if
  27.     ) ;_ end of progn
  28.   ) ;_ end of if
  29.   iprop
  30. ) ;_ end of defun
  31.  
  32. ;;take a list of files return a list of dotted pairs eg ("Filename" . "C:temp")("Latitude" -35.4576)(Longtitude "149.1234)
  33.  
  34. ;;;(defun C:test (/ idata)
  35. ;;;  (setq file (getfiled "" "" "" 0))
  36. ;;;  (setq iprop (exifdata file))
  37. ;;;  (setq lat (getgpslat valuelist))
  38. ;;;  (setq long (getgpslong valuelist))
  39. ;;;  (rel)
  40. ;;;  (setq pt (list long lat))
  41. ;;;  (setq actpt (lltoact pt))
  42. ;;;  (princ)
  43. ;;;) ;_ end of defun
  44.  
  45. (defun c:test (/ pathAndFiles path files file imageFiles locationsList)
  46.   (setq pathAndFiles (dos_getfilem "Select images to insert into drawing" "Y:\\" "*.JPG;*.JPEG;*.PNG;*.TIFF"))
  47.   (setq path (car pathAndFiles))
  48.   (setq files (cdr pathAndFiles))
  49.   (foreach file files
  50.     (setq imageFiles (cons (strcat path file) imageFiles))
  51.   ) ;_ end of foreach
  52.   (setq imageFiles (reverse imageFiles))
  53.   (setq locationsList (getImageLocations imagefiles))
  54.   (insertPhotoLocationBlocks locationsList)
  55. ) ;_ end of defun
  56.  
  57. (defun insertPhotoLocationBlocks (locationsList)
  58.   (foreach lst locationsList
  59.     (setq file (car lst))
  60.     (setq pt (cadr lst))
  61.     (setq rot (caddr lst))
  62.     (if rot
  63.       (command "insert" "PHOTO LOCATION" pt 1 1 rot)
  64.       (command "insert" "PHOTO LOCATION" pt 1 1 0)
  65.     ) ;_ end of if
  66.     (command "-hyperlink" "insert" "object" "last" "" file "" file)
  67.   ) ;_ end of foreach
  68. ) ;_ end of defun
  69.  
  70. (defun rel ()
  71.   (foreach obj (list iprop imgObj)
  72.     (if (= 'vla-object (type obj))
  73.       (vlax-release-object obj)
  74.     ) ;_ end of if
  75.   ) ;_ end of foreach
  76. ) ;_ end of defun
  77.  
  78. (defun getImageLocations (imageList)
  79.   (setq imgObj (vlax-create-object "WIA.Imagefile"))
  80.   (foreach image imageList
  81.     (if (setq imageFile (findfile image))
  82.       (progn
  83.         (setq locationlist (getImageLocation imgObj imageFile))
  84.         (if locationlist
  85.           (setq locationsList (cons locationlist locationsList))
  86.           (princ (strcat "\nCouldn't find location for " imageFile))
  87.         ) ;_ end of if
  88.       ) ;_ end of progn
  89.       (princ (strcat "\nCouldn't find file for " image))
  90.     ) ;_ end of if
  91.   ) ;_ end of foreach
  92.   (if (listp locationsList)
  93.     (reverse locationsList)
  94.     nil
  95.   ) ;_ end of if
  96. ) ;_ end of defun
  97.  
  98. (defun getImageLocation (imgObj imageFile)
  99.   (setq
  100.     err (vl-catch-all-apply
  101.           (function
  102.             (lambda nil
  103.               (vlax-invoke-method imgObj 'loadfile imageFile)
  104.               (setq iprop (vlax-get-property imgObj 'properties))
  105.             ) ;_ end of lambda
  106.           ) ;_ end of function
  107.         ) ;_ end of vl-catch-all-apply
  108.   ) ;_ end of setq
  109.     (progn
  110.       (setq idata (getall iprop))
  111.       (setq lat (getgpslat idata))
  112.       (setq long (getgpslong idata))
  113.       (setq dir (getGpsDir idata))
  114.       (setq pt (list long lat))
  115.       (setq actpt (lltoact pt))
  116.     ) ;_ end of progn
  117.   ) ;_ end of if
  118. ;;;  (if (= 'vla-object (type iprop))
  119. ;;;    (vlax-release-object iprop)
  120. ;;;  ) ;_ end of if
  121.   (list imageFile actpt dir)
  122. ) ;_ end of defun
  123.  
  124.  
  125.  
  126. ;;;(defun getall (collection / err x valuelist)
  127. ;;;  ;;
  128. ;;;  (setq
  129. ;;;    err      (vl-catch-all-apply
  130. ;;;       (function
  131. ;;;         (lambda nil
  132. ;;;           (vlax-for x collection
  133. ;;;             ;;(vlax-dump-object x T)
  134. ;;;             (setq
  135. ;;;               valuelist
  136. ;;;                (cons (cons (vlax-get-property x 'name)
  137. ;;;                            (vlax-variant-value
  138. ;;;                              (vlax-get-property x 'value)
  139. ;;;                            ) ;_ end of vlax-variant-value
  140. ;;;                      ) ;_ end of cons
  141. ;;;                      valuelist
  142. ;;;                ) ;_ end of cons
  143. ;;;             ) ;_ end of setq
  144. ;;;           ) ;_ end of vlax-for
  145. ;;;         ) ;_ end of lambda
  146. ;;;       ) ;_ end of function
  147. ;;;     ) ;_ end of vl-catch-all-apply
  148. ;;;  ) ;_ end of setq
  149. ;;;
  150. ;;;  (if (listp valuelist);;(null (vl-catch-all-error-p err))
  151. ;;;    (reverse valuelist)
  152. ;;;  ) ;_ end of if
  153. ;;;) ;_ end of defun
  154.  
  155. (defun getall (collection / err x valuelist name prop)
  156.   (vlax-for x collection
  157.     (setq name (vl-catch-all-apply '(lambda nil (vlax-get-property x 'name))))
  158.     (setq prop (vl-catch-all-apply '(lambda nil (vlax-variant-value (vlax-get-property x 'value)))))
  159.       (setq valuelist (cons (cons name prop) valuelist))
  160.     ) ;_ end of if
  161.     ;;(vlax-dump-object x T)
  162.  ;_ end of setq
  163.   ) ;_ end of vlax-for
  164.   (if (listp valuelist)
  165.     ;;(null (vl-catch-all-error-p err))
  166.     (reverse valuelist)
  167.   ) ;_ end of if
  168. ;;;  (foreach x (reverse valuelist)
  169. ;;;    (princ (strcat "\n" (vl-princ-to-string x)))
  170. ;;;  ) ;_ end of foreach
  171. ) ;_ end of defun
  172.  
  173.  
  174. (defun dumpall (collection)
  175.   (setq
  176.     err (vl-catch-all-apply
  177.           (function
  178.             (lambda nil
  179.               (vlax-for x collection
  180.                 (vlax-dump-object x T)
  181.  
  182.               ) ;_ end of vlax-for
  183.             ) ;_ end of lambda
  184.           ) ;_ end of function
  185.         ) ;_ end of vl-catch-all-apply
  186.   ) ;_ end of setq
  187.  
  188.     (reverse valuelist)
  189.   ) ;_ end of if
  190. ) ;_ end of defun
  191.  
  192. (defun getitemfromcollection (collection itemname / valuelist)
  193.   (setq
  194.     err (vl-catch-all-apply
  195.           (function
  196.             (lambda nil
  197.               (vlax-for x collection
  198.                 (setq
  199.                   valuelist
  200.                    (cons (vlax-get-property x itemname)
  201.                          valuelist
  202.                    ) ;_ end of cons
  203.                 ) ;_ end of setq
  204.               ) ;_ end of vlax-for
  205.             ) ;_ end of lambda
  206.           ) ;_ end of function
  207.         ) ;_ end of vl-catch-all-apply
  208.   ) ;_ end of setq
  209.     (reverse valuelist)
  210.     nil
  211.   ) ;_ end of if
  212. ) ;_ end of defun
  213.  
  214.  
  215. (defun getGpsLatref (idata / dottedpair ref)
  216.   (if (setq dottedpair (assoc "GpsLatitudeRef" idata))
  217.     (setq ref (cdr dottedpair))
  218.   ) ;_ end of if
  219.   (if (equal ref "S")
  220.     (setq ref -1)
  221.     (setq ref 1)
  222.   ) ;_ end of if
  223. ) ;_ end of defun
  224.  
  225. (defun getGpsLongref (idata / dottedpair ref)
  226.   (if (setq dottedpair (assoc "GpsLongitudeRef" idata))
  227.     (setq ref (cdr dottedpair))
  228.   ) ;_ end of if
  229.   (if (equal ref "W")
  230.     (setq ref -1)
  231.     (setq ref 1)
  232.   ) ;_ end of if
  233. ) ;_ end of defun
  234.  
  235. (defun getimagewidth (idata)
  236.   (if (setq dottedpair (assoc "ImageWidth" idata))
  237.     (cdr dottedpair)
  238.     nil
  239.   ) ;_ end of if
  240. ) ;_ end of defun
  241.  
  242. (defun getimageheight (idata / dottedpair)
  243.   (if (setq dottedpair (assoc "ImageHeight" idata))
  244.     (cdr dottedpair)
  245.     nil
  246.   ) ;_ end of if
  247. ) ;_ end of defun
  248.  
  249. (defun getGpsLat (idata / gpsLatobj)
  250.   (if (and (setq pair (assoc "GpsLatitude" idata))
  251.            (setq gpsLatobj (cdr pair))
  252.            (setq lat (getgpsvalue gpsLatobj))
  253.            (setq ref (getGpsLatref idata))
  254.       ) ;_ end of and
  255.     (* lat ref)
  256.     nil
  257.   ) ;_ end of if
  258. ) ;_ end of defun
  259.  
  260. (defun getGpsDir (idata)
  261.   (if (and (setq pair (assoc "GpsImgDir" idata))
  262.            (setq GpsImgDirObj (cdr pair))
  263.            (setq imgDir (vlax-get-property GpsImgDirObj 'value))
  264.       ) ;_ end of and
  265.     (setq imgDir (- imgDir 12.9))
  266.   ) ;_ end of if
  267. ) ;_ end of defun
  268.  
  269.  
  270.  
  271.  
  272. (defun getGpsLong (idata / gpslongobj)
  273.   (if (and (setq pair (assoc "GpsLongitude" idata))
  274.            (setq gpslongobj (cdr pair))
  275.            (setq long (getgpsvalue gpslongobj))
  276.            (setq ref (getGpsLongref idata))
  277.       ) ;_ end of and
  278.     (* long ref)
  279.     nil
  280.   ) ;_ end of if
  281. ) ;_ end of defun
  282.  
  283. (defun getgpsvalue (vectorObj / Numlist Denomlist i numerator denominator dms dd)
  284.   (setq Numlist (getitemfromcollection vectorobj "Numerator"))
  285.   (setq Denomlist (getitemfromcollection vectorobj "Denominator"))
  286.   (setq i 0)
  287.   (repeat 3
  288.     (if (and (setq numerator (nth i Numlist))
  289.              (setq denominator (nth i Denomlist))
  290.              (not (zerop denominator))
  291.         ) ;_ end of and
  292.       (setq dms (cons (/ (float numerator) denominator) dms))
  293.       (setq dms (cons 0 dms))
  294.     ) ;_ end of if
  295.     (setq i (1+ i))
  296.   ) ;_ end of repeat
  297.   (setq dms (reverse dms))
  298.   (setq dd (getdecimaldegrees dms))
  299. ) ;_ end of defun
  300.  
  301. (defun getdecimaldegrees (dms)
  302.   (+ (car dms) (/ (cadr dms) 60) (/ (caddr dms) 3600))
  303. ) ;_ end of defun
  304.  
  305. (defun ACTtoLL (pt)
  306.   (ade_projptbackward pt)
  307. ) ;_ end of defun
  308.  
  309. (defun LLtoACT (pt)
  310.   ;;pt must be a list in the form of long lat
  311.   (ade_projptforward pt)
  312. ) ;_ end of defun
  313.  
  314. (ade_projsetsrc "LL84")
  315. (ade_projsetdest "SGC")
  316. (princ "\nGeo.lsp loaded")
  317. (princ "\nGPS.lsp loaded")
  318.  ;|«Visual LISP© Format Options»
  319. (200 2 40 2 T "end of " 100 20 0 0 0 T T nil T)
  320. ;*** DO NOT add text below the comment! ***|;
  321.  
  322.  
« Last Edit: January 10, 2019, 04:21:13 PM by Rod »
"All models are wrong, some models are useful" - George Box

Gemini

  • Mosquito
  • Posts: 6
Re: Get_File_Properties
« Reply #35 on: January 10, 2019, 04:44:30 PM »
Sorry to bother you, but some functions are missing:
"dos_getfilem", "ade_projsetsrc" and "ade_projsetdest".
Thank you.

Rod

  • Newt
  • Posts: 185
Re: Get_File_Properties
« Reply #36 on: January 10, 2019, 05:17:24 PM »
Hi Gemini,

dos_getfilem is part of doslib (free download arx that extends lisp with additional functions, been around for along time really useful)
"ade_projsetsrc" and "ade_projsetdest" are lisp functions that included with autocad map

You will have to hack into my code but it should help you unravel the ivector object.

I might have some time next week to help if you are stuck. Otherwise and hopefully someone else with better programming skills will jump in!
"All models are wrong, some models are useful" - George Box

Gemini

  • Mosquito
  • Posts: 6
Re: Get_File_Properties
« Reply #37 on: January 11, 2019, 02:36:54 PM »
I had installed the "doslib" and the "dos_getfilem" seems to work perfectly. Thank you.
I will try to with your code, get the real values off "ivector object". But I don't have AutoCAD Map, to resolve "ade_projptbackward", "ade_projsetsrc" and "ade_projsetdest" Map functions :(

Rod

  • Newt
  • Posts: 185
Re: Get_File_Properties
« Reply #38 on: January 13, 2019, 05:08:24 PM »
Rather than reproject them if your drawing has a coordinate system attached (geographiclocation https://help.autodesk.com/view/CIV3D/2019/ENU/index.html?guid=GUID-10A3B776-A0FA-4438-B29B-EA22C070A27E) you could use
(COMMAND "GEOMARKLATLONG" latitude longitude filename)
"All models are wrong, some models are useful" - George Box

Gemini

  • Mosquito
  • Posts: 6
Re: Get_File_Properties
« Reply #39 on: January 14, 2019, 08:03:56 AM »
Hi Rod, many thanks for your suggestion.
But I want to insert hundreds of pictures in lots of drawings. And for that, I'm trying to use lisp. With "geo..." locations commands, I need to use a program to extract lat an log, coordinates from the pictures(exif), and after that to make a script(that's an idea). With lisp is more easy and simple.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Get_File_Properties
« Reply #40 on: January 14, 2019, 04:13:37 PM »
Awesome MP

I also tested it in BricsCAD 18.2
How do you print the return list in a column format?

Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Get_File_Properties
« Reply #41 on: January 16, 2019, 01:43:42 PM »
Awesome MP

I also tested it in BricsCAD 18.2
How do you print the return list in a column format?

I added this to the end of your code, to print out the results to a text file:

    (setq fh (open "f:/Propertiy Result.txt" "w"))   
    (foreach x result (write-line (vl-prin1-to-string x) fh))
    (close fh)


I assume this is the best way?
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Get_File_Properties
« Reply #42 on: January 16, 2019, 02:02:01 PM »
Edit to last post:

    (setq fh (open (strcat (getvar "Dwgprefix")(vl-filename-base (getvar "dwgname")) "-FilePropertyResults.txt") "w"))
    (foreach x result (write-line (vl-prin1-to-string x) fh))
    (close fh)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Get_File_Properties
« Reply #43 on: January 16, 2019, 04:51:24 PM »
I assume this is the best way?

Of all the ways it could be done it's definitely one of them. :)

Another way might [be] to ensure the output name is write-able — bailing if not — or creating a new output name that is [write-able].

Edit: Fixed typos.
« Last Edit: January 16, 2019, 08:45:53 PM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

xdcad

  • Bull Frog
  • Posts: 430
Re: Get_File_Properties
« Reply #44 on: April 10, 2020, 11:49:35 AM »
I have started on this. Here is my progress. Rough but working for me.
I looked up -windows image acquition-
If you develop it further please post your lsp.
Thanks, Rod.

[EDIT Should have cleaned this up and commented more. Sorry flat out at the moment, hope it's helpful]

Code - Auto/Visual Lisp: [Select]
  1. (defun exifdata (file / idata)
  2.   ;;/ err idata iprop imgObj )
  3.   (if (and (setq file (findfile file))
  4.            (setq imgObj (vlax-create-object "WIA.Imagefile"))
  5.       ) ;_ end of and
  6.     (progn
  7.       (setq
  8.         err (vl-catch-all-apply
  9.               (function
  10.                 (lambda nil
  11.                   (vlax-invoke-method imgObj 'loadfile file)
  12.                   (setq iprop (vlax-get-property imgObj 'properties))
  13.                   (princ "\nProperties")
  14.                 ) ;_ end of lambda
  15.               ) ;_ end of function
  16.             ) ;_ end of vl-catch-all-apply
  17.       ) ;_ end of setq
  18.       (if (null (vl-catch-all-error-p err))
  19.         (progn
  20.           ;;(dumpall iprop)
  21.           (setq idata (getall iprop))
  22.           (princ "\nData")
  23.           ;;(dumpall idata)
  24.         ) ;_ end of progn
  25.       ) ;_ end of if
  26.  ;_ end of if
  27.     ) ;_ end of progn
  28.   ) ;_ end of if
  29.   iprop
  30. ) ;_ end of defun
  31.  
  32. ;;take a list of files return a list of dotted pairs eg ("Filename" . "C:temp")("Latitude" -35.4576)(Longtitude "149.1234)
  33.  
  34. ;;;(defun C:test (/ idata)
  35. ;;;  (setq file (getfiled "" "" "" 0))
  36. ;;;  (setq iprop (exifdata file))
  37. ;;;  (setq lat (getgpslat valuelist))
  38. ;;;  (setq long (getgpslong valuelist))
  39. ;;;  (rel)
  40. ;;;  (setq pt (list long lat))
  41. ;;;  (setq actpt (lltoact pt))
  42. ;;;  (princ)
  43. ;;;) ;_ end of defun
  44.  
  45. (defun c:test (/ pathAndFiles path files file imageFiles locationsList)
  46.   (setq pathAndFiles (dos_getfilem "Select images to insert into drawing" "Y:\\" "*.JPG;*.JPEG;*.PNG;*.TIFF"))
  47.   (setq path (car pathAndFiles))
  48.   (setq files (cdr pathAndFiles))
  49.   (foreach file files
  50.     (setq imageFiles (cons (strcat path file) imageFiles))
  51.   ) ;_ end of foreach
  52.   (setq imageFiles (reverse imageFiles))
  53.   (setq locationsList (getImageLocations imagefiles))
  54.   (insertPhotoLocationBlocks locationsList)
  55. ) ;_ end of defun
  56.  
  57. (defun insertPhotoLocationBlocks (locationsList)
  58.   (foreach lst locationsList
  59.     (setq file (car lst))
  60.     (setq pt (cadr lst))
  61.     (setq rot (caddr lst))
  62.     (if rot
  63.       (command "insert" "PHOTO LOCATION" pt 1 1 rot)
  64.       (command "insert" "PHOTO LOCATION" pt 1 1 0)
  65.     ) ;_ end of if
  66.     (command "-hyperlink" "insert" "object" "last" "" file "" file)
  67.   ) ;_ end of foreach
  68. ) ;_ end of defun
  69.  
  70. (defun rel ()
  71.   (foreach obj (list iprop imgObj)
  72.     (if (= 'vla-object (type obj))
  73.       (vlax-release-object obj)
  74.     ) ;_ end of if
  75.   ) ;_ end of foreach
  76. ) ;_ end of defun
  77.  
  78. (defun getImageLocations (imageList)
  79.   (setq imgObj (vlax-create-object "WIA.Imagefile"))
  80.   (foreach image imageList
  81.     (if (setq imageFile (findfile image))
  82.       (progn
  83.         (setq locationlist (getImageLocation imgObj imageFile))
  84.         (if locationlist
  85.           (setq locationsList (cons locationlist locationsList))
  86.           (princ (strcat "\nCouldn't find location for " imageFile))
  87.         ) ;_ end of if
  88.       ) ;_ end of progn
  89.       (princ (strcat "\nCouldn't find file for " image))
  90.     ) ;_ end of if
  91.   ) ;_ end of foreach
  92.   (if (listp locationsList)
  93.     (reverse locationsList)
  94.     nil
  95.   ) ;_ end of if
  96. ) ;_ end of defun
  97.  
  98. (defun getImageLocation (imgObj imageFile)
  99.   (setq
  100.     err (vl-catch-all-apply
  101.           (function
  102.             (lambda nil
  103.               (vlax-invoke-method imgObj 'loadfile imageFile)
  104.               (setq iprop (vlax-get-property imgObj 'properties))
  105.             ) ;_ end of lambda
  106.           ) ;_ end of function
  107.         ) ;_ end of vl-catch-all-apply
  108.   ) ;_ end of setq
  109.     (progn
  110.       (setq idata (getall iprop))
  111.       (setq lat (getgpslat idata))
  112.       (setq long (getgpslong idata))
  113.       (setq dir (getGpsDir idata))
  114.       (setq pt (list long lat))
  115.       (setq actpt (lltoact pt))
  116.     ) ;_ end of progn
  117.   ) ;_ end of if
  118. ;;;  (if (= 'vla-object (type iprop))
  119. ;;;    (vlax-release-object iprop)
  120. ;;;  ) ;_ end of if
  121.   (list imageFile actpt dir)
  122. ) ;_ end of defun
  123.  
  124.  
  125.  
  126. ;;;(defun getall (collection / err x valuelist)
  127. ;;;  ;;
  128. ;;;  (setq
  129. ;;;    err      (vl-catch-all-apply
  130. ;;;       (function
  131. ;;;         (lambda nil
  132. ;;;           (vlax-for x collection
  133. ;;;             ;;(vlax-dump-object x T)
  134. ;;;             (setq
  135. ;;;               valuelist
  136. ;;;                (cons (cons (vlax-get-property x 'name)
  137. ;;;                            (vlax-variant-value
  138. ;;;                              (vlax-get-property x 'value)
  139. ;;;                            ) ;_ end of vlax-variant-value
  140. ;;;                      ) ;_ end of cons
  141. ;;;                      valuelist
  142. ;;;                ) ;_ end of cons
  143. ;;;             ) ;_ end of setq
  144. ;;;           ) ;_ end of vlax-for
  145. ;;;         ) ;_ end of lambda
  146. ;;;       ) ;_ end of function
  147. ;;;     ) ;_ end of vl-catch-all-apply
  148. ;;;  ) ;_ end of setq
  149. ;;;
  150. ;;;  (if (listp valuelist);;(null (vl-catch-all-error-p err))
  151. ;;;    (reverse valuelist)
  152. ;;;  ) ;_ end of if
  153. ;;;) ;_ end of defun
  154.  
  155. (defun getall (collection / err x valuelist name prop)
  156.   (vlax-for x collection
  157.     (setq name (vl-catch-all-apply '(lambda nil (vlax-get-property x 'name))))
  158.     (setq prop (vl-catch-all-apply '(lambda nil (vlax-variant-value (vlax-get-property x 'value)))))
  159.       (setq valuelist (cons (cons name prop) valuelist))
  160.     ) ;_ end of if
  161.     ;;(vlax-dump-object x T)
  162.  ;_ end of setq
  163.   ) ;_ end of vlax-for
  164.   (if (listp valuelist)
  165.     ;;(null (vl-catch-all-error-p err))
  166.     (reverse valuelist)
  167.   ) ;_ end of if
  168. ;;;  (foreach x (reverse valuelist)
  169. ;;;    (princ (strcat "\n" (vl-princ-to-string x)))
  170. ;;;  ) ;_ end of foreach
  171. ) ;_ end of defun
  172.  
  173.  
  174. (defun dumpall (collection)
  175.   (setq
  176.     err (vl-catch-all-apply
  177.           (function
  178.             (lambda nil
  179.               (vlax-for x collection
  180.                 (vlax-dump-object x T)
  181.  
  182.               ) ;_ end of vlax-for
  183.             ) ;_ end of lambda
  184.           ) ;_ end of function
  185.         ) ;_ end of vl-catch-all-apply
  186.   ) ;_ end of setq
  187.  
  188.     (reverse valuelist)
  189.   ) ;_ end of if
  190. ) ;_ end of defun
  191.  
  192. (defun getitemfromcollection (collection itemname / valuelist)
  193.   (setq
  194.     err (vl-catch-all-apply
  195.           (function
  196.             (lambda nil
  197.               (vlax-for x collection
  198.                 (setq
  199.                   valuelist
  200.                    (cons (vlax-get-property x itemname)
  201.                          valuelist
  202.                    ) ;_ end of cons
  203.                 ) ;_ end of setq
  204.               ) ;_ end of vlax-for
  205.             ) ;_ end of lambda
  206.           ) ;_ end of function
  207.         ) ;_ end of vl-catch-all-apply
  208.   ) ;_ end of setq
  209.     (reverse valuelist)
  210.     nil
  211.   ) ;_ end of if
  212. ) ;_ end of defun
  213.  
  214.  
  215. (defun getGpsLatref (idata / dottedpair ref)
  216.   (if (setq dottedpair (assoc "GpsLatitudeRef" idata))
  217.     (setq ref (cdr dottedpair))
  218.   ) ;_ end of if
  219.   (if (equal ref "S")
  220.     (setq ref -1)
  221.     (setq ref 1)
  222.   ) ;_ end of if
  223. ) ;_ end of defun
  224.  
  225. (defun getGpsLongref (idata / dottedpair ref)
  226.   (if (setq dottedpair (assoc "GpsLongitudeRef" idata))
  227.     (setq ref (cdr dottedpair))
  228.   ) ;_ end of if
  229.   (if (equal ref "W")
  230.     (setq ref -1)
  231.     (setq ref 1)
  232.   ) ;_ end of if
  233. ) ;_ end of defun
  234.  
  235. (defun getimagewidth (idata)
  236.   (if (setq dottedpair (assoc "ImageWidth" idata))
  237.     (cdr dottedpair)
  238.     nil
  239.   ) ;_ end of if
  240. ) ;_ end of defun
  241.  
  242. (defun getimageheight (idata / dottedpair)
  243.   (if (setq dottedpair (assoc "ImageHeight" idata))
  244.     (cdr dottedpair)
  245.     nil
  246.   ) ;_ end of if
  247. ) ;_ end of defun
  248.  
  249. (defun getGpsLat (idata / gpsLatobj)
  250.   (if (and (setq pair (assoc "GpsLatitude" idata))
  251.            (setq gpsLatobj (cdr pair))
  252.            (setq lat (getgpsvalue gpsLatobj))
  253.            (setq ref (getGpsLatref idata))
  254.       ) ;_ end of and
  255.     (* lat ref)
  256.     nil
  257.   ) ;_ end of if
  258. ) ;_ end of defun
  259.  
  260. (defun getGpsDir (idata)
  261.   (if (and (setq pair (assoc "GpsImgDir" idata))
  262.            (setq GpsImgDirObj (cdr pair))
  263.            (setq imgDir (vlax-get-property GpsImgDirObj 'value))
  264.       ) ;_ end of and
  265.     (setq imgDir (- imgDir 12.9))
  266.   ) ;_ end of if
  267. ) ;_ end of defun
  268.  
  269.  
  270.  
  271.  
  272. (defun getGpsLong (idata / gpslongobj)
  273.   (if (and (setq pair (assoc "GpsLongitude" idata))
  274.            (setq gpslongobj (cdr pair))
  275.            (setq long (getgpsvalue gpslongobj))
  276.            (setq ref (getGpsLongref idata))
  277.       ) ;_ end of and
  278.     (* long ref)
  279.     nil
  280.   ) ;_ end of if
  281. ) ;_ end of defun
  282.  
  283. (defun getgpsvalue (vectorObj / Numlist Denomlist i numerator denominator dms dd)
  284.   (setq Numlist (getitemfromcollection vectorobj "Numerator"))
  285.   (setq Denomlist (getitemfromcollection vectorobj "Denominator"))
  286.   (setq i 0)
  287.   (repeat 3
  288.     (if (and (setq numerator (nth i Numlist))
  289.              (setq denominator (nth i Denomlist))
  290.              (not (zerop denominator))
  291.         ) ;_ end of and
  292.       (setq dms (cons (/ (float numerator) denominator) dms))
  293.       (setq dms (cons 0 dms))
  294.     ) ;_ end of if
  295.     (setq i (1+ i))
  296.   ) ;_ end of repeat
  297.   (setq dms (reverse dms))
  298.   (setq dd (getdecimaldegrees dms))
  299. ) ;_ end of defun
  300.  
  301. (defun getdecimaldegrees (dms)
  302.   (+ (car dms) (/ (cadr dms) 60) (/ (caddr dms) 3600))
  303. ) ;_ end of defun
  304.  
  305. (defun ACTtoLL (pt)
  306.   (ade_projptbackward pt)
  307. ) ;_ end of defun
  308.  
  309. (defun LLtoACT (pt)
  310.   ;;pt must be a list in the form of long lat
  311.   (ade_projptforward pt)
  312. ) ;_ end of defun
  313.  
  314. (ade_projsetsrc "LL84")
  315. (ade_projsetdest "SGC")
  316. (princ "\nGeo.lsp loaded")
  317. (princ "\nGPS.lsp loaded")
  318.  ;|«Visual LISP© Format Options»
  319. (200 2 40 2 T "end of " 100 20 0 0 0 T T nil T)
  320. ;*** DO NOT add text below the comment! ***|;
  321.  
  322.  

HI,How find GEO.LSP?
and
where are the functions ade_projsetsrc and ade_projsetdest defined?

thanks!
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
[XDrx-Sub Forum]
https://www.theswamp.org/index.php?board=78.0
https://github.com/xdcad/XDrx-API
http://bbs.xdcad.net