Copy images in current drawing to selected folder

Copy images in current drawing to selected folder

DC-MWA
Collaborator Collaborator
859 Views
9 Replies
Message 1 of 10

Copy images in current drawing to selected folder

DC-MWA
Collaborator
Collaborator

Hello,

I have an extensive list of drawings in which I need to gather all the referenced images in each drawing and copy them to a new directory. 

I started to franken-lisp something together and realized as I often do that this is way out of my league. I'm hoping someone out there has done something similar.

I have attached what I have (not much).

Thank you in advance for any assistance received.

0 Likes
Accepted solutions (2)
860 Views
9 Replies
Replies (9)
Message 2 of 10

pbejse
Mentor
Mentor

@DC-MWA wrote:

Hello,

I have an extensive list of drawings in which I need to gather all the referenced images in each drawing and copy them to a new directory. 


Does that include subfolders?

0 Likes
Message 3 of 10

DC-MWA
Collaborator
Collaborator

No.

Get list of images from current drawing.

select folder to copy to

copy each image to selected folder

and now that I'm doing this, if I could rename the image name with an "X-" on the front of the image name that would be awesome.

0 Likes
Message 4 of 10

pbejse
Mentor
Mentor
Accepted solution

@DC-MWA wrote:

No.

Get list of images from current drawing.

select folder to copy to

copy each image to selected folder

and now that I'm doing this, if I could rename the image name with an "X-" on the front of the image name that would be awesome.


 

(defun c:copydwgimages (/ ss i image file  images)
  (vl-load-com)
  (and
    (setq ss (ssget "X" '((0 . "IMAGE"))))
    (setq i 0)
    (repeat (sslength ss)
      (setq image (vlax-ename->vla-object (ssname ss i))
	    name  (vla-get-name image)
	    file  (vla-get-imagefile image)
	    i	  (1+ i)
      )
      (if (not (member file images))
	(setq images (cons file images))
	)
      images
    )
    (setq dir-loc (acet-ui-pickdir
		    "Select Files to XREF"
		  )
    )
    (foreach itm images 
      (setq p (vl-string-position 92  itm nil T))
	(vl-file-copy
		itm
		(strcat	dir-loc
			"\\" "X-" (substr itm (+ 2 p))
		)
	      ) 
      (vl-file-copy
	itm
	(strcat	dir-loc
		"\\" "X-"
		(vl-filename-base itm)
		(vl-filename-extension itm)
	)
      )
    )
  )
  (princ)
)

 

HTH

 

0 Likes
Message 5 of 10

DC-MWA
Collaborator
Collaborator

I just tested it on my first drawing. It seems to work perfectly!!!

0 Likes
Message 6 of 10

pbejse
Mentor
Mentor

@DC-MWA wrote:

I just tested it on my first drawing. It seems to work perfectly!!!


That's good to know, Glad it helps.

Cheers

 

0 Likes
Message 7 of 10

DC-MWA
Collaborator
Collaborator

After I do the copying of the files, I then open the savedas drawing and rename all the images to "X-imagename" and remove the paths.

Is this something we could do or should I start another post?

0 Likes
Message 8 of 10

pbejse
Mentor
Mentor
Accepted solution

@DC-MWA wrote:

After I do the copying of the files, I then open the savedas drawing and rename all the images to "X-imagename" and remove the paths.

Is this something we could do or should I start another post?


Sure we can.

BTW please ignore the post #4 as i tried to modify it and i run out of time

This version will save the drawing on the selected folder where the new renamed images are located

(defun c:copydwgimages (/ aDoc ss i image file  images)
(vl-load-com)
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))  
  (if
    (and
      (setq ss (ssget "X" '((0 . "IMAGE"))))
      (setq i 0)
      (repeat (sslength ss)
	(setq image (vlax-ename->vla-object (ssname ss i))
	      file  (vla-get-imagefile image)
	      i	    (1+ i)
	)
	(if (not (assoc file images))
	  (setq images (cons (list file image) images))
	)
	images
      )
      (setq dir-loc (acet-ui-pickdir "Select Files to XREF"))
    )
     (progn
       (Vla-saveas
	 aDoc
	 (strcat dir-loc "\\" (Vla-get-name aDoc))
       )
       (foreach	itm images
	 (setq NameAndPath (car itm))
	 (vl-file-copy
	   NameAndPath
	   (strcat dir-loc
		   "\\"
		   "X-"
		   (setq xname (vl-filename-base NameAndPath))
		   (vl-filename-extension NameAndPath)
	   )
	 )
	 (vla-put-name (cadr itm) (strcat "X-" xname))
	 (vla-put-imagefile
	   (cadr itm)
	   (strcat ".\\"
		   (strcat "X-" xname)
		   (vl-filename-extension NameAndPath)
	   )
	 )
       )
     )
  )
  (princ)
)

HTH

 

 

 

 

0 Likes
Message 9 of 10

DC-MWA
Collaborator
Collaborator

This is exactly what I was looking for. I truly appreciate your time and knowledge. This will save me counless hours of time.

THANK YOU SO MUCH!!

0 Likes
Message 10 of 10

pbejse
Mentor
Mentor

@DC-MWA wrote:

This is exactly what I was looking for. I truly appreciate your time and knowledge. This will save me counless hours of time.

THANK YOU SO MUCH!!


My pleasure, glad it helps

Cheers

 

0 Likes