선택한 종류의 객체 모두 삭제

숨겨진 부분이 없는 일반 텍스트입니다. 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길이가 0인 선과 폴리선 찾아 삭제
• CXEMPTYTXT빈 문자 찾아 삭제
• CXFONTCHK글꼴 파일이 없는 문자 스타일 목록
• CXFONTSUB모든 문자 스타일의 글꼴 파일 교체
• CXPURGE더 지울 것이 없을 때까지 도면 정리
• CXDIMRESET직접 고친 치수 문자를 측정값으로 되돌리기
• CXDUPDEL완전히 중복된 객체 삭제
• CXOBJCOUNT객체를 종류별로 세기