LISP for images

August 20, 2015

Hello everyone,

I'm wondering if it is possible to create a lisp that could attach several images to AutoCAD 2010 at the same time and create a new layer that has the same name like an image for each image.

I downloaded georefimg app that put an image in certain place in AutoCAD based on world file but it is necessary to do this for each image separately. In case of this app first thing to do is attach one image to CAD and afterwards I can use georefimg to choose an image (that was inserted before) in order to put this in proper section. But it could be faster and more efficient if I would attach many images equally in random place and after that use this georefimg for all images.

If someone has some idea how to prepare sth like this I'll be grateful for any suggestions in this case.

Best wishes,

Jakub

August 20, 2015

Hi

Raster manager by ABC AutoCAD allow selection of multiple images and georeferences them, although not to individual layers. Should be fine with you're AutoCAD 2010.

August 20, 2015

Change the directory path to the one you want and the extension images that you want to attach and they must be in the directory path.

(defun c:Test (/ fld p en e lst p files nm l r)
 ;; Tharwat 20.08.2015	;;
 (if (and (findfile
            (setq fld [color="red"]"C:\\\New folder"[/color])
            )
          (setq p     '(0. 0. 0.)
                en    (entlast)
                files (vl-directory-files fld "*.[color="red"]jpg[/color]" 1)
                )
          )
   (mapcar
     '(lambda (im)
        (vl-cmdf "_.-attach" (strcat fld "\\" im) "_none" p "" "")
        (if (not (eq en (setq e (entlast))))
          (progn
            (vla-getboundingbox
              (setq o (vlax-ename->vla-object e))
              'l
              'r
              )
            (setq lst (mapcar 'vlax-safearray->list (list r l))
                  p   (list (caar lst) (cadr (cadr lst)) 0.)
                  en  e
                  )
            (if
              (not (tblsearch "LAYER" (setq nm (vl-filename-base im))))
               (progn
                 (entmake (list '(0 . "LAYER")
                                '(100 . "AcDbSymbolTableRecord")
                                '(100 . "AcDbLayerTableRecord")
                                (cons 2 nm)
                                '(70 . 0)
                                )
                          )
                 (vla-put-layer o nm)
                 )
               )
            )
          )
        )
     files
     )
   )
 (princ)
 )(vl-load-com)

August 20, 2015

Thank you Tharwat for your response. I'm curious is it possible to modify this lisp below in this way to be able to get similar results like you sent me.

