Jakub Posted August 20, 2015 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Spaj Posted August 20, 2015 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted August 20, 2015 Share Posted 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) Quote Link to comment Share on other sites More sharing options...
Jakub Posted August 20, 2015 Author Share Posted 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. Quote Link to comment Share on other sites More sharing options...
tombu Posted August 20, 2015 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 21, 2015 Share Posted 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) Quote Link to comment Share on other sites More sharing options...
Jakub Posted August 25, 2015 Author Share Posted 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? Quote Link to comment Share on other sites More sharing options...
tombu Posted August 25, 2015 Share Posted August 25, 2015 (edited) 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. Quote Link to comment Share on other sites More sharing options...
Jakub Posted August 26, 2015 Author Share Posted 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? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 26, 2015 Share Posted August 26, 2015 Try changing "+.:E:S" to "_+.:E:S" Quote Link to comment Share on other sites More sharing options...
Jakub Posted August 26, 2015 Author Share Posted 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? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 26, 2015 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Jakub Posted August 26, 2015 Author Share Posted 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! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 26, 2015 Share Posted August 26, 2015 You're welcome Jakub, I'm glad it helps and thank you for your compliments. Quote Link to comment Share on other sites More sharing options...
chrismyr Posted May 25 Share Posted May 25 Hello friends is it possible the above code to supports also .tif files?? Also an also interested part, if this is possible, is, as we handle georeferenced image, to import an image from a specific folder (than we have specified before) by clicking in cad. Does someone has seen this someware Thanks anyway Christos On 8/21/2015 at 6:27 AM, BIGAL said: 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) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 25 Share Posted May 25 Do you have a tiff and a JGW file or only the tiff file ? Quote Link to comment Share on other sites More sharing options...
chrismyr Posted May 26 Share Posted May 26 I have .tif and .tfw files Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 27 Share Posted May 27 I am not sure but look in code above change JGW to TFW and see if it works. The TFW should have 6 lines of information like scale, X & Y. 0.09596117668048 0.00000000000000 0.00000000000000 -0.09596117668048 630708.84619759640191 5749997.23614041972905 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.