 ; Ka - empty all attributes in a block except those selected.
 ; Copyright 2011 by Rocket Software Ltd.
 ; 
 (DEFUN C:KA (/ tex entt atnam pa curent texlst next)
  (setvar "cmdecho" 0)
  (while (setq tex (nentsel "\nSelect Attributes: "))
         (if (= "ATTRIB" (cdr (assoc 0 (setq entt (entget (car tex))))))
             (progn
                  (setq atnam (cdr (assoc 2 entt)))
                  (setq pa (cadr tex))
                  (if (setq curent (ssget pa))
                      (progn
                          (setq curent (ssname curent 0))           
                          (if (and (= (cdr (assoc 0 (entget curent))) "INSERT")
                                   (not (member curent uplst))) 
                              (setq uplst (cons curent uplst))))) 
                  (princ atnam)
                  (setq texlst (append texlst (list atnam))))))
  (if (and texlst uplst)
      (while (setq enam (car uplst))
             (setq uplst (cdr uplst))
             (while (/= "SEQEND" (cdr (assoc 0 (setq entt (entget (setq enam
                                                          (entnext enam)))))))
                    (setq atnam (cdr (assoc 2 entt)))
                    (if (not (member atnam texlst))
                        (entmod (subst (cons 1 "") (assoc 41 entt) entt))))))
 (princ))