[转贴]：Kill null text/mtext/attrib,zerop line...

eachy · 发表于 2004-12-16 19:43:55

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

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

×

;; KILLDOTS.LSP
;; (c)1998, John F. Uhden, CADvantage
;; This utility (for R12-R14) aims to delete all single-vertex
;; polylines, zero-length lines/polylines, and text with nothing
;; but spaces from a drawing.
;; ENJOY, or else!
;; NOTE: It wasn't written to handle locked layers.
;;
;;null-text modifications, ATTDEF/CIRCLE/ARC and other enhancements by V.Michl, [url]www.xanadu.cz[/url]
(defun c:KILLDOTS (/ ss i n fuzz e0 e ent dxflist data bad p)
(defun dxflist (in dxf / memb out)
(while (not (atom in))
(if (and (not (atom (setq memb (car in))))
(= (car memb) dxf)
)
(setq out (cons (cdr memb) out))
)
(setq in (cdr in))
)
(reverse out)
)
(setq i 0.0
n 0.0
fuzz 1e-11
)
(princ "\n")
(if (setq
ss (ssget
"_X"
'((0 . "LINE,LWPOLYLINE,POLYLINE,TEXT,MTEXT,ATTDEF,CIRCLE,ARC"))
)
)
(while (< i (sslength ss))
(prompt (strcat "\rProcessing # " (rtos (1+ i) 2 0)))
(setq e0 (ssname ss i)
ent (entget e0)
obj (cdr (assoc 0 ent))
i (1+ i)
)
(cond
((= obj "LINE")
(setq
bad (equal (cdr (assoc 10 ent)) (cdr (assoc 11 ent)) fuzz)
)
)
((= obj "LWPOLYLINE")
(setq bad (and (= (length (setq data (dxflist ent 10))) 2)
(equal (car data) (cadr data) fuzz)
)
)
)
((= obj "POLYLINE")
(setq e (entnext e0)
ent (entget e)
p (cdr (assoc 10 ent))
bad 1
)
(while (and bad (= (cdr (assoc 0 ent)) "VERTEX"))
(setq bad (equal (cdr (assoc 10 ent)) p fuzz)
e (entnext e)
ent (entget e)
)
)
)
((= obj "CIRCLE")
(setq bad (equal (cdr (assoc 40 ent)) 0.0 fuzz))
)
((= obj "ARC")
(setq bad
(or (equal (cdr (assoc 40 ent)) 0.0 fuzz)
(equal (cdr (assoc 50 ent)) (cdr (assoc 51 ent)) fuzz)
)
)
)
((= obj "ATTDEF")
(setq bad (or (= (cdr (assoc 2 ent)) "")
(wcmatch (cdr (assoc 2 ent)) " ")
)
)
)
((or (= obj "TEXT") (= obj "MTEXT"))
(setq bad (or (= (cdr (assoc 1 ent)) "")
(wcmatch (cdr (assoc 1 ent)) " ")
)
) ; thanks to Steve Johnson
)
)
(if bad
(progn (entdel e0) (setq n (1+ n)))
)
)
(prompt "No candidate objects found.")
)
(if ss
(prompt (strcat "\nDeleted " (rtos n 2 0) " "DOTS""))
)
(princ)
)

;; KILLDOTS.LSP 
;; (c)1998, John F. Uhden, CADvantage 
;; This utility (for R12-R14) aims to delete all single-vertex 
;; polylines, zero-length lines/polylines, and text with nothing 
;; but spaces from a drawing. 
;; ENJOY, or else! 
;; NOTE: It wasn't written to handle locked layers. 
;; 
;;null-text modifications, ATTDEF/CIRCLE/ARC and other enhancements by V.Michl, [url]www.xanadu.cz[/url] 
 
(defun c:KILLDOTS (/ ss i n fuzz e0 e ent dxflist data bad p) 
  (defun dxflist (in dxf / memb out) 
    (while (not (atom in)) 
      (if (and (not (atom (setq memb (car in)))) 
               (= (car memb) dxf) 
          ) 
        (setq out (cons (cdr memb) out)) 
      ) 
      (setq in (cdr in)) 
    ) 
    (reverse out) 
  ) 
  (setq        i    0.0 
        n    0.0 
        fuzz 1e-11 
  ) 
  (princ "\n") 
  (if (setq 
        ss (ssget 
             "_X" 
             '((0 . "LINE,LWPOLYLINE,POLYLINE,TEXT,MTEXT,ATTDEF,CIRCLE,ARC")) 
           ) 
      ) 
    (while (
      (prompt (strcat "\rProcessing # " (rtos (1+ i) 2 0))) 
      (setq e0        (ssname ss i) 
            ent        (entget e0) 
            obj        (cdr (assoc 0 ent)) 
            i        (1+ i) 
      ) 
      (cond 
        ((= obj "LINE") 
         (setq 
           bad (equal (cdr (assoc 10 ent)) (cdr (assoc 11 ent)) fuzz) 
         ) 
        ) 
        ((= obj "LWPOLYLINE") 
         (setq bad (and        (= (length (setq data (dxflist ent 10))) 2) 
                        (equal (car data) (cadr data) fuzz) 
                   ) 
         ) 
        ) 
        ((= obj "POLYLINE") 
         (setq e   (entnext e0) 
               ent (entget e) 
               p   (cdr (assoc 10 ent)) 
               bad 1 
         ) 
         (while        (and bad (= (cdr (assoc 0 ent)) "VERTEX")) 
           (setq bad (equal (cdr (assoc 10 ent)) p fuzz) 
                 e   (entnext e) 
                 ent (entget e) 
           ) 
         ) 
        ) 
        ((= obj "CIRCLE") 
         (setq bad (equal (cdr (assoc 40 ent)) 0.0 fuzz)) 
        ) 
        ((= obj "ARC") 
         (setq bad 
                (or (equal (cdr (assoc 40 ent)) 0.0 fuzz) 
                    (equal (cdr (assoc 50 ent)) (cdr (assoc 51 ent)) fuzz) 
                ) 
         ) 
        ) 
        ((= obj "ATTDEF") 
         (setq bad (or (= (cdr (assoc 2 ent)) "") 
                       (wcmatch (cdr (assoc 2 ent)) " ") 
                   ) 
         ) 
        ) 
        ((or (= obj "TEXT") (= obj "MTEXT")) 
         (setq bad (or (= (cdr (assoc 1 ent)) "") 
                       (wcmatch (cdr (assoc 1 ent)) " ") 
                   ) 
         )                                ; thanks to Steve Johnson 
        ) 
      ) 
      (if bad 
        (progn (entdel e0) (setq n (1+ n))) 
      ) 
    ) 
    (prompt "No candidate objects found.") 
  ) 
  (if ss 
    (prompt (strcat "\nDeleted " (rtos n 2 0) " "DOTS"")) 
  ) 
  (princ) 
)

andyhua5240 · 发表于 2004-12-17 13:24:46

斑竹，恕小弟愚笨：
不知道程序是干什么用的？试了好半天也试不出个结果来？
谢谢！

snsj · 发表于 2004-12-17 15:46:47

Kill null text/mtext/attrib,zerop line...
清楚空文字，零长度线段。。。。

xjlmlxbq · 发表于 2004-12-20 09:55:11

不知道在什么地方用?

qiaqiadeng · 发表于 2006-7-4 14:02:23

好，我把他同purge放在一起，就可以为文件瘦身了。

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

[转贴]：Kill null text/mtext/attrib,zerop line...

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

相关帖子