;; ATTDEL.LSP for d2cad by John F. Uhden 01-17-17
;; Just select inserts. Those without attributes will be filtered out.
;; Actually, you can pick anything, but only inserts with attributes
;; will be selected.
;; Attributes on locked layers will report errors, but
;; the program will continue.
;; It does not change any block definition, but you could copy the
;; emasculated block insertions.
;;
(defun C:da ( / *error* err vars ss i obj atts m n)
(vl-load-com)
(defun *error* (err)
(mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
(vla-endundomark *doc*)
(cond
((not err))
((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
(1 (princ (strcat "\nERROR: " err)))
)
(princ)
)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
(mapcar '(lambda (x)(setvar (car x) 0)) vars)
(command "_.expert" (getvar "expert")) ;; dummy command
(and
(setq ss (ssget '((0 . "INSERT")(66 . 1))))
(setq i (sslength ss) n 0 m 0)
(while (> i 0)
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(setq atts (vla-getattributes obj))
(setq atts (vlax-variant-value atts))
(foreach att (vlax-safearray->list atts)
(setq m (1+ m))
(if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-delete (list att))))
(princ (strcat "\nERROR: " (vl-catch-all-error-message err)))
(setq n (1+ n))
)
)
)
)
(princ (strcat "\nDeleted " (itoa n) "/" (itoa m) " attributes."))
(*error* nil)
)
(c:da)

Advertisements