[求助]请求完善将所选实体层置为当前层后，实体层的颜色能否随层，谢谢！

cxs259

;;----------------------
;;将所选实体层置为当前层
;;----------------------
(defun c:cl (/ ent ent_data clay olay)
  (setq olay (getvar "clayer"))
  (setq ent (car (entsel (strcat "\n选择物体/当前层为<" olay ">:"))))
  (if (/= nil ent)
    (progn
      (setq ent_data (entget ent))
      (setq clay (cdr (assoc 8 ent_data)))
      (setvar "clayer" clay)
      (prompt (strcat "\n成功将图层设为<" clay ">："))
    )
  )
)

Andyhon

(setvar "Cecolor" "ByLayer")    ; add this line

cxs259

感谢Anhyhon，实体层的颜色是有红、黄、绿等颜色的，随层后，颜色也有红、黄、绿等颜色，不是单纯的白色，谢谢！

gufeng

2. ;;----------------------
3. ;;将所选实体层置为当前层
4. ;;----------------------
5. (defun c:cl (/ ent ent_data clay olay)
6.   (setq olay (getvar "clayer"))
7.   (setq ent (car (entsel (strcat "\n选择物体/当前层为<" olay ">:"))))
8.   (if (/= nil ent)
9.     (progn
10.       (setq ent_data (entget ent))
11.       (command "_change" ent "" "_p" "_color" "bylayer" "")
12.       (setq clay (cdr (assoc 8 ent_data)))
13.       (setvar "clayer" clay)
14.       (prompt (strcat "\n成功将图层设为<" clay ">："))
15.     )
16.   )
17. )

;;---------------------- ;;将所选实体层置为当前层 ;;---------------------- (defun c:cl (/ ent ent_data clay olay)   (setq olay (getvar "clayer"))   (setq ent (car (entsel (strcat "\n选择物体/当前层为<" olay ">:"))))   (if (/= nil ent)     (progn       (setq ent_data (entget ent))       (command "_change" ent "" "_p" "_color" "bylayer" "")       (setq clay (cdr (assoc 8 ent_data)))       (setvar "clayer" clay)       (prompt (strcat "\n成功将图层设为<" clay ">："))     )   ) )

块的改不了

caiqs

;;;用新的组码值替换原值
(defun dxfupd(ent dxfcode newval / elst newlst  )
  (setq elst(entget ent))

  (setq newlst(append elst (list (cons dxfcode newval))))

  (entmod newlst)
  (entupd ent))

 

 

(defun c:cl (/ ent ent_data clay olay e blkname blkref elst)
  (setq olay (getvar "clayer"))
  (setq ent (car (entsel (strcat "\n选择物体 (当前层为<" olay ">) :"))))
  (cond
;;;  (if ;|(/= nil ent)|;  ent
    ((not ent) (princ "\n")) ;_无效对象,静默退出
    (ent ;_有效对象
     (setq ent_data (entget ent))
     (setq conlst (assoc 8 ent_data)) ;_实体层关联表
     (setq clay (cdr conlst)) ;_所选实体所在的层名
     (setvar "clayer" clay) ;_设置当前层
     (dxfupd ent 62 256)
;;;     (entmod (subst (cons 62 256) (assoc 62 ent_data) ent_data))
;;;     (entupd ent)
     (if
       (equal "INSERT" (cdr (assoc 0 ent_data))) ;_块
 (progn
;;;   (entmod (subst conlst (assoc 8 ent_data) ent_data))
;;;   (entupd ent)
   (dxfupd ent 8 clay)
   (setq blkname (cdr (assoc 2 ent_data))) ;_块名
   (setq blkdef (tblsearch "block" blkname)) ;_块定义

   (setq e (cdr (assoc -2 blkdef))) ;_块中第一个图元
  
;;;   (setq elst (append (entget e) (list (cons 62 0)))) ;_块中第一个图元颜色随块
;;;(setq elst (append (entget e)(list (cons 62 256))));_块中第一个图元颜色随层
;;;   (entmod (subst (cons 62 0) (assoc 62 elst) elst))
;;;   (entupd e)

  
   (dxfupd e 62 0);_等效于上面的代码,随块
;;;   (dxfupd e 62 256);_颜色随层

   (while (and
     (setq e (entnext e))
     (setq elst (entget e))

     (/= (cdr (assoc 0 elst)) "SEQEND")
   )

;;;     (setq elst (append elst (list (cons 62 0)))) ;_块中图元颜色随块
;;;;;;  (setq elst (append elst (list (cons 62 256))))    ;_块中图元颜色随层
;;;     (entmod elst)
;;;     (entupd e)

    
      (dxfupd e 62 0);_等效于上面的代码,颜色随块
;;;     (dxfupd e 62 256);_颜色随层
   )
   (entupd ent)
 )
     )
    )
  )

(princ)

)

 

 

简单的写了一下,还有另一种方法用vl函数,也很方便,防错功能没有,自已改改吧

Aries

caiqs 发表于 2010-9-17 16:50
本帖最后由 作者 于 2010-9-18 7:15:31 编辑  ;;;用新的组码值替换原值(defun dxfupd(ent dxfcode newval  ...

收藏备用