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

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


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

图层名用户输入

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

(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:17

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

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

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

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

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

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

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

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

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

本帖最后由 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:12

llsheng_73 发表于 2014-12-11 17:21 static/image/common/back.gif


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

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

llsheng_73 发表于 2014-12-11 17:21 static/image/common/back.gif


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

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

我加了(setvar "clayer"怎么还没用
页: [1] 2
查看完整版本: 求新建一个图层，并且这个图层颜色都跟已有图层颜色设置不一样