删除你点选类型的所有对象

纯文本，没有任何隐藏内容。复制后存成名为 cxdeltype.lsp 的文件，或直接下载。

;;; ============================================================================
;;; CXDELTYPE - Delete every object of the type you pick
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxdeltype
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; Erase every entity of type TYPE (a DXF name such as "HATCH") in the current space. With LAYER, only those on
;; that layer. Returns how many were erased.
(defun cx:deltype-run (type layer / filter ss n i)
  (setq filter (list (cons 0 type) (cons 410 (getvar "CTAB"))))
  (if layer (setq filter (cons (cons 8 layer) filter)))
  (setq n 0)
  (if (setq ss (ssget "X" filter))
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (if (entdel (ssname ss i)) (setq n (1+ n)))
        (setq i (1+ i)))))
  n)

(defun c:CXDELTYPE ( / *error* cx:sv pick ed scope n)
  (setq *error* cx:err)
  (if (setq pick (car (entsel "\nSelect an object of the type to delete: ")))
    (progn
      (setq ed (entget pick))
      (setq scope (cx:ask-kw (strcat "Delete every " (cdr (assoc 0 ed)) " on") "All ThisLayer" "All"))
      (cx:start '(("CMDECHO" . 0)))
      (setq n (cx:deltype-run (cdr (assoc 0 ed)) (if (= scope "All") nil (cdr (assoc 8 ed)))))
      (princ (strcat "\n" (itoa n) " " (cdr (assoc 0 ed)) " object(s) deleted."))
      (cx:end)))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

(princ "\nCXDELTYPE loaded. Type CXDELTYPE to start.")
(princ)

更多命令：清理

• CXBYLAYER把颜色、线型和线宽恢复为 ByLayer
• CXZEROLEN找出并删除零长度的直线和多段线
• CXEMPTYTXT找出并删除空文字
• CXFONTCHK列出字体文件缺失的文字样式
• CXFONTSUB在所有文字样式里把一个字体文件换成另一个
• CXPURGE反复清理图形，直到没有可清的内容
• CXDIMRESET把手改过的标注文字恢复成测量值
• CXDUPDEL删除完全重复的对象
• CXOBJCOUNT按类型统计对象数量