框选块内对象改为0层，如何颜色线型保持不变

chen7560152

请教下大侠们，如何框选一些块，使得块内对象改为0层，颜色线型可以保持不变，这样可以实现么，论坛里也搜到一些工具都是 可以改为0层的，不过块内的对象都直接变成0层的线型和颜色了，如果默认是固定颜色的有些可以实现，但是默认如果是bylayer的话，识别不了，都还是会变成白色了。

pxr201419

(prompt "将块中所有图元置于0层，保持原颜色和线型 tt")
(defun c:tt()
   (vl-load-com)
   (defun xc  (lst)
      (if lst
         (cons (car lst) (xc (vl-remove (car lst) lst)))))
   (defun getdata (ass)
      (cdr (assoc ass st)))
   (prompt "选择块")
   (setvar "nomutt" 1)
   (cond ((setq ss (ssget '((0 . "INSERT"))))
          (setvar "nomutt" 0)
          (setq i 0 blst '())
          (while (< i (sslength ss))
             (setq blst (cons (cdr (assoc 2 (entget (ssname ss i)))) blst)
                   i (1+ i)))
          (setq blst (xc blst));块名列表
          (setq layers '())
          (vlax-for x (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
             (setq layers (cons (mapcar 'cdr (vl-remove-if-not '(lambda(a)(member (car a) '(2 62 6)))
                                                        (entget (vlax-vla-object->ename x)))) layers)))
          (while blst
             (setq e (tblobjname "block" (car blst)))
             (while (setq e (entnext e))
                (setq st (entget e)
                      lay (getdata 8))
                (cond ((/= lay "0")
                       (setq st (subst '(8 . "0") (assoc 8 st) st))
                       (if (and (not (getdata 62)) (/= (cadr (assoc "0" layers)) (cadr (assoc lay layers))))
                          (setq st (append st (list (cons 62 (cadr (assoc lay layers)))))))
                       (if (and (not (getdata 6)) (/= (last (assoc "0" layers)) (last (assoc lay layers))))
                          (setq st (append st (list (cons 6 (last (assoc lay layers)))))))
                       (entmod st))))
             (setq blst (cdr blst)))
          (prompt "处理完毕"))
         (t (setvar "nomutt" 0)(prompt "没有选到块!")))
   (princ))

newer

设置前，得到层的颜色，保存， 设置后，设置下实体的颜色

chen7560152

newer 发表于 2020-7-27 16:19
设置前，得到层的颜色，保存， 设置后，设置下实体的颜色

大侠方便整一个么，不太会

yangjian001

做一个热心并受欢迎的人

chen7560152

pxr201419 发表于 2020-7-28 16:23
(prompt "将块中所有图元置于0层，保持原颜色和线型 tt")
(defun c:tt()
   (vl-load-com)

大侠我试了下非常好用，非常感激，可以增加支持属性块，还有普通图元的功能么