社区 › Auto Lisp › 复制/重命名层

ajax30 发表于 2022-7-5 16:56:19

复制/重命名层

大家好，
 
我经常需要创建一个新层，该层与图形中已经存在的某个层具有相同的属性和/或以某种简单的方式重命名层。无需使用注释层道具管理器或重命名。只需在命令行中保持简单、干净和快速即可。
 
我的想法是，在选择一个实体后，您可以复制（创建具有相同属性的新层）或重命名选定实体的层。经过几次Lisp程序测试，我明白这超出了我的技能范围。。。
谁能帮帮我吗？
 
谢谢

Dadgad 发表于 2022-7-5 17:00:47

 
欢迎来到CADTutor。在LAYERS 2工具栏上有一些很棒的工具或命令。其中之一是COPYTOLAYER。您也可以在命令行中调用它。如果选择一个实体，该实体位于与新图层相同设置的图层上，并选择名称选项midcommand，则可以指定一个不存在的图层名称，在确认要使用该名称创建图层后，将创建该图层。

ajax30 发表于 2022-7-5 17:03:49

谢谢你的回复！问题是：COPYTOLAYER没有保持相同的属性（颜色、线型、线宽）。

eldon 发表于 2022-7-5 17:06:10

很抱歉，您不喜欢使用图层特性管理器，因为您想做的事情非常简单。
 
单击要复制的图层，然后单击“新建”。新层具有第一层的所有属性，只需要一个名称（或默认为Layer1）。

ajax30 发表于 2022-7-5 17:10:26

这是我每天努力避免的例行公事：）问题是，大多数时候我需要处理具有数千层的图形，而层道具管理器通常会减慢autocad的速度。所以我用的是老古典主义者。。。它似乎比图层道具管理器快得多

Dadgad 发表于 2022-7-5 17:14:47

将应用于正在创建的新图层的特性
指定新图层名称，
与当前层的相同，而不是与
从中复制实体的图层的。
 
正如eldon所指出的那样，在不需要图层特性管理器的情况下，首先确保当前图层
具有要应用于新层的特性。
如果你这样做，我相信你会发现所有的属性都是你想要的。

Tharwat 发表于 2022-7-5 17:16:13

这有什么帮助吗？
 
希望您的系统上安装了Express Tools，以享受选择集拖动模式功能
 

(defun c:Test (/ ss p1 p2 i sn lst l)
;;___ Tharwat 12. May. 2013 ___;;
(if
   (and
   (setq ss (ssget "_:L"))
   (setq p1 (getpoint "\n Specify base point :"))
   (setq p2 (acet-ss-drag-move ss p1 "\n Specify second point :"))
   (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (setq lst (cons (vla-copy (vlax-ename->vla-object sn)) lst))
   )
   )
    (progn
      (foreach e lst
      (vla-move e (vlax-3d-point p1) (vlax-3d-point p2))
      )
      (while
      (and (/= "" (setq l (getstring t "\n Specify New Layer Name :")))
             (snvalid l)
             (tblsearch "LAYER" l)
      )
         (princ
         "\n Unvalid name of layer or it's already existed ! TRY AGAIN "
         )
      )
      (if (not (tblsearch "LAYER" l))
      (progn
          (vla-add (vla-get-layers
                     (vla-get-activedocument (vlax-get-acad-object))
                   )
                   l
          )
          (foreach o lst (vla-put-layer o l))
      )
      )
    )
)
(princ "\n Written by Tharwat ...")
(princ)
)
(vl-load-com)

VVA 发表于 2022-7-5 17:19:03

