求新建一个图层，并且这个图层颜色都跟已有图层颜色设置不一样

品茗新秀 · 发表于 2014-12-10 16:54

1.就是新建一个图层，并且图层颜色都跟已有颜色不一样
2.这个新建图层为当前层

图层名用户输入

vectra · 发表于 2014-12-10 16:54

(defun get-layer-colors (/ color colors layers)
(setq layers
(vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-for layer layers
(setq color (vla-get-color layer))
(if (not (member color colors))
(setq colors (cons color colors))
)
)
colors
)
(defun pick-unique-color (colors / color do)
(setq color 1
do t
)
(while do
(if (not (member color colors))
(setq do nil)
(setq color (1+ color))
)
)
color
)
(defun create-layer (name / color layer layers)
(setq layers (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
color (pick-unique-color (get-layer-colors))
)
(if (and
(<= color 255)
(/= (type (vl-catch-all-apply 'vla-item (list layers name)))
'vla-object
)
)
(progn
(setq layer (vla-add layers name))
(vla-put-color layer color)
layer
)
)
)
(defun c:tt (/ name)
(setq name (getstring "输入图层名称:"))
(if (null (create-layer name))
(princ "图层已存在或无独特颜色，未创建新图层。")
)
(princ)
)

(defun get-layer-colors        (/ color colors layers) 
  (setq        layers 
         (vla-get-layers 
           (vla-get-activedocument (vlax-get-acad-object)) 
         ) 
  ) 
 
  (vlax-for layer layers 
    (setq color (vla-get-color layer)) 
    (if        (not (member color colors)) 
      (setq colors (cons color colors)) 
    ) 
  ) 
  colors 
) 
 
 
(defun pick-unique-color (colors / color do) 
  (setq        color 1 
        do t 
  ) 
  (while do 
    (if        (not (member color colors)) 
      (setq do nil) 
      (setq color (1+ color)) 
    ) 
  ) 
  color 
) 
 
 
(defun create-layer (name / color layer layers) 
  (setq        layers (vla-get-layers 
                 (vla-get-activedocument (vlax-get-acad-object)) 
               ) 
        color  (pick-unique-color (get-layer-colors)) 
  ) 
  (if (and 
        (<= color 255) 
        (/= (type (vl-catch-all-apply 'vla-item (list layers name))) 
            'vla-object 
        ) 
      ) 
    (progn 
      (setq layer (vla-add layers name)) 
      (vla-put-color layer color) 
      layer 
    ) 
  ) 
) 
 
 
(defun c:tt (/ name) 
  (setq name (getstring "输入图层名称:")) 
  (if (null (create-layer name)) 
    (princ "图层已存在或无独特颜色，未创建新图层。") 
  ) 
  (princ) 
)

自贡黄明儒 · 发表于 2014-12-10 16:56

这个容易，你先查询已经使用过的颜色

品茗新秀 · 发表于 2014-12-10 17:34

自贡黄明儒发表于 2014-12-10 16:56
这个容易，你先查询已经使用过的颜色

就是程序能检查已使用的颜色，然后增加一个不一样的颜色，如果该颜色不满，就手动改一下

品茗新秀 · 发表于 2014-12-11 01:35

难的是跟已有颜色不一样，搞了半天几搞几来

mjz521yy · 发表于 2014-12-11 15:47

这个容易，你先查询已经使用过的颜色

llsheng_73 · 发表于 2014-12-11 17:21

本帖最后由 llsheng_73 于 2014-12-11 17:26 编辑

(defun c:tt(/ sll snl la co)
(Setq sll(TblNext"layer"T))
(While(SetQ snl(Cons(list(Cdr(Assoc 2 sll))(Cdr(Assoc 62 sll)))snl)sll(TblNext"layer"nil)))
(setq snl(list(mapcar'car snl)(mapcar'cadr snl))la""co 1)
(while(and(< co 256)(progn(while(tblsearch"layer"(setq la(getstring(if(<(length(car snl))8)(strcat"\n已有图层名["(apply'strcat(mapcar'(lambda(x)(strcat","x))(reverse(car snl))))"]:")
(strcat"\n上次图层名["(caar snl)"]:"))))(car snl))(alert(strcat"图层"la"已存在")))(/=""la))la)
(while(member co(last snl))(setq co(1+ co)))
(if(< co 257)
(progn(entmakex(list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 62 co)'(70 . 0)(cons 2 la)))
(setq snl(mapcar'(lambda(x y)(cons x y))(list la co)snl)))
(setq la"")))
)

品茗新秀 · 发表于 2014-12-11 22:00

llsheng_73 发表于 2014-12-11 17:21

你好，输入图层名后如何此图即为当前图层，我改了一下，跳不到当前图层

品茗新秀 · 发表于 2014-12-11 22:05

llsheng_73 发表于 2014-12-11 17:21

主要是不能将输入的图层为当前图层

品茗新秀 · 发表于 2014-12-11 23:37

我加了(setvar "clayer"怎么还没用

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

[提问] 求新建一个图层，并且这个图层颜色都跟已有图层颜色设置不一样

最佳答案

相关帖子

点评

评分

评分