[求助]：跪求成批改图层名称的工具,

zkb · 发表于 2006-8-24 10:43:32

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

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

×

一百多个图层,我要每个前面加上一个前缀(专业名称),差点没疯掉.....前缀每个都是相同的.

yongren1982 · 发表于 2006-8-24 16:27:13

不合用自己改改,爱心币是要留下滴:D

zzsong · 发表于 2006-8-24 21:46:55

二楼能说说你的方法吗？我下载不了。

yongren1982 · 发表于 2006-8-25 10:25:20

再试:P

60910743 · 发表于 2006-8-25 18:01:05

我没有那么多的爱心币，太可惜了

yongren1982 · 发表于 2006-8-25 19:31:44

感谢版主.以下是修改过的源码,未经严格测试,慎用:D;字符大小写敏感

;; rnl(rename layers).lsp
;; Copyright (C) 2006 LSoft
;; 声明: 1.未经严格测试, 作者不对此程序的功能/稳定性/安全性等做任何保证,
;; 亦不对由于使用此程序所造成的任何损失负责.
;; 2.作者否认有关于此程序的任何隐含的声明或保证.
;; 3.任何人可免费拷贝/使用/修改本程序而不须作者授权, 但须保留此声明.
;; 4.未经作者授权, 不得将此程序用于此声明中未明示的任何用途.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; filename: rnl(rename layers).lsp
;; author: psyche
;; qq: 411453804
;; date: 2006/08/24
;; function: modtblname: modify symbol table records' name
;; modlyrname: modify layers' name
;; CheckKeyword: check string for key word
;; ModifyString: modify string
;; command: RNL: rename layers
;; RNS: rename symbol table records such as block, layer, et. al
;; RNLEX: rename layers EX
;; RNSEX: rename symbol table records EX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 函数: 修改符号表记录名, 调用rename命令
; symbol: 符号表类型
; 块(Block)
; 标注样式(Dimstyle)
; 图层(LAyer)
; 线型(LType)
; 文字样式(Style)
; UCS(Ucs)
; 视图(VIew)
; 视口(VPort))
(defun modtblname(symbol oldname newname)
(command "-rename" symbol oldname newname)
)
; 函数: 修改图层名
(defun modlyrname(oldname newname)
(setq lyr (tblobjname "layer" oldname))
(setq data (entget lyr))
(setq data (subst (cons 2 newname) (assoc 2 data) data))
(entmod data)
)
; 函数: 检索关键字 [psyche 2006/08/27]
(defun CheckKeyword(key string pos)
(setq keylen (strlen key))
(setq stringlen (strlen string))
(setq startpos 0)
(if (= pos "Tail") (setq startpos (- stringlen keylen)))
(setq index (vl-string-search key string startpos))
(cond
( (and (= index 0) (= pos "Head")) 0 )
( (and (= index (- stringlen keylen)) (= pos "Tail")) index)
( (and index (= pos "Any")) index )
( T nil )
)
)
; 函数: 修改字符串 [psyche 2006/08/27]
(defun ModifyString(oldstr key pos modstr mode)
(setq index (CheckKeyword key oldstr pos))
(if index
(cond
( (= mode "PRefix") (strcat modstr oldstr) )
( (= mode "POstfix") (strcat oldstr modstr) )
( (= mode "Replace") (vl-string-subst modstr key oldstr index) )
( T nil)
)
)
)
; 命令: 修改所有图层名
(defun C:RNL()
(setq prefix (getstring T "\n输入前缀: "))
(setq postfix (getstring T "\n输入后缀: "))
(if (and (null prefix) (null postfix))
(progn
(princ "*无任何可操作的修改*")
(exit)
)
)
(setq lyr0 (tblnext "layer" T))
(while (setq lyr (tblnext "layer"))
(setq oldname (cdr (assoc 2 lyr)))
(setq newname (strcat prefix oldname postfix))
(modlyrname oldname newname)
)
(gc)
(princ)
)
; 命令: 修改所有指定类型的符号表记录名
(defun C:RNS()
(initget "Block Dimstyle LAyer LType Style Ucs VIew VPort")
(setq symbol (getkword "\n输入要重命名的对象类型 [块(B)/标注样式(D)/图层(LA)/线型(LT)/文字样式(S)/UCS(U)/视图(VI)/视口
(VP)]: "))
(if (null symbol)
(exit)
)
(setq prefix (getstring T "\n输入前缀: "))
(setq postfix (getstring T "\n输入后缀: "))
(if (and (null prefix) (null postfix))
(progn
(princ "*无任何可操作的修改*")
(exit)
)
)
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq tbl (tblnext symbol T))
;(setq tbl (tblnext symbol))
(while tbl
(setq oldname (cdr (assoc 2 tbl)))
(setq newname (strcat prefix oldname postfix))
(vl-catch-all-apply 'modtblname (list symbol oldname newname))
(setq tbl (tblnext symbol))
)
(command "undo" "end")
(setvar "cmdecho" oce)
(gc)
(princ)
)
; 命令: RNL扩展 [psyche 2006/08/27]
(defun C:RNLEX()
(initget 0)
(setq key (getstring T "\n输入要修改图层的名称关键字: "))
(initget "Head Tail Any")
(setq pos (getkword "\n关键字位置 [头(H)/尾(T)/任意(A)] <任意>: "))
(if (not pos) (setq pos "Any"))
(initget "PRefix POstfix Replace")
(setq mode (getkword "\n修改方式 [加前缀(PR)/加后缀(PO)/替换(R)] <加前缀>: "))
(if (not mode) (setq mode "PRefix"))
(setq strprompt
(cond
( (= mode "PRefix") "前缀字符串: " )
( (= mode "POstfix") "后缀字符串: " )
( (= mode "Replace") "替换字符串: " )
)
)
(setq modstr (getstring T strprompt))
(if (not modstr) (setq modstr ""))
(setq lyr0 (tblnext "layer" T))
(while (setq lyr (tblnext "layer"))
(setq oldname (cdr (assoc 2 lyr)))
(setq newname (ModifyString oldname key pos modstr mode))
(if newname (modlyrname oldname newname))
)
(gc)
(princ)
)
; 命令: RNS扩展 [psyche 2006/08/27]
(defun C:RNSEX()
(initget "Block Dimstyle LAyer LType Style Ucs VIew VPort")
(setq symbol (getkword "\n输入要重命名的对象类型 [块(B)/标注样式(D)/图层(LA)/线型(LT)/文字样式(S)/UCS(U)/视图(VI)/视口
(VP)]: "))
(if (null symbol)
(exit)
)
(initget 0)
(setq key (getstring T "\n输入要修改的名称关键字: "))
(initget "Head Tail Any")
(setq pos (getkword "\n关键字位置 [头(H)/尾(T)/任意(A)] <任意>: "))
(if (not pos) (setq pos "Any"))
(initget "PRefix POstfix Replace")
(setq mode (getkword "\n修改方式 [加前缀(PR)/加后缀(PO)/替换(R)] <加前缀>: "))
(if (not mode) (setq mode "PRefix"))
(setq strprompt
(cond
( (= mode "PRefix") "前缀字符串: " )
( (= mode "POstfix") "后缀字符串: " )
( (= mode "Replace") "替换字符串: " )
)
)
(setq modstr (getstring T strprompt))
(if (not modstr) (setq modstr ""))
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq tbl (tblnext symbol T))
(while tbl
(setq oldname (cdr (assoc 2 tbl)))
(setq newname (ModifyString oldname key pos modstr mode))
(if newname (vl-catch-all-apply 'modtblname (list symbol oldname newname)))
(setq tbl (tblnext symbol))
)
(command "undo" "end")
(setvar "cmdecho" oce)
(gc)
(princ)
)

;; rnl(rename layers).lsp 
;; Copyright (C) 2006 LSoft 
;; 声明: 1.未经严格测试, 作者不对此程序的功能/稳定性/安全性等做任何保证, 
;;         亦不对由于使用此程序所造成的任何损失负责. 
;;       2.作者否认有关于此程序的任何隐含的声明或保证. 
;;       3.任何人可免费拷贝/使用/修改本程序而不须作者授权, 但须保留此声明. 
;;       4.未经作者授权, 不得将此程序用于此声明中未明示的任何用途. 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;      filename: rnl(rename layers).lsp 
;;        author: psyche 
;;            qq: 411453804 
;;          date: 2006/08/24 
;;      function:   modtblname: modify symbol table records' name 
;;                  modlyrname: modify layers' name 
;;                CheckKeyword: check string for key word 
;;                ModifyString: modify string 
;;         command:   RNL: rename layers 
;;                    RNS: rename symbol table records such as block, layer, et. al 
;;                RNLEX: rename layers EX 
;;                RNSEX: rename symbol table records EX 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
; 函数: 修改符号表记录名, 调用rename命令 
;       symbol: 符号表类型 
;                块(Block) 
;                标注样式(Dimstyle) 
;                图层(LAyer) 
;                线型(LType) 
;                文字样式(Style) 
;                UCS(Ucs) 
;                视图(VIew) 
;                视口(VPort)) 
(defun modtblname(symbol oldname newname) 
  (command "-rename" symbol oldname newname) 
  ) 
; 函数: 修改图层名 
(defun modlyrname(oldname newname) 
  (setq lyr (tblobjname "layer" oldname)) 
  (setq data (entget lyr)) 
  (setq data (subst (cons 2 newname) (assoc 2 data) data)) 
  (entmod data) 
  ) 
; 函数: 检索关键字 [psyche 2006/08/27] 
(defun CheckKeyword(key string pos) 
  (setq keylen (strlen key)) 
  (setq stringlen (strlen string)) 
  (setq startpos 0) 
  (if (= pos "Tail") (setq startpos (- stringlen keylen))) 
  (setq index (vl-string-search key string startpos)) 
  (cond 
    ( (and (= index 0) (= pos "Head")) 0 ) 
    ( (and (= index (- stringlen keylen)) (= pos "Tail")) index) 
    ( (and index (= pos "Any")) index ) 
    ( T nil ) 
    ) 
  ) 
; 函数: 修改字符串 [psyche 2006/08/27] 
(defun ModifyString(oldstr key pos modstr mode) 
  (setq index (CheckKeyword key oldstr pos)) 
  (if index 
    (cond 
      ( (= mode  "PRefix") (strcat modstr oldstr) ) 
      ( (= mode "POstfix") (strcat oldstr modstr) ) 
      ( (= mode "Replace") (vl-string-subst modstr key oldstr index) ) 
      ( T nil) 
      ) 
    ) 
  ) 
; 命令: 修改所有图层名 
(defun C:RNL() 
  (setq prefix  (getstring T "\n输入前缀: ")) 
  (setq postfix (getstring T "\n输入后缀: ")) 
  (if (and (null prefix) (null postfix)) 
    (progn 
      (princ "*无任何可操作的修改*") 
      (exit) 
      ) 
    ) 
   
  (setq lyr0 (tblnext "layer" T)) 
  (while (setq lyr  (tblnext "layer")) 
    (setq oldname (cdr (assoc 2 lyr))) 
    (setq newname (strcat prefix oldname postfix)) 
    (modlyrname oldname newname) 
    ) 
   
  (gc) 
  (princ) 
  ) 
; 命令: 修改所有指定类型的符号表记录名 
(defun C:RNS() 
  (initget "Block Dimstyle LAyer LType Style Ucs VIew VPort") 
  (setq symbol (getkword "\n输入要重命名的对象类型 [块(B)/标注样式(D)/图层(LA)/线型(LT)/文字样式(S)/UCS(U)/视图(VI)/视口 
 
(VP)]: ")) 
  (if (null symbol) 
    (exit) 
    ) 
 
  (setq prefix  (getstring T "\n输入前缀: ")) 
  (setq postfix (getstring T "\n输入后缀: ")) 
  (if (and (null prefix) (null postfix)) 
    (progn 
      (princ "*无任何可操作的修改*") 
      (exit) 
      ) 
    ) 
 
  (setq oce (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command "undo" "begin") 
 
  (setq tbl (tblnext symbol T)) 
  ;(setq tbl (tblnext symbol)) 
  (while tbl 
    (setq oldname (cdr (assoc 2 tbl))) 
    (setq newname (strcat prefix oldname postfix)) 
    (vl-catch-all-apply 'modtblname (list symbol oldname newname)) 
    (setq tbl (tblnext symbol)) 
    ) 
 
  (command "undo" "end") 
  (setvar "cmdecho" oce) 
 
  (gc) 
  (princ) 
  ) 
; 命令: RNL扩展 [psyche 2006/08/27] 
(defun C:RNLEX() 
  (initget 0) 
  (setq key (getstring T "\n输入要修改图层的名称关键字: ")) 
  (initget "Head Tail Any") 
  (setq pos (getkword "\n关键字位置 [头(H)/尾(T)/任意(A)] <任意>: ")) 
  (if (not pos) (setq pos "Any")) 
  (initget "PRefix POstfix Replace") 
  (setq mode (getkword "\n修改方式 [加前缀(PR)/加后缀(PO)/替换(R)] <加前缀>: ")) 
  (if (not mode) (setq mode "PRefix")) 
  (setq strprompt 
         (cond 
           ( (= mode "PRefix")  "前缀字符串: " ) 
           ( (= mode "POstfix") "后缀字符串: " ) 
           ( (= mode "Replace") "替换字符串: " ) 
           ) 
        ) 
  (setq modstr (getstring T strprompt)) 
  (if (not modstr) (setq modstr "")) 
 
  (setq lyr0 (tblnext "layer" T)) 
  (while (setq lyr (tblnext "layer")) 
    (setq oldname (cdr (assoc 2 lyr))) 
    (setq newname (ModifyString oldname key pos modstr mode)) 
    (if newname (modlyrname oldname newname)) 
    ) 
 
  (gc) 
  (princ) 
  ) 
; 命令: RNS扩展 [psyche 2006/08/27] 
(defun C:RNSEX() 
  (initget "Block Dimstyle LAyer LType Style Ucs VIew VPort") 
  (setq symbol (getkword "\n输入要重命名的对象类型 [块(B)/标注样式(D)/图层(LA)/线型(LT)/文字样式(S)/UCS(U)/视图(VI)/视口 
 
(VP)]: ")) 
  (if (null symbol) 
    (exit) 
    ) 
 
  (initget 0) 
  (setq key (getstring T "\n输入要修改的名称关键字: ")) 
  (initget "Head Tail Any") 
  (setq pos (getkword "\n关键字位置 [头(H)/尾(T)/任意(A)] <任意>: ")) 
  (if (not pos) (setq pos "Any")) 
  (initget "PRefix POstfix Replace") 
  (setq mode (getkword "\n修改方式 [加前缀(PR)/加后缀(PO)/替换(R)] <加前缀>: ")) 
  (if (not mode) (setq mode "PRefix")) 
  (setq strprompt 
         (cond 
           ( (= mode "PRefix")  "前缀字符串: " ) 
           ( (= mode "POstfix") "后缀字符串: " ) 
           ( (= mode "Replace") "替换字符串: " ) 
           ) 
        ) 
  (setq modstr (getstring T strprompt)) 
  (if (not modstr) (setq modstr "")) 
 
  (setq oce (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command "undo" "begin") 
 
  (setq tbl (tblnext symbol T)) 
  (while tbl 
    (setq oldname (cdr (assoc 2 tbl))) 
    (setq newname (ModifyString oldname key pos modstr mode)) 
    (if newname (vl-catch-all-apply 'modtblname (list symbol oldname newname))) 
    (setq tbl (tblnext symbol)) 
    ) 
 
  (command "undo" "end") 
  (setvar "cmdecho" oce) 
 
  (gc) 
  (princ) 
  )

水泥钉 · 发表于 2006-8-26 11:13:04

一、打开你要更改图层名称的文件
二、任选一个你要更改的图层名称用鼠标左键点一下（高亮显示）
三、再用鼠标左键点一下同一图层名称（进入重命名状态）
四、在合适的位置输入你要做的更改，并把它复制下来
五、重复上述二；三步，在合适的位置插入即可
说明：虽然不能一次改上百个，这样做却可以大大提高速度

zzsong · 发表于 2006-8-27 00:04:03

下了，试了一下。
楼主提供的功能也太强大了，有点过头了，若只想针对部分图层改名怎么办？
比如：
A-1
A-2
A-3
A-4
……
B-1
B-2
B-3
B-4
……
改成：
所有A图层前边加X，B图层前边加Y，……，？
我想这种情况还是常用的。

yongren1982 · 发表于 2006-8-27 14:22:27

fixed

flfuthpss · 发表于 2008-8-1 05:11:17

我也经常遇到这类事情，特别是一些外资公司。

yoyoho · 发表于 2008-8-2 11:24:39

好程序
功能真强大
很好的学习资料
感谢楼主

kmdz · 发表于 2008-8-3 22:18:52

非常感谢，值得学习。

zhengchuan1971 · 发表于 2008-8-7 15:42:24

非常感谢，值得学习。

xotoo · 发表于 2008-8-10 20:44:23

我不会编程，是小白，我在想可不可以继续实现下面的功能……
1、批量给图层名称前加图层名第一个汉字的拼音首字母，并大写——效果就是——程序运行后，如果检测到图层名第一个字是中文，就自动在图层名前加图层名第一个汉字的拼音首字母，并大写；如果检测到图层名是英文，就跳过图层名前加字母，但是继续检测英文图层名，如果图层名首字母是小写，自动更改为大写字母……
2、可以按指定字符数量（数目）批量删除图层名中的前面或者后面的字符数目——效果就是——程序运行后可以按指定数目（比如三个字符）批量删除图名名的前三个字符或者后三个字符（不区分大小写，并且英文和汉字都独立的算一个完整的字符）……

PS：上午发了一个帖子，结果编辑错误，现在也看不到内容，也不能进行编辑，麻烦版主看到帮忙删掉吧……那个需要删掉的帖子链接如下：http://www.xdcad.net/forum/showthread.php?s=&threadid=653539

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

[求助]：跪求成批改图层名称的工具,

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

相关帖子

成批更改图层名称