[编程交流] 用于图像的LISP

(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)

;;;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)

(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!")
)
)