可能是这个

        (defun ListBox (title msg keylab flag / tmp file dcl_id choice)
        ;; ListBox (gile)
        ;; Dialog box to choose one or more in a list
        ;;
        ;; Arguments
        ;; title : the dialog title (string)
        ;; msg ; message (string), "" or nil for none
        ;; keylab : an dotted pairs list of type ((key1 . label1) (key2 . label2) ...)
        ;; flag : 0 = popup list
        ;;      1 = single choice list box
        ;;      2 = multipe choices list box
        ;;
        ;; Return value : the choosen key (flag = 0 or 1) or the list of choosen keys (flag = 2)
        ;;
        ;; Using example
        ;; (listbox "Layout" "Choose a layout" (mapcar 'cons (layoutlist) (layoutlist)) 1)

        ;; create and open a temporay file
          (setq        tmp(vl-filename-mktemp "tmp.dcl")
                file (open tmp "w")
          )
                ;; write the file according to arguments
          (write-line
          (strcat "ListBox:dialog{label=\"" title "\";")
          file
          )
          (if (and msg (/= msg ""))
          (write-line (strcat ":text{label=\"" msg "\";}") file)
          )
          (write-line
          (cond
              ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
              ((= 1 flag) "spacer;:list_box{key=\"lst\";allow_accept = true;")
              (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
          )
          file
          )
          (write-line "}spacer;ok_cancel;}" file)
          (close file)
               
                ;; load the file and show the dialog
          (setq dcl_id (load_dialog tmp))
          (if (not (new_dialog "ListBox" dcl_id))
          (exit)
          )
          (start_list "lst")
          (mapcar 'add_list (mapcar 'cdr keylab))
          (end_list)
          (action_tile
          "accept"
          "(or (= (get_tile \"lst\") \"\")
          (if (= 2 flag) (progn
          (foreach n (str2lst (get_tile \"lst\") \" \")
          (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
          (setq choice (reverse choice)))
          (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
          (done_dialog)"
          )
          (start_dialog)
          (unload_dialog dcl_id)
          (vl-file-delete tmp)
          choice
        )
(defun make-copy-layer (New_Layer_Name Owner_Layer_Name / tmp )
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=2&TID=47868&PAGEN_1=2
;;;Functionh to create a copy of the layer
;;; New_Layer_Name - the name of the new layer
;;; Owner_Layer_Name - name of the copied layer
;;; Returns ename copy created layer or nil
;;; (Make-copy-layer "My new layer" "0")

(if (and (setq tmp (tblobjname "LAYER" Owner_Layer_Name))
          (setq tmp (entget tmp))
          (snvalid New_Layer_Name 0)
          (not (tblsearch "LAYER" New_Layer_Name))
          )
   (entmakex (subst (cons 2 New_Layer_Name)(assoc 2 tmp) tmp))
   )
)
;;;Written By Michael Puckett.
;;;(setq all_layers (tablelist "LAYER"))
(defun tablelist (s / d r)
   (while (setq d (tblnext s (null d)))
       (setq r (cons (cdr (assoc 2 d)) r))
   );_ while
   );_ defun
(defun c:test ( / e1 _l _n _nl )
(if
(setq e1 (entsel "\nPlease select a primitive copy of the layer you want to get <exit>: "))
(progn      
      (print (setq _l (cdr(assoc 8 (entget(car e1))))))
      (setq _nl (getstring t "\nNew layer name: "))
      (if (make-copy-layer_nl _l) (setvar "clayer" _nl))
))
);defun
(defun C:test1 ( / _nl _l )
(vl-load-com)
(and
(setq _l
(listbox "Layer" "Select exist layer"
   ((lambda(l)(mapcar 'cons l l))(vl-remove-if-not 'snvalid (tablelist "LAYER")))
   1
   )
)
(setq _nl (getstring t "\nNew layer name: "))
(snvalid _nl 0)
(if (make-copy-layer_nl _l) (setvar "clayer" _nl))
)
(princ)
)
(princ "\n type Test or Test1 in command line")(princ)

 
将图层特性从一个图层复制到另一个图层

ajax30 发表于 2022-7-5 17:22:17

达德加德，
对不起，你说得对！
 
塔尔瓦特，
谢谢，但新图层具有默认属性
 
VVA，
非常感谢。两者都很棒！！！

Lee Mac 发表于 2022-7-5 17:27:27

很好的解决方案VVA。

查看完整版本: 复制/重命名层