本帖最后由 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 0 xc (length xdictlist) xii 0 xnl nil xhl 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))
nob xii
)
)
(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)
(setq xi (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
(setq xnl (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)网友答:
谢谢分享,已经复制使用,好使
祝愿祖国繁荣昌盛
请朋友们看一下,这个程序如果修改成数字大于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 0 xc (length xdictlist) xii 0 xnl nil xhl 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))
nob xii
)
)
(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)
(setq xi (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
(setq xnl (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次,基本上能清理干净了。
; 对当前图形里的常规词典 ...
谢谢分享,已经复制使用,好使
祝愿祖国繁荣昌盛