(defun c:img ( / ang dis ins lst spc )
   (if
       (and
           (setq lst (LM:getfiles "Select Image Files to Insert" img:dir nil))
           (setq ins (getpoint "\nSpecify insertion point: "))
       )
       (progn
           (initget 4)
           (setq dis (cond ((getdist "\nSpecify image spacing <0>: ")) (0.0))
                 spc (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                         (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
                     )
                 ang (angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 1))
                 img:dir (vl-filename-directory (car lst))
           )
           (foreach img lst
               (setq ins
                   (cons
                       (+ (car ins) dis
                          (vla-get-imagewidth (vlax-invoke spc 'addraster img ins 1.0 ang))
                       )
                       (cdr ins)
                   )
               )
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Using this code above I can insert many images into CAD but it's problem with name of these images. I need to insert images that have the origin name (without modifying) and create a new layer for each image with a name as image with prefix xxx:

image: 1_2.jpg

layer: xxx_1_2

I know it could be frustrating to help so without basic knowledge about lisp programming but I mean to start learning ASAP.

Thanks for any help.

August 20, 2015

Being as you need the georefimg app to place the images based on world file code to place selected images on layers with the same name or with a default prefix to group them together would probably be more helpful.

August 21, 2015

We use a georef lsp and manually pick the images normally up to say 3 the lsp updates all 3 so it would be easy to highlite all then run lisp. The only proviso is the jpg and jgw must be together in a directory or else it will ask to pick directory. Ignore reference to tiff we use jpg's

;;;Reads world tiff file (.jgw) to scale and place image correctly in autocad.
;;;First insert all tiff images into drawing at whatever scale and insertion point.
;;;If the jgw exists in same directory and is named the same as the image selected,
;;;it will automatically be found and the image will be scaled and placed. If it is
;;;not in the same directory, the user can browse for the file.
;;;03.23.2011 Added support to create jgw files as well as support rotated images 
;;;Needs a file with 6 lines (ScaleX Rotation -Rotation -ScaleY TopLeftXCoord TopLeftYCoord)
;  « Last Edit: April 12, 2011, 09:43:43 am by ronjonp »  

(vl-load-com)
 (defun ss->lst (ss / e n out)
   (setq n -1)
   (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
 )
 (defun _writefile (filename lst / file result)
   (cond ((and (eq 'str (type filename)) (setq file (open filename "w")))
   (foreach x lst
     (write-line
       (cond ((= (type x) 'str) x)
	     ((= (type x) 'int) (itoa x))
	     ((= (type x) 'real) (rtos x 2 6))
	     ((vl-prin1-to-string x))
       )
       file
     )
   )
   (close file)
   filename
  )
   )
 )
 (defun _readfile (filename / file result)
   (cond
     ((and (eq 'str (type filename)) (setq file (open filename "r")))
      (while (setq line (read-line file)) (setq result (cons (vl-string-trim " " line) result)))
      (close file)
      (reverse result)
     )
   )
 )
 (setq opt "ReadIt")
;  (initget 0 "ReadIt WriteIt")
;  (setq	opt (cond ((getkword (strcat "\nImage World File [ReadIt/WriteIt] <" opt ">: ")))
;		  (opt)
;	    )
; )
 (princ "\nSelect image(s): ")
 (setq pre (getvar 'dwgprefix))
 (if (and (setq ss (ssget '((0 . "image")))) (setq ss (ss->lst ss)))
   (foreach image ss
     (setq name    (vlax-get image 'name)
    hgt	    (vlax-get image 'height)
    wdth    (vlax-get image 'width)
    imhgt   (vlax-get image 'imageheight)
    imwdth  (vlax-get image 'imagewidth)
    rot	    (vlax-get image 'rotation)
    bpt	    (vlax-get image 'origin)
    imgpath (vl-filename-directory (vlax-get image 'imagefile))
    jgw	    (strcat imgpath "\\" name ".jgw")
     )
     (if (= opt "ReadIt")
(progn
  (if (and (or (setq jgw (findfile (strcat pre name ".jgw")))
	       (setq jgw (findfile (strcat imgpath "\\" name ".jgw")))
	       (setq jgw (getfiled (strcat "***Select <<" name ".jgw>>***") pre "jgw" 16))
	   )
	   (setq pre (strcat (vl-filename-directory jgw) "\\"))
	   (setq data (mapcar 'atof (_readfile jgw)))
	   (> (length data) 5)
	   (setq l1 (car data))
	   (setq mvpt (list (nth 4 data) (nth 5 data) 0.0))
      )
    (progn (vla-put-imageheight image (* hgt l1))
	   (vla-put-imagewidth image (* wdth l1))
	   (vla-put-rotation image (cadr data))
	   (setq rot (vlax-get image 'rotation))
	   (setq bpt (polar bpt (+ (/ pi 2.) rot) (* hgt l1)))
	   (vlax-invoke image 'move bpt mvpt)
	   (princ (strcat "\njgw File Read - " jgw))
    )
    (princ "\njgw file NOT found or not correctly formatted!")
  )
)
(progn (setq bpt (polar bpt (+ (/ pi 2.) rot) imhgt))
       (if (setq jgw (_writefile
		       (strcat imgpath "\\" name ".jgw")
		       (list (/ imhgt hgt)
			     rot
			     (strcat "-" (rtos (abs rot) 2 6))
			     (strcat "-" (rtos (abs (/ imwdth wdth)) 2 6))
			     (rtos (car bpt) 2 6)
			     (rtos (cadr bpt) 2 6)
		       )
		     )
	   )
	(print jgw)
	(princ "\nError writing file...")
       )
)
     )
   )
 )
 (princ)

;;;Reads world tiff file (.jgw) to scale and place image correctly in autocad.
;;;First insert all tiff images into drawing at whatever scale and insertion point.
;;;If the jgw exists in same directory and is named the same as the image selected,
;;;it will automatically be found and the image will be scaled and placed. If it is
;;;not in the same directory, the user can browse for the file.
;;;03.23.2011 Added support to create jgw files as well as support rotated images 
;;;Needs a file with 6 lines (ScaleX Rotation -Rotation -ScaleY TopLeftXCoord TopLeftYCoord)
;  « Last Edit: April 12, 2011, 09:43:43 am by ronjonp »  

(vl-load-com)
 (defun ss->lst (ss / e n out)
   (setq n -1)
   (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
 )
 (defun _writefile (filename lst / file result)
   (cond ((and (eq 'str (type filename)) (setq file (open filename "w")))
   (foreach x lst
     (write-line
       (cond ((= (type x) 'str) x)
	     ((= (type x) 'int) (itoa x))
	     ((= (type x) 'real) (rtos x 2 6))
	     ((vl-prin1-to-string x))
       )
       file
     )
   )
   (close file)
   filename
  )
   )
 )
 (defun _readfile (filename / file result)
   (cond
     ((and (eq 'str (type filename)) (setq file (open filename "r")))
      (while (setq line (read-line file)) (setq result (cons (vl-string-trim " " line) result)))
      (close file)
      (reverse result)
     )
   )
 )
 (setq opt "ReadIt")
;  (initget 0 "ReadIt WriteIt")
;  (setq	opt (cond ((getkword (strcat "\nImage World File [ReadIt/WriteIt] <" opt ">: ")))
;		  (opt)
;	    )
; )
 (princ "\nSelect image(s): ")
 (setq pre (getvar 'dwgprefix))
 (if (and (setq ss (ssget '((0 . "image")))) (setq ss (ss->lst ss)))
   (foreach image ss
     (setq name    (vlax-get image 'name)
    hgt	    (vlax-get image 'height)
    wdth    (vlax-get image 'width)
    imhgt   (vlax-get image 'imageheight)
    imwdth  (vlax-get image 'imagewidth)
    rot	    (vlax-get image 'rotation)
    bpt	    (vlax-get image 'origin)
    imgpath (vl-filename-directory (vlax-get image 'imagefile))
    jgw	    (strcat imgpath "\\" name ".jgw")
     )
     (if (= opt "ReadIt")
(progn
  (if (and (or (setq jgw (findfile (strcat pre name ".jgw")))
	       (setq jgw (findfile (strcat imgpath "\\" name ".jgw")))
	       (setq jgw (getfiled (strcat "***Select <<" name ".jgw>>***") pre "jgw" 16))
	   )
	   (setq pre (strcat (vl-filename-directory jgw) "\\"))
	   (setq data (mapcar 'atof (_readfile jgw)))
	   (> (length data) 5)
	   (setq l1 (car data))
	   (setq mvpt (list (nth 4 data) (nth 5 data) 0.0))
      )
    (progn (vla-put-imageheight image (* hgt l1))
	   (vla-put-imagewidth image (* wdth l1))
	   (vla-put-rotation image (cadr data))
	   (setq rot (vlax-get image 'rotation))
	   (setq bpt (polar bpt (+ (/ pi 2.) rot) (* hgt l1)))
	   (vlax-invoke image 'move bpt mvpt)
	   (princ (strcat "\njgw File Read - " jgw))
    )
    (princ "\njgw file NOT found or not correctly formatted!")
  )
)
(progn (setq bpt (polar bpt (+ (/ pi 2.) rot) imhgt))
       (if (setq jgw (_writefile
		       (strcat imgpath "\\" name ".jgw")
		       (list (/ imhgt hgt)
			     rot
			     (strcat "-" (rtos (abs rot) 2 6))
			     (strcat "-" (rtos (abs (/ imwdth wdth)) 2 6))
			     (rtos (car bpt) 2 6)
			     (rtos (cadr bpt) 2 6)
		       )
		     )
	   )
	(print jgw)
	(princ "\nError writing file...")
       )
)
     )
   )
 )
 (princ)

August 25, 2015

I'm wondering if it is possible to create a lisp routine that creates a new layer for image. I'll try to explain this in detail.

For example: I inserted a bunch of images in Autocad randomly. I'd like to run a lisp routine that I would select those images (an area of these images) and after pushed 'Enter' get new layers with name the same like each image and transfer this image into each created layer.

I've got two images: image1.jpg, image2.jpg and after this process I would get layers with names: image1 and image2 and each layer has this image.

Does somebody have some idea how to do this?

August 25, 2015

This should do it:

(vl-load-com)
(defun c:Image2Lay (/ ss ent el Elay)
(setq ss (ssget "+.:E:S" '((0 . "image"))))
(if ss
    (progn
	    (setq EOBJ (vlax-ename->vla-object (ssname SS 0))	; Entity object
		  Elay (vlax-get-property EOBJ 'Name )	; Object layer
	    )
	    (or (tblsearch "layer" Elay)(command "-LAYER" "N" Elay ""))
	    (vlax-put-property EOBJ 'Layer Elay)
    )
    (princ "\nNo SS!")
)
)

Edited August 25, 2015 by tombu
Changed to only add layer if not in drawing.

August 26, 2015

When I used this routine I've got a message with an error for 'ssget' function ("+.:E:S"). Why does it pop out?

August 26, 2015

Try changing "+.:E:S" to "_+.:E:S"

August 26, 2015

I've tried to use this routine with this changing but now I had messages:

- unknow command "-LAYER"

- unknow command "N"

- and unknow command "here is a name of image"

Why did I get these messages?

August 26, 2015

Try the following modification of my code (you will need to first download & load my Get Files function):

(defun c:img ( / ang dis doc ins lay lst lyc obj spc str )
   (if
       (and
           (setq lst (LM:getfiles "Select Image Files to Insert" img:dir nil))
           (setq ins (getpoint "\nSpecify insertion point: "))
       )
       (progn
           (initget 4)
           (setq dis (cond ((getdist "\nSpecify image spacing <0>: ")) (0.0))
                 str (getstring t "\nSpecify layer prefix <none>: ")
                 doc (vla-get-activedocument (vlax-get-acad-object))
                 spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                 ang (angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 1))
                 lyc (vla-get-layers doc)
                 img:dir (vl-filename-directory (car lst))
           )
           (foreach img lst
               (setq obj (vlax-invoke spc 'addraster img ins 1.0 ang)
                     ins (cons (+ (car ins) dis (vla-get-imagewidth obj)) (cdr ins))
                     lay (strcat str "_" (vl-filename-base img))
               )
               (vla-add lyc lay)
               (vla-put-layer obj lay)
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

The above is untested however.

August 26, 2015

I don't know how to thank you for helping me. Everything works perfectly. I'm appreciate what you've done for me. You're such an amazing guy!

August 26, 2015

You're welcome Jakub, I'm glad it helps and thank you for your compliments.

LISP for images

Recommended Posts

Jakub

Link to comment

Share on other sites

Spaj

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Jakub

Link to comment

Share on other sites

tombu

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Jakub

Link to comment

Share on other sites

tombu

Link to comment

Share on other sites

Jakub

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Jakub

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Jakub

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity