[求助]請問有否能將圖面的所有圖元之顏色都轉為Bycolor

lzu1797 · 发表于 2006-2-9 10:55

本帖最后由作者于 2006-2-10 13:14:56 编辑

r求助一下，工作上有需要

厂商要求所有物件(对象)的LAYER都不可以是Bylayer(还明文规定)

就是说所有的图元都要有各自的顏色(Bycolor)

有无此程序能一次转换呢？因为图量很大，谢谢

举个例：如果我把图面上的所有图层都改为白色

那Bycolor(即非Bylayer)的图元就会闻风不动还是保持他的顏色

只有Bylayer的图元会跟著变白色...

现在就是希望能一次转换让所有的图元都能自动套到相应的顏色里

多谢了

citykunan · 发表于 2006-2-9 11:04

这个问题很复杂，这里有一个bylayer的

;Good_将块block的实体不是BYLAYER的变成bylayer(lUCAS)(有嵌套块)
;嵌套块-----写一个递归的程序(很简单的) 8-)
;;By LUCAS
;;增加了嵌套图块
;;属性,引线,公差,尺寸....就留给你
(defun BLKBYLYR_LAI (BN COL / ENT NAME)
(vlax-for ENT
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
BN
)
(vla-put-color ENT COL)
(if (= (vla-get-objectname ENT) "AcDbBlockReference")
(BLKBYLYR_LAI (vla-get-name ENT) COL) ;递归
)
)
)
(defun C:xbl (/ E LST)
(if (and (setq E (car (entsel "\nSelect block: ")))
(setq COL (acad_colordlg 7))
)
(BLKBYLYR_LAI (cdr (assoc 2 (entget E))) COL)
)
(command "_.REGEN")
(princ)
)

xyp1964 · 发表于 2006-2-9 11:44

(defun c:test ()
(if (setq ss (ssget "X"))
(command "chprop" ss "" "co" "bylayer" "")
)
(princ)
)

lzu1797 · 发表于 2006-2-10 13:13

谢谢楼上两位大大了

我先试试看效果ㄛ

lzu1797 · 发表于 2006-2-10 13:23

三楼大大误会我的意思了

顏色是要「不可以bylayer」

每一个图元的顏色都能对应--该图层的顏色

meflying · 发表于 2006-2-10 17:19

(defun c:test( / ss i ent ents lay col)
(setq ss (ssget))
(setq i 0)
(repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq ents (entget ent))
    (setq lay (cdr (assoc 8 ents)))
    (setq col (cdr (assoc 62 (tblsearch "layer" lay))))
    (if (assoc 62 ents)
      (setq ents (subst (cons 62 col) (assoc 62 ents) ents))
      (setq ents (append ents (list (cons 62 col))))
    )
    (entmod ents)
    (setq i (1+ i))
)
(princ)
)

xyp1964 · 发表于 2006-2-10 22:33

确实没理解楼主的意思，修改编译文件：

TANER · 发表于 2006-2-17 13:25

本帖最后由作者于 2006-2-18 10:55:25 编辑

;;; ==================================================================
(defun test2 (/ i layercol layername layer-table ss)
(command "LAYER" "ON" " *" "T" "*" "U" "*" "")
(setq layer-table (th1-table "layer")
i -1
)
(while (setq layername (nth (1+ i) layer-table))
(setq layercol (th-get-laycolor (read layername)))
(if (setq ss (ssget "x" (list (cons 8 layername))))
(command "change" ss "" "p" "c" layercol "")
)
(setq i (1+ i))
)
(princ)
)
;;; ==================================================================
;;; 返回层的颜色
(defun th-get-laycolor (laname / la1 la col)
(setq la (cdr (assoc 2 (tblnext "layer" t))))
(if (/= la laname)
(setq la1 (tblnext "layer" nil)
la (cdr (assoc 2 la1))
col (cdr (assoc 62 la1))
)
(setq col (abs (cdr (assoc 62 la))))
)
(princ "\n颜色为 : ")
col
)
;;; ==================================================================
;;; 功能返回包含在指定符号表中的所有元素
;;; 参数一个符号表名称
(defun th1-table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
(vl-remove 'nil (acad_strlsort (reverse r)))
)
;;; ==================================================================

;;; ==================================================================
(defun test2 (/ i layercol layername layer-table ss)
  (command "LAYER" "ON" " *" "T" "*" "U" "*" "")
  (setq layer-table (th1-table "layer")
 i -1
  )
  (while (setq layername (nth (1+ i) layer-table))
    (setq layercol (th-get-laycolor (read layername)))
    (if (setq ss (ssget "x" (list (cons 8 layername))))
      (command "change" ss "" "p" "c" layercol "")
    )
    (setq i (1+ i))
  )
  (princ)
)
;;; ==================================================================
;;; 返回层的颜色
(defun th-get-laycolor (laname / la1 la col)
  (setq la (cdr (assoc 2 (tblnext "layer" t))))
  (if (/= la laname)
    (setq la1 (tblnext "layer" nil)
   la (cdr (assoc 2 la1))
   col (cdr (assoc 62 la1))
    )
    (setq col (abs (cdr (assoc 62 la))))
  )
  (princ "\n颜色为 : ")
  col
)
;;; ==================================================================
;;; 功  能  返回包含在指定符号表中的所有元素
;;; 参  数  一个符号表名称
(defun th1-table (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))
  )
  (vl-remove 'nil (acad_strlsort (reverse r)))
)
;;; ==================================================================

问各位大虾一个问题：
上面的程序运行后，改变了层的状态。有什么办法不改其状态或改变后再恢复？

TANER · 发表于 2006-2-18 11:22

；解决了上贴问题：
;;; ==================================================================
;;; argument: state
;;; 1 frozen
;;; 2 thawed
;;; 3 on
;;; 4 off
;;; 5 lock
;;; 6 not locked
;;; 7 plottable
;;; 8 not plottable
;;; example: (layer-state 1)
;;; return values: list of layers
(defun th-layer-state (state / typ names tf skip)
(setq names nil)
(vlax-for layer (vla-get-layers (vla-get-activedocument
(vlax-get-acad-object)
)
) (setq skip nil)
(cond
((= 1 state)
(setq typ (vla-get-freeze layer)
tf :vlax-true
)
)
((= 2 state)
(setq typ (vla-get-freeze layer)
tf :vlax-false
)
)
((= 3 state)
(setq typ (vla-get-layeron layer)
tf :vlax-true
)
)
((= 4 state)
(setq typ (vla-get-layeron layer)
tf :vlax-false
)
)
((= 5 state)
(setq typ (vla-get-lock layer)
tf :vlax-true
)
)
((= 6 state)
(setq typ (vla-get-lock layer)
tf :vlax-false
)
)
((= 7 state)
(setq typ (vla-get-plottable layer)
tf :vlax-true
)
)
((= 8 state)
(setq typ (vla-get-plottable layer)
tf :vlax-false
)
)
(t
(setq skip t)
)
) (if (and
(null skip)
(eq typ tf)
)
(setq names (cons (vla-get-name layer) names))
)
)
(reverse names)
)
;;; ==================================================================
(defun test1 (/ i layercol layername layer-table
layer-table5 ss
)
(setq layer-table (th1-table "layer")
layer-table5 (th-layer-state 5)
i -1
)
(while (setq layername (nth (1+ i) layer-table))
(setq layercol (th-get-laycolor (read layername)))
(if (member layername layer-table5)
(progn
(command "LAYER" "U" layername "")
(if (setq ss (ssget "x" (list (cons 8 layername))))
(command "change" ss "" "p" "c" layercol "")
)
(command "LAYER" "lo" layername "")
)
(if (setq ss (ssget "x" (list (cons 8 layername))))
(command "change" ss "" "p" "c" layercol "")
)
)
(setq i (1+ i))
)
(princ)
)

；解决了上贴问题：
 ;;; ==================================================================
;;; argument: state
;;; 1 frozen
;;; 2 thawed
;;; 3 on
;;; 4 off
;;; 5 lock
;;; 6 not locked
;;; 7 plottable
;;; 8 not plottable
;;; example: (layer-state 1)
;;; return values: list of layers
(defun th-layer-state (state / typ names tf skip)
  (setq names nil)
  (vlax-for layer (vla-get-layers (vla-get-activedocument
         (vlax-get-acad-object)
      )
    ) (setq skip nil)
     (cond
       ((= 1 state)
  (setq typ (vla-get-freeze layer)
        tf :vlax-true
  )
       )
       ((= 2 state)
  (setq typ (vla-get-freeze layer)
        tf :vlax-false
  )
       )
       ((= 3 state)
  (setq typ (vla-get-layeron layer)
        tf :vlax-true
  )
       )
       ((= 4 state)
  (setq typ (vla-get-layeron layer)
        tf :vlax-false
  )
       )
       ((= 5 state)
  (setq typ (vla-get-lock layer)
        tf :vlax-true
  )
       )
       ((= 6 state)
  (setq typ (vla-get-lock layer)
        tf :vlax-false
  )
       )
       ((= 7 state)
  (setq typ (vla-get-plottable layer)
        tf :vlax-true
  )
       )
       ((= 8 state)
  (setq typ (vla-get-plottable layer)
        tf :vlax-false
  )
       )
       (t
  (setq skip t)
       )
     ) (if (and
      (null skip)
      (eq typ tf)
    )
  (setq names (cons (vla-get-name layer) names))
       )
  )
  (reverse names)
)
;;; ==================================================================
(defun test1 (/ i layercol layername layer-table  
  layer-table5 ss
      )
  (setq layer-table (th1-table "layer")
 layer-table5 (th-layer-state 5)
 i -1
 
  )
  (while (setq layername (nth (1+ i) layer-table))
    (setq layercol (th-get-laycolor (read layername)))
    (if (member layername layer-table5)
      (progn
 (command "LAYER" "U" layername "")
 (if (setq ss (ssget "x" (list (cons 8 layername))))
   (command "change" ss "" "p" "c" layercol "")
 )
 (command "LAYER" "lo" layername "")
      )
      (if (setq ss (ssget "x" (list (cons 8 layername))))
 (command "change" ss "" "p" "c" layercol "")
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

龙龙仔 · 发表于 2006-2-18 12:25

账号		自动登录	找回密码
密码			注册

[求助]請問有否能將圖面的所有圖元之顏色都轉為Bycolor

本帖子中包含更多资源

本帖子中包含更多资源