批量拆离影像
本帖最后由 yangqingchao 于 2018-6-19 15:27 编辑有时修影像已经删除，但没有拆离，再次插入的时候会提示出错，本程序可以批量拆离已删除影像。本人刚接触autolisp，请不要见笑！
(prompt "本程序执行命令是: DetachIMG\n")
(defun c:DetachIMG ( / imageDict ss1 ss2 num lst newlst n blkName fileList)
(setvar "cmdecho" 0)
(setq ss1 (X:flists))
(setq imageDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
(setq num (length imageDict))
(setq lst (XD::List:Nth++ imageDict 10 (- num 10)))
(setq newlst (XD::LIST:Group-n lst 2))
(setq n (length newlst))
(while (< 0 n)
(setq blkName (cdr (car (nth (setq n (- n 1)) newlst))))
(setq fullName (cdr (assoc 1 (entget (cdr (car (cdr (nth n newlst))))))))
(setq fileName (strcat (vl-filename-base fullName) (vl-filename-extension fullName)))
(if (= nil ss1)
(progn
(setq fileList (cons fileName fileList))
(command "_image" "Detach" blkName)
(princ (strcat filename "在文档中已删除，因此被拆离！\n"))
)
(progn
(setq ss2 (vl-remove-if-not '(lambda (x) (= x fullName)) ss1))
(if (= nil ss2)
(progn
(setq fileList (cons fileName fileList))
(command "_image" "Detach" blkName)
(princ (strcat filename "在文档中已删除，因此被拆离！\n"))
)
)
)
)
)
(vl-sort fileList '<)
(if (/= nil fileList)
(princ (strcat "共拆离" (itoa (length fileList)) "张影像！\n"))
(princ "没有影像可以拆离！\n")
)
(princ)
)
(defun X:flists( / *fullName *fileName filelists)
(setq ss (ssget "X" '((0 . "IMAGE"))));;;全选所有光栅对象
(if (= nil ss);;;如果不存在
(setq filelists nil);;;没有对象，则返回nil
(progn
(setq i (sslength ss))
(while (< 0 i)
(setq ee (ssname ss (setq i (1- i))))
(setq vlaobj (vlax-ename->vla-object ee))
(setq *fullName (vla-get-ImageFile vlaobj))
;(setq *fileName (strcat (vl-filename-base *fullName) (vl-filename-extension *fullName)))
(setq filelists (cons *fullName filelists))
)
)
)
(vl-sort filelists '<);;;返回排序列表
)
;;;此函数来自晓东CAD
(defun XD::List:Nth++ (l s n)
(repeat (/ s 4) (setq l (cddddr l)))
(repeat (rem s 4) (setq l (cdr l)))
(setq s nil)
(if (and l n)
(cond ((>= n (length l)) l)
((< n (- (length l) n))
(repeat (/ n 4)
(setq s (cons (cadddr l)
(cons (caddr l) (cons (cadr l) (cons (car l) s)))
)
l (cddddr l)
)
)
(repeat (rem n 4)
(setq s (cons (car l) s)
l (cdr l)
)
)
(reverse s)
)
(t
(setq l (reverse l)
s (- (length l) n)
)
(repeat (/ s 4) (setq l (cddddr l)))
(repeat (rem s 4) (setq l (cdr l)))
(reverse l)
)
)
l
)
)
;;;此函数来自晓东CAD
(defun XD::LIST:Group-n ( l n / a b )
(while l
(repeat n
(setq a (cons (car l) a)
l (cdr l)
)
)
(setq b (cons (reverse a) b)
a nil
)
)
(reverse b)
)
谢谢分享 不用command 用vlisp 怎样写呢？
页:
[1]