修改层名的几种方法

newer · 发表于 2016-9-8 08:05:00

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;VLISP方法[it618postdisplay>0]

;;VLISP方法
(defun c:tt (/ lay layn layname)
(if (and
(setq e (car (entsel "\nSelect an object to change the LayerName: ")))
(setq layname (cdr (assoc 8 (entget e))))
(/= (setq newlayname (getstring "\n新的层名<退出>"))
""
)
)
(progn
(vlax-for lay (vla-get-layers (vla-get-activedocument
(vlax-get-acad-object)
)
) (setq layn (vla-get-name lay))
(if (and
(wcmatch layn layname)
(/= layn "0")
(/= layn "Defpoints")
) ; and
(vla-put-name lay newlayname)
) ; if
) ; vlax-for
) ; progn
) ; if
(princ)
)

;;VLISP方法 
 
(defun c:tt (/ lay layn layname) 
  (if (and 
        (setq e (car (entsel "\nSelect an object to change the LayerName: "))) 
        (setq layname (cdr (assoc 8 (entget e)))) 
        (/= (setq newlayname (getstring "\n新的层名<退出>")) 
            "" 
        ) 
      ) 
    (progn 
      (vlax-for lay (vla-get-layers (vla-get-activedocument 
                                                            (vlax-get-acad-object) 
                                    ) 
                    ) (setq layn (vla-get-name lay)) 
                (if (and 
                      (wcmatch layn layname) 
                      (/= layn "0") 
                      (/= layn "Defpoints") 
                    )                       ; and 
                  (vla-put-name lay newlayname) 
                )                       ; if 
      )                                       ; vlax-for 
    )                                       ; progn 
  )                                       ; if 
  (princ) 
)

[/it618postdisplay]

;;; test
;;命令方法
(defun c:tt (/ layname)
(if (and
(setq e (car (entsel "\nSelect an object to change the LayerName: ")))
(setq layname (cdr (assoc 8 (entget e))))
(/= layname "0")
(/= layname "Defpoints")
(/= (setq newlayname (getstring "\n新的层名<退出>"))
""
)
) ; and
(command "._rename" "_Layer" layname newlayname)
) ; if
(princ)
)
;;; test
;;AUTOLISP 方法
(defun c:tt (/ layname)
(if (and
(setq e (car (entsel "\nSelect an object to change the LayerName: ")))
(setq layname (cdr (assoc 8 (entget e))))
(/= layname "0")
(/= layname "Defpoints")
(/= (setq newlayname (getstring "\n新的层名<退出>"))
""
)
) ; and
(progn
(setq obj (tblobjname "layer" layname)
ed (entget obj)
)
(entmod (subst
(cons 2 newlayname)
(assoc 2 ed)
ed
)
)
)
) ; if
(princ)
)
;;; test
;;;ARX 方法
(defun c:tt (/ layname)
(if (and
(setq e (car (entsel "\nSelect an object to change the LayerName: ")))
(setq layname (car (xdrx_getpropertyvalue e "layer")))
(/= layname "0")
(/= layname "Defpoints")
(/= (setq newlayname (getstring "\n新的层名<退出>"))
""
)
) ; and
(progn
(xdrx_setpropertyvalue e "layer" newlayname)
)
) ; if
(princ)
)
;;;ADS 方法
(defun c:tt (/ layname)
(if (and
(setq e (car (entsel "\nSelect an object to change the LayerName: ")))
(setq layname (xdrx_getpropertyvalue e "layer"))
(/= (car layname) "0")
(/= (car layname) "Defpoints")
(/= (setq newlayname (getstring "\n新的层名<退出>"))
""
)
) ; and
(progn
(xdrx_setenttodb (cadr layname))
(xdrx_modent 2 newlayname)
)
) ; if
(princ)
)

;;; test 
;;命令方法 
(defun c:tt (/ layname) 
  (if (and 
        (setq e (car (entsel "\nSelect an object to change the LayerName: "))) 
        (setq layname (cdr (assoc 8 (entget e)))) 
        (/= layname "0") 
        (/= layname "Defpoints") 
        (/= (setq newlayname (getstring "\n新的层名<退出>")) 
            "" 
        ) 
      )                                       ; and 
    (command "._rename" "_Layer" layname newlayname) 
  )                                       ; if 
  (princ) 
) 
;;; test 
;;AUTOLISP 方法 
(defun c:tt (/ layname) 
  (if (and 
        (setq e (car (entsel "\nSelect an object to change the LayerName: "))) 
        (setq layname (cdr (assoc 8 (entget e)))) 
        (/= layname "0") 
        (/= layname "Defpoints") 
        (/= (setq newlayname (getstring "\n新的层名<退出>")) 
            "" 
        ) 
      )                                       ; and 
    (progn 
      (setq obj (tblobjname "layer" layname) 
            ed (entget obj) 
      ) 
      (entmod (subst 
                (cons 2 newlayname) 
                (assoc 2 ed) 
                ed 
              ) 
      ) 
    ) 
  )                                       ; if 
  (princ) 
) 
;;; test 
;;;ARX 方法 
(defun c:tt (/ layname) 
  (if (and 
        (setq e (car (entsel "\nSelect an object to change the LayerName: "))) 
        (setq layname (car (xdrx_getpropertyvalue e "layer"))) 
        (/= layname "0") 
        (/= layname "Defpoints") 
        (/= (setq newlayname (getstring "\n新的层名<退出>")) 
            "" 
        ) 
      )                                       ; and 
    (progn 
      (xdrx_setpropertyvalue e "layer" newlayname) 
    ) 
  )                                       ; if 
  (princ) 
) 
;;;ADS 方法 
(defun c:tt (/ layname) 
  (if (and 
        (setq e (car (entsel "\nSelect an object to change the LayerName: "))) 
        (setq layname (xdrx_getpropertyvalue e "layer")) 
        (/= (car layname) "0") 
        (/= (car layname) "Defpoints") 
        (/= (setq newlayname (getstring "\n新的层名<退出>")) 
            "" 
        ) 
      )                                       ; and 
    (progn 
      (xdrx_setenttodb (cadr layname)) 
      (xdrx_modent 2 newlayname) 
    ) 
  )                                       ; if 
  (princ) 
)

819534890 · 发表于 2016-9-8 10:08:07

回复又学习

lengliqun · 发表于 2016-10-10 17:22:05

回复又学习

sicky111 · 发表于 2016-10-10 20:46:00

学习了。

凌乱一夏 · 发表于 2016-10-24 23:26:31

正需要这段代码

yoyoho · 发表于 2016-10-25 07:46:30

回帖学习程序。

duan1980 · 发表于 2016-10-25 07:57:39

学习了!!

qht5566 · 发表于 2016-11-19 13:42:34

有时候用得到，谢谢

sachindkini · 发表于 2016-11-19 13:58:52

nice tool .....

zz159504 · 发表于 2017-3-19 20:15:42

回帖学习程序

winerfjy · 发表于 2017-3-25 14:59:27

楼主的贴本人实在受益匪浅啊

defun · 发表于 2017-5-15 14:06:00

回帖学习程序

liulisheng · 发表于 2018-2-8 09:39:47

必须顶一下

zyclyl · 发表于 2018-2-8 10:38:59

看看都是怎么做

xdcad9819 · 发表于 2020-5-4 08:25:10

修改层名的几种方法

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

[每日一码] 修改层名的几种方法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。