修改清理垃圾词典程序为自动运行
本帖最后由 nyistjz 于 2022-3-17 15:57 编辑请朋友们看一下，这个程序如果修改成数字大于1000时，怎么运行删除！
感谢
(dictremove (namedobjdict) "ACAD_DGNLINESTYLECOMP") 自己搞出来了！
;清理大数量的垃圾词典
(defun dicts>n (n / mygetcount xc xdictlist xdicts xi xlst xn xname)
(defun myGetCount (xdicts xname / errobj xitem)
(setq
xitem (vla-item xdicts xname)
errobj (vl-catch-all-apply 'vla-get-count (list xitem))
)
(if (vl-catch-all-error-p errobj) 000 errobj)
)
(setq xdicts (vla-get-dictionaries(vla-get-ActiveDocument(vlax-get-Acad-Object))))
(setq xdictlist (entget (namedobjdict)))
(setq xc (length xdictlist) )
(setq xi 0)
(while (< xi xc)
(setq xlst (nth xi xdictlist))
(setq xn (car xlst))
(and
(= xn 3)
(setq xname (cdr xlst))
(< n (myGetCount xdicts xname));数字大于1000的都是垃圾
(setq xlst (nth (1- xi) xdictlist))
(= (car xlst) 350)
(entdel (cdr xlst))
)
(setq xi (1+ xi))
)
)
(dicts>n 100);清理特定数量的垃圾词典
;清理全部词典
(defun dicts=all(/ xdictlist xi xlst)
(setq xdictlist (entget (namedobjdict)))
(setq xi 0)
(while (< xi (length xdictlist))
(setq xlst (nth xi xdictlist))
(if (= (car xlst) 350)(entdel (cdr xlst)))
(setq xi (1+ xi))
)
) 我改的增加两个参数比较大小，清理数字最大的。重新3次，基本上能清理干净了。
; 对当前图形里的常规词典进行列表
(defun C:dicts ( / xdoc xdicts xi xc xii xlst xname xnl xhl myGetCount )
(defun myGetCount ( xd xn / xitem errobj)
(setq xitem (vla-item xd xn)errobj (vl-catch-all-apply 'vla-get-count (list xitem)))
(if (vl-catch-all-error-p errobj)
"0"
(itoa errobj)
)
); end of myerr()
(vl-load-com)
(setq xdoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
xdicts (vla-get-dictionaries xdoc)
xdictlist (entget (namedobjdict))
xi 0xc (length xdictlist)xii 0xnl nilxhl nil nob 0 n 0
)
(repeat 3
(while (< xi xc); 对于xdictlist中的每个元素，字典列表
(if (= (car (setq xlst (nth xi xdictlist))) 3)
(progn
(setq xii (1+ xii)xi (1+ xi))
(princ (strcat (itoa xii) ". \"" (setq xname (cdr xlst)) "\""(myGetCount xdicts xname) "\n"))
(if (> (atoi (myGetCount xdicts xname)) n)
(setq n (atoi (myGetCount xdicts xname))
nobxii
)
)
(setq xnl (cons xname xnl)xhl (cons (cdr (nth xi xdictlist)) xhl))
); end of progn(it's a dictionary item)
); end of if(it's a dictionary item)
(setqxi (1+ xi))
); end of while(each element in dictionary list)
(princ (strcat "\nActiveDocument.Dictionaries.Count=" (itoa (vla-get-count xdicts)) "\n"))
(initget 6); no zero or negative value allowed
(setqxnl (reverse xnl)xhl (reverse xhl))
(if (and nob (<= nob xii)) (entdel (nth (1- nob) xhl)))
(princ (strcat "刚才清理的行数为:" (itoa nob)))
)
(vla-PurgeAll xdoc)
(vla-Save xdoc)
(princ "\nYou can type command of DICTS to go again.")
(princ)
); end of (C:dicts) 哆啦A梦_oELxg 发表于 2022-8-24 23:23
我改的增加两个参数比较大小，清理数字最大的。重新3次，基本上能清理干净了。
; 对当前图形里的常规词典 ...
谢谢分享，已经复制使用，好使
祝愿祖国繁荣昌盛
页:
[1]