Visual LISP 使用 Image 命令

Free-Lancer · 发表于 2013-5-25 09:21:28

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

Image command from visual LISP?By Augusto Goncalves
To use the RELOAD, UNLOAD and DETACH options of the IMAGE command, it is not possible to use the AutoCAD ActiveX interface. Instead, you have to 'rebuild' these options using AutoLISP and Visual LISP functions.
-IMAGE RELOAD:
This command options works on the raster image definition object that is stored in the dictionary "ACAD_IMAGE_DICT". This object uses the DXFgroup code 280 as a 'loaded' flag. If the value of group code 280 is 1, the image file is currently loaded; if the value is 0, the image file is unloaded.
In order to get the correct entry in the image dictionary (to get the right image definition object) and set this flag to 1, use the IMAGERELOAD function (see below).
-IMAGE UNLOAD:
This command options uses the flag previously mentioned. Set the value of group code 280 to 0 to unload the image file. The function IMGUNLOAD does this.
-IMAGE DETACH:
This command options removes the specified image definition object and removes every raster image entity from the current drawing that uses the (deleted) image definition object. The IMGDETACH function does this.
You can use the following functions. They 'rebuild' the functionality of the IMAGE command options. The functions (imgreload), (imgunload) and (imgdetach) need the image name as a parameter. For the image name, use the AutoCAD wildcard mechanism.

