用于图像的LISP
大家好，我想知道是否有可能创建一个lisp，可以同时将多个图像附加到AutoCAD 2010，并创建一个新层，该层的名称与每个图像的名称相同。
我下载了georefimg应用程序，该应用程序基于world文件将图像放置在AutoCAD中的特定位置，但有必要对每个图像分别执行此操作。在这个应用程序的情况下，首先要做的是附加一个图像到CAD，然后我可以使用georefimg选择一个图像（之前插入的），以便把它放在适当的部分。但是，如果我在随机位置均匀地附加许多图像，然后对所有图像使用此georefimg，则速度更快、效率更高。
如果有人知道如何准备这样的东西，我将不胜感激。
最美好的祝福，
雅库布 你好
ABC AutoCAD的“光栅管理器”允许选择多个图像并对其进行地理参考，但不适用于单个图层。如果你是AutoCAD 2010，应该没问题。 将目录路径更改为您想要的路径和要附加的扩展映像，它们必须位于目录路径中。
(defun c:Test (/ fld p en e lst p files nm l r)
;; Tharwat 20.08.2015 ;;
(if (and (findfile
(setq fld "C:\\\New folder")
)
(setq p '(0. 0. 0.)
en (entlast)
files (vl-directory-files fld "*.jpg" 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.)
ene
)
(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)
谢谢塔瓦的回复。我很好奇是否可以用这种方式修改下面的lisp，以获得与您发送给我的类似的结果。
使用上面的代码，我可以将许多图像插入CAD，但这些图像的名称有问题。我需要插入具有原始名称（无需修改）的图像，并为每个图像创建一个新层，其名称为前缀为xxx的图像：
图：1_2。jpg公司
层：xxx\u 1\u 2
我知道如果没有lisp编程的基本知识，帮助别人可能会很沮丧，但我想尽快开始学习。
谢谢你的帮助。 如果你需要georefimg应用程序根据世界文件代码放置图像，将选定的图像放置在具有相同名称的层上，或者使用默认前缀将它们组合在一起，可能会更有帮助。 我们使用Georgef lsp并手动拾取图像，通常情况下，lsp会更新所有3个图像，因此很容易对所有图像进行highlite处理，然后运行lisp。唯一的限制条件是jpg和jgw必须在一个目录中，否则它将要求选择目录。忽略对tiff的引用，我们使用jpg
;;;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 <" 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 <" 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)
我想知道是否有可能创建一个lisp例程，为图像创建一个新层。我会尽量详细解释这一点。
例如：我在Autocad中随机插入了一组图像。我想运行一个lisp例程，我会选择这些图像（这些图像的一个区域），按下“回车”键后，获得与每个图像同名的新层，并将此图像传输到每个创建的层中。
我有两张图片：图片1。jpg，图2。在这个过程之后，我会得到名称为：image1和image2的层，每个层都有这个图像。
有人知道怎么做吗？ 这应该做到：
(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!")
)
)
当我使用这个例程时，我得到一条消息，其中“ssget”函数有一个错误（“+：E:S”）。为什么会弹出？ 尝试将“+：E:S”更改为“+：E:S”
页:
[1]
2