Jump to content
Jakub

LISP for images

Recommended Posts

Jakub

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

Share this post


Link to post
Share on other sites
Spaj

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.

Share this post


Link to post
Share on other sites
Tharwat

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)

Share this post


Link to post
Share on other sites
Jakub

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.

Share this post


Link to post
Share on other sites
tombu

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.

Share this post


Link to post
Share on other sites
BIGAL

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)

Share this post


Link to post
Share on other sites
Jakub

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?

Share this post


Link to post
Share on other sites
tombu

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 by tombu
Changed to only add layer if not in drawing.

Share this post


Link to post
Share on other sites
Jakub

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

Share this post


Link to post
Share on other sites
Lee Mac

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

Share this post


Link to post
Share on other sites
Jakub

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?

Share this post


Link to post
Share on other sites
Lee Mac

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.

Share this post


Link to post
Share on other sites
Jakub

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! :D

Share this post


Link to post
Share on other sites
Lee Mac

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

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...