;;; Use the function 'imgunload' instead of
;;; calling the command
;;; -IMAGE _Unload
;;;
(defun imgunload (imgname)
(imgloadstat (strcase imgname) 0)
(princ)
)
;;; Use the function 'imgreload' instead of
;;; calling the command
;;; -IMAGE _Reload
;;;
(defun imgreload (imgname)
(imgloadstat (strcase imgname) 1)
(princ)
)
;;; Use the function 'imgdetach' instead of
;;; calling the command
;;; -IMAGE _Detach
;;;
(defun imgdetach (imgname / imgDict imgDictId dictLength counter
dictName imgDefIds selSet imgDefId)
;; Iterate all dictionary entries and remove
;; the entries which matches 'imgname'.
(setq imgname (strcase imgname)
imgDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")
)
(if (equal imgDict nil)
(princ "\nNo images loaded.")
(progn
;; Image dictionary is available.
(setq imgDictId (cdr (car imgDict))
dictLength (length imgdict)
counter 0
)
(while (< counter dictLength)
(if (equal (car (nth counter imgDict)) 3)
;; Entry name found. Get it.
(progn
(setq dictName (strcase (cdr (nth counter imgDict))))
;; Compare the entry name.
(if (wcmatch dictName imgname)
(progn
;; Remove the dictionary entry...
(dictremove imgDictId dictName)
;; ...and store the entity name of
;; the raster image definition object.
(setq imgDefIds
(append imgDefIds
(list (cdr (nth (1+ counter) imgDict)))
)
)
)
)
)
)
(setq counter (1+ counter))
)
;; Finished iterating the dictionary.
;; Do we have to remove some raster image entities?
(if (/= (length imgDefIds) 0)
;; Yes, we have to remove some raster image entities
;; (because the related image definition objects
;; have been removed).
(progn
;; Select all image entities.
(setq selSet (ssget "X" '((0 . "IMAGE")))
counter 0
)
(if (/= selSet nil)
(progn
;; Iterate all image entities
(while (< counter (sslength selSet))
;; Get the entity name of the referenced
;; image definition object.
(setq imgDefId
(cdr (assoc 340 (entget (ssname selSet counter))))
)
;; Is the referenced definition object gone?
(if (member imgDefId imgDefIds)
;; The definition for this image entity
;; have been removed, so let us remove
;; the image entity, as well.
(entdel (cdr (car (entget (ssname selSet counter)))))
)
(setq counter (1+ counter))
)
;; Empty the selection set
(setq selSet nil)
)
)
)
)
)
)
(princ)
)
;;; Internal function.
;;; This function is called by 'imgunload'
;;; and 'imgreload'.
;;;
(defun imgloadstat (imgname status / imgDict imgDictId
dictLength counter dictName dictEntry next)
;; Get the image dictionary
(setq imgDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
(if (equal imgDict nil)
(princ "\nNo images loaded.")
(progn
;; Image dictionary is available.
(setq imgDictId (cdr (car imgDict))
dictLength (length imgdict)
counter 0
next T
)
(while (< counter dictLength)
(if (equal (car (nth counter imgDict)) 3)
;; Entry name found. Get it.
(progn
;; Get dictionary entry name
;; and the dictionary entry
(setq dictName (strcase (cdr (nth counter imgDict)))
dictEntry (dictnext imgDictId next)
next nil
)
;; Compare the entry name with the given name.
(if (wcmatch dictName imgname)
(progn
;; Entry found. Set the 'loaded' flag
(setq dictEntry (subst (cons 280 status)
(assoc 280 dictEntry)
dictEntry
)
)
;; There is a problem in AutoCAD
;; which is fixed by 'fixlist'.
;; Some entities / objects should
;; return on 'entget' 2D points,
;; but VisualLisp gets 3D points.
;; The (wrong) z value of thereturned
;; point contains a random value
;; which can break 'entmod'.
;; In case of an image definition
;; object we have to remove the
;; z value of group code 10 and
;; 11 before we can use 'entmod'.
(entmod (fixlist dictEntry))
)
)
)
)
(setq counter (1+ counter))
)
)
)
)
;;; Internal function.
;;; This function avoids the problem with 2D / 3D points.
;;;
(defun fixlist (imgDef /)
;; Get the group code 10 and 11 list
(setq pt1 (assoc 10 imgDef)
pt2 (assoc 11 imgDef)
)
;; Remove the z value of group code 10...
(setq imgDef (subst (list 10 (nth 1 pt1) (nth 2 pt1))
(assoc 10 imgDef)
imgDef
)
)
;; ...and the z value of group code 11.
(setq imgDef (subst (list 11 (nth 1 pt2) (nth 2 pt2))
(assoc 11 imgDef)
imgDef
)
)
;; Return the fixed list
imgDef
)
(princ "\nNew lisp functions:")
(princ "\n(imgunload ), (imgreload ), (imgdetach)\n")
(princ)

;;; Use the function 'imgunload' instead of 
;;; calling the command 
;;; -IMAGE _Unload 
;;; 
(defun imgunload (imgname) 
  (imgloadstat (strcase imgname) 0) 
  (princ) 
) 
 
;;; Use the function 'imgreload' instead of 
;;; calling the command 
;;; -IMAGE _Reload 
;;; 
(defun imgreload (imgname) 
  (imgloadstat (strcase imgname) 1) 
  (princ) 
) 
 
;;; Use the function 'imgdetach' instead of 
;;; calling the command 
;;; -IMAGE _Detach 
;;; 
(defun imgdetach (imgname / imgDict imgDictId dictLength counter 
        dictName imgDefIds selSet imgDefId) 
 
  ;; Iterate all dictionary entries and remove 
  ;; the entries which matches 'imgname'. 
 
  (setq imgname (strcase imgname) 
    imgDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT") 
  ) 
  (if (equal imgDict nil) 
   (princ "\nNo images loaded.") 
   (progn 
    ;; Image dictionary is available. 
    (setq imgDictId  (cdr (car imgDict)) 
       dictLength (length imgdict) 
       counter  0 
    ) 
    (while (< counter dictLength) 
      (if (equal (car (nth counter imgDict)) 3) 
       ;; Entry name found. Get it. 
       (progn 
        (setq dictName (strcase (cdr (nth counter imgDict)))) 
        ;; Compare the entry name. 
        (if (wcmatch dictName imgname) 
          (progn 
           ;; Remove the dictionary entry... 
           (dictremove imgDictId dictName) 
           ;; ...and store the entity name of 
           ;; the raster image definition object. 
           (setq imgDefIds 
            (append imgDefIds 
                (list (cdr (nth (1+ counter) imgDict))) 
            ) 
           ) 
          ) 
        ) 
       ) 
      ) 
      (setq counter (1+ counter)) 
    ) 
    ;; Finished iterating the dictionary. 
    ;; Do we have to remove some raster image entities? 
    (if (/= (length imgDefIds) 0) 
      ;; Yes, we have to remove some raster image entities 
      ;; (because the related image definition objects 
      ;; have been removed). 
      (progn 
       ;; Select all image entities. 
       (setq selSet  (ssget "X" '((0 . "IMAGE"))) 
          counter 0 
       ) 
       (if (/= selSet nil) 
        (progn 
          ;; Iterate all image entities 
          (while (< counter (sslength selSet)) 
           ;; Get the entity name of the referenced 
           ;; image definition object. 
           (setq imgDefId 
            (cdr (assoc 340 (entget (ssname selSet counter)))) 
           ) 
           ;; Is the referenced definition object gone? 
           (if (member imgDefId imgDefIds) 
            ;; The definition for this image entity 
            ;; have been removed, so let us remove 
            ;; the image entity, as well. 
            (entdel (cdr (car (entget (ssname selSet counter))))) 
           ) 
           (setq counter (1+ counter)) 
          ) 
          ;; Empty the selection set 
          (setq selSet nil) 
        ) 
       ) 
      ) 
    ) 
   ) 
  ) 
  (princ) 
) 
 
;;; Internal function. 
;;; This function is called by 'imgunload' 
;;; and 'imgreload'. 
;;; 
(defun imgloadstat (imgname status / imgDict imgDictId 
          dictLength counter dictName dictEntry next) 
 
  ;; Get the image dictionary 
  (setq imgDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")) 
  (if (equal imgDict nil) 
   (princ "\nNo images loaded.") 
   (progn 
    ;; Image dictionary is available. 
    (setq imgDictId  (cdr (car imgDict)) 
       dictLength (length imgdict) 
       counter  0 
       next  T 
    ) 
    (while (< counter dictLength) 
      (if (equal (car (nth counter imgDict)) 3) 
       ;; Entry name found. Get it. 
       (progn 
        ;; Get dictionary entry name 
        ;; and the dictionary entry 
        (setq dictName (strcase (cdr (nth counter imgDict))) 
           dictEntry (dictnext imgDictId next) 
           next  nil 
        ) 
        ;; Compare the entry name with the given name. 
        (if (wcmatch dictName imgname) 
          (progn 
           ;; Entry found. Set the 'loaded' flag 
           (setq dictEntry (subst (cons 280 status) 
                      (assoc 280 dictEntry) 
                      dictEntry 
                  ) 
           ) 
           ;; There is a problem in AutoCAD 
           ;; which is fixed by 'fixlist'. 
           ;; Some entities / objects should 
           ;; return on 'entget' 2D points, 
           ;; but VisualLisp gets 3D points. 
           ;; The (wrong) z value of thereturned 
           ;; point contains a random value 
           ;; which can break 'entmod'. 
           ;; In case of an image definition 
           ;; object we have to remove the 
           ;; z value of group code 10 and 
           ;; 11 before we can use 'entmod'. 
           (entmod (fixlist dictEntry)) 
          ) 
        ) 
       ) 
      ) 
      (setq counter (1+ counter)) 
    ) 
   ) 
  ) 
) 
 
;;; Internal function. 
;;; This function avoids the problem with 2D / 3D points. 
;;; 
(defun fixlist (imgDef /) 
  ;; Get the group code 10 and 11 list 
  (setq pt1 (assoc 10 imgDef) 
    pt2 (assoc 11 imgDef) 
  ) 
  ;; Remove the z value of group code 10... 
  (setq imgDef (subst (list 10 (nth 1 pt1) (nth 2 pt1)) 
           (assoc 10 imgDef) 
           imgDef 
        ) 
  ) 
  ;; ...and the z value of group code 11. 
  (setq imgDef (subst (list 11 (nth 1 pt2) (nth 2 pt2)) 
           (assoc 11 imgDef) 
           imgDef 
        ) 
  ) 
  ;; Return the fixed list 
  imgDef 
) 
(princ "\nNew lisp functions:") 
(princ "\n(imgunload ), (imgreload ), (imgdetach)\n") 
(princ)

ysq101 · 发表于 2013-5-25 15:30:18

悲哀了!!!!!!看不懂E文

qyming1996 · 发表于 2014-8-31 14:07:27

从Visual LISP图像命令？由奥古斯托Goncalves

使用加载，卸载和脱离的图像命令选项，这是不可能使用AutoCAD ActiveX接口。相反，你要“重建”这些选项使用AutoLISP语言和Visual LISP函数。

图像加载：

这个命令选项的作品都存储在字典”的光栅图像定义对象acad_image_dict &quot；。这个对象使用dxfgroup代码280作为一个'装'标志。如果280组代码的值为1，图像文件是当前加载的；如果值为0，图像文件卸载。

为了在图像词典得到正确的入口（得到正确的图像定义对象）和设置此标志为1，使用imagereload函数（见下文）。

图像卸载：

这个命令选项使用国旗前面提到的。组的代码值280到0把图像文件。功能imgunload呢。

图像脱离：

此命令的选项删除指定的图像定义的对象和当前的绘图，以消除每一栅格图像的图像对象定义实体（删除）。该imgdetach功能呢。

你可以使用以下功能。他们“重建”的图像命令选项的功能。功能（imgreload），（imgunload）和（imgdetach）需要的图像的名称作为参数。对于图像的名称，使用AutoCAD通配符机制。

-本文出自晓东CAD家园-论坛，原文地址：http://bbs.xdcad.net/thread-668318-1-1.html

账号		自动登录	找回密码
密码			立即注册

[他山之石] Visual LISP 使用 Image 命令

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分