创建层从其他存在的层复制属性

Lisphk

命令 test 拾取实体拷贝图层
命令 test1, 对话框选择复制的图层

(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)
;;;[url]http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=2&TID=47868&PAGEN_1=2[/url]
;;;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)

longer1000

啥也不说了，感谢楼主分享哇！

xvjiex

感谢分享创建层从其他存在的层复制属性