为所有la添加前缀或后缀乐筑天下 - Powered by Discuz! Archiver

gman 发表于 2022-7-6 08:49:14

为所有la添加前缀或后缀

我想看看我可以使用什么命令将“Exist”添加到图形中的所有图层。

我理解基本的lisp命令，

谢谢

CarlB 发表于 2022-7-6 08:53:43

您可能可以使用“rename”命令来完成。在“重命名”对话框中，输入“*”作为旧层名称以应用于所有层，然后输入“前缀*”或“*后缀”作为新名称。

India 发表于 2022-7-6 08:57:53

我已经做了一个小VBA函数来做到这一点，但不知道如何上传到这里。它有一个表单和编码。
窗口如下所示
http://img147.imageshack.us/my.php?image=screenshotqm4.jpg

kpblc 发表于 2022-7-6 09:01:37

您也可以尝试以下方法：
(defun c:layrename (/ adoc str)
(vl-load-com)
(initget "Prefix Suffix _ P S")
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
answer (getkword "\nUse string like <Prefix> : ")
str (getstring "\nString to add <Exit> : ")
) ;_ end of setq
(vla-startundomark adoc)
(if (not answer)
(setq answer "P")
) ;_ end of if
(vlax-for item (vla-get-layers adoc)
(vl-catch-all-apply
'vla-put-name
(list
item
(cond
((= answer "P")
 (strcat str (vla-get-name item))
 )
(t
 (strcat (vla-get-name item) str)
 )
) ;_ end of cond
) ;_ end of list
) ;_ end of VL-CATCH-ALL-APPLY
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun

royalchill 发表于 2022-7-6 09:04:12

这是一个很好的惯例。你能做到你可以选择一个层或触摸和对象，只需将sufix默认为-extg或任何你想作为sufix的东西吗。我们正在使用aia标准，因此我们只需要添加一个-extg或-demo等的sufix。。

motee-z 发表于 2022-7-6 09:07:28

它是非常有用的lisp
但我认为，如果它能这样工作，它将更加有用和实用：
命令：选择图层（通过单击图形中的对象）
命令行中a层ppear的名称
然后单击另一个对象选择另一个图层
然后单击enter结束选择
命令：输入要添加到选定图层名称的后缀或前缀
然后所有选定层的名称都更改了
谢谢

royalchill 发表于 2022-7-6 09:09:21

这是我现在使用的，但它需要所有4个lisp例程。我有一种方法可以用宏或较短的lisp做同样的事情。我现在就是这样扣的。
^C^C（加载“NMELIST”）；（加载“NCLTLIST”）；（加载“ustr”）；（加载“layerextg”）^C^Clayrn；

例行程序1

;此例程将重命名图形中的所有图层
;前缀为用户选择的后缀默认值“_BAK”。
;帮助插入接地
;
;使用它的一种方法是从
;建筑师。复制所有实体

（defun c:layrn（）
（setq LsuffIX（ustr 1“Enter layer suffix”“-extg“nil））
（如果（非ncltlist）（加载“ncltlist”））
（setq文件（ncltlist）
外卖清单（汽车用品）
ENTS（cadr材料）
CNTR 0
)
（foreach LAYDAT LAYLIST（程序
（setq LAYNME2（strcat（car LAYDAT）LsufFIX））
（命令“layer”“m”LAYNME2“C”（cadr LAYDAT）“lt”（caddr LAYDAT）”“”）
（提示“-”）
)
)
（SETQ ALIS（SSGET））
（命令“CHANGE”ALIS““P”LT“hidden2”C“13”）
（重复（sslength ENTS）
（setq ENTDAT）
（subst
（缺点8
（strcat）
（cdr
（setq旧
（协会8）
（setq ENTDAT）
（entget）
（setq ENTNME）
（ssname ENTS CNTR）
)
)
)
)
)
)LsufFIX
)
)旧ENTDAT
)
)
（entmod ENTDAT）
（entupd ENTNME）
（setq CNTR（1+CNTR））
（提示“.”）
);重复
（普林斯）
)

例行程序2

;此例程列出所有（图层名称、颜色和线型）
;在选择中，PLUS返回表单中的选择集
;（（N C LT）（N C LT）…）（选择集）
;
;要检索选择集，请使用（cadr（ncltlist））
;
;
（defun ncltlist（）
（如果（非nmelist）（加载“nmelist”））
（setq STUFF（nmelist）
NCLT无
NLIST（汽车用品）
ss1（cdr材料）
)
（foreach LNAME NLIST（程序
（setq LDAT（tblsearch“layer”LNAME）
LCOLOR（cdr（ASSOC 62 LDAT））
LLTYPE（cdr（ASSOC 6 LDAT））
NCLT（CONS（list LNAME LCOLOR LLTYPE）NCLT）
)
)
)
（setq输出（cons NCLT ss1））
);德芬

例行程序3

;该例程列出了所有图层名称
;在选择中
（defun nmelist（）
（setq cntr 0
NLIST'（）
ss1（ssget）
)
（重复（sslength ss1）
（setq LYRNME（cdr（assoc 8（entget（ssname ss1 cntr 1070;））））
（如果（不是（成员LYRNME NLIST））
（setq NLIST（cons LYRNME NLIST））
)
（setq CNTR（1+CNTR））
);重复
（setq输出（list nlist ss1））
);德芬

例行程序4

;* USTR用户界面字符串
;* 如果位=1，则不允许输入null，0表示注释，如果存在DEF，则忽略位。
;* MSG是提示字符串，其中添加了一个默认字符串（nil）
;* 或“”表示无），并添加：号。如果SPFLAG T，则允许在
;* 一串
;*
（defun ustr（位msg def spflag/inp nval）
（如果（和def（/=def“”））
（setq msg（strcat“\n”msg”：）
inp（getstring msg spflag）
inp（if（=inp“”）def inp）
);setq公司
（程序
（setq msg（strcat“\n”msg”：）
（如果（=位1）
（while（=“”（setq inp（getstring msg spflag）））
（setq inp（getstring msg spflag））
) );编程和if
);如果
inp公司
);德芬
;*

CAB 发表于 2022-7-6 09:13:59

这里有一个游戏：
;;CAB 03.09.07
;;LayerRename.lsp
;;Rename selected layers with prefix or suffix
(defun c:Lprefix()
(LayerRename t)
)
(defun c:Lsuffix()
(LayerRename nil)
)
;;Use these to change the string
(defun c:ChgPrefix ()
(while
(progn
(initget 1)
(setq *prefix (getstring t "\nEnter the prefix: "))
(= "" *prefix)
)
(princ)
)
)(defun c:ChgSuffix ()
(while
(progn
(initget 1)
(setq *suffix (getstring t "\nEnter the suffix: "))
(= "" *suffix)
)
)
(princ)
)

(defun LayerRename (pre / obj lyr newlyr str getlyr)
(defun GetLayer (Obj)
(vla-get-name (vla-item (vla-get-layers *doc*) (vla-get-layer Obj)))
)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-activedocument *acad*)))
(if Pre
(if (or (null *prefix) (= *prefix "")) (c:ChgPrefix))
(if (or (null *suffix) (= *suffix "")) (c:ChgSuffix))
)
(if Pre
(setq str *prefix)
(setq str *suffix)
)
(while (setq ent (entsel "\nSelect an object to rename the layer."))
(setq obj (vlax-ename->vla-object (car ent)))
(cond
((wcmatch (setq lyr (getlayer obj)) "*|*")
   (prompt "\n**Can not rename a xref layer.")
)
((wcmatch lyr (strcat "*" str "*")) ; potential problems here
   ;;if the layer name inadvertenlt has the matching string
   (prompt "\n**This layer is already renamed.")
)
(t
   (if Pre (setq newlyr (strcat str lyr)) (setq newlyr (strcat lyr str)))
   (if (vl-catch-all-error-p
         (vl-catch-all-apply
         'vla-put-name
         (list (vla-item (vla-get-layers *doc*) (vla-get-layer Obj))
               newlyr)))
   (prompt (strcat "\n**Layer " lyr " could not be renamed."))
   (prompt (strcat "\nLayer " lyr " has been renamed."))
   )
)
)
)
(princ)
)
(prompt (strcat "\nLayer Rename loaded, Enter LaRn to run."
            "\nEnter ChgSuffix to change the siffix."))
(princ)

motee-z 发表于 2022-7-6 09:14:53

你很棒，卡布先生
我尝试将2个路由组合在一起，以选择重命名所有层，或通过在一个命令中选择对象来逐个重命名，但我失败了，我这样做了
密码
（定义c:chlrnm（/*前缀）
（setq txtstle（getvar“textstyle”））
（initget 1“多单”）
（setq ser1（getkword“多层或单层（Single）”）
（如果（非ser1）
（程序
（setq ser1“单”）
)
)
（如果（=ser1“多”）
（程序
（vl load com）
（initget“前缀后缀_PS”）
（setq adoc（vla get activedocument（vlax get acad object））
答案（getkword）“\n使用类似字符串[前缀/后缀] : ")</prefix>
 str (getstring "\nString to add <exit> : ")</exit>
 ) ;_ end of setq
(vla-startundomark adoc)
(if (not answer)
 (setq answer "P")
 ) ;_ end of if
(vlax-for item (vla-get-layers adoc)
 (vl-catch-all-apply
 'vla-put-name
 (list
 item
 (cond
 ((= answer "P")
 (strcat str (vla-get-name item))
 )
 (t
 (strcat (vla-get-name item) str)
 )
 ) ;_ end of cond
 ) ;_ end of list
 ) ;_ end of VL-CATCH-ALL-APPLY
 ) ;_ end of vlax-for
(vla-endundomark adoc)
 )
 )
(if(= ser1 "Single")
 (progn
 
;;Use these to change the string
(defun c:ChgPrefix ()
(while
 (progn
 (initget 1)
 (setq *prefix (getstring t "\nEnter the prefix: "))
 (= "" *prefix)
 )
 (princ)
)
)(defun c:ChgSuffix ()
(while
 (progn
 (initget 1)
 (setq *suffix (getstring t "\nEnter the suffix: "))
 (= "" *suffix)
 )
)
 (princ)
)
 
 
(defun LayerRename (pre / obj lyr newlyr str getlyr)
(defun GetLayer (Obj)
 (vla-get-name (vla-item (vla-get-layers *doc*) (vla-get-layer Obj)))
)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-activedocument *acad*)))
(if Pre
 (if (or (null *prefix) (= *prefix "")) (c:ChgPrefix))
 (if (or (null *suffix) (= *suffix "")) (c:ChgSuffix))
)
(if Pre
 (setq str *prefix)
 (setq str *suffix)
)
(while
 (setq ent (entsel "\nSelect an object to rename the layer."))
 (setq obj (vlax-ename->vla-object (car ent)))
 (cond
 ((wcmatch (setq lyr (getlayer obj)) "*|*")
 (prompt "\n**Can not rename a xref layer.")
 )
 ((wcmatch lyr (strcat "*" str "*")) ; potential problems here
 ;;if the layer name inadvertenlt has the matching string
 (prompt "\n**This layer is already renamed.")
 )
 (t
 (if Pre (setq newlyr (strcat str lyr)) (setq newlyr (strcat lyr str)))
 (if (vl-catch-all-error-p
 (vl-catch-all-apply
 'vla-put-name
 (list (vla-item (vla-get-layers *doc*) (vla-get-layer Obj))
 newlyr)))
 (prompt (strcat "\n**Layer " lyr " could not be renamed."))
 (prompt (strcat "\nLayer " lyr " has been renamed."))
 )
 )
 )
 
 )
(princ)
)
 )
)
)
;;;;;;;;;;;;
any help will be a ppreciated

 
Hi gman,
test this code


(defun table (s / d r) ; Michael Puckett
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)

(defun c:test (/ add lst xlay)
(setq lst (cdr (reverse (table "layer"))))
(setq add "Exist")
(foreach x lst
(setq xlay (strcat x " - " add))
(command "_rename" "layer" x xlay)
) ; foreach
(princ)
) ; defun

Adesu 发表于 2022-7-6 09:19:12

这很好，但我的目标是选择层，然后添加后缀。这个例程使所有后缀都存在。谢谢您的关注。

页: [1] 2

乐筑天下's Archiver

为所有la添加前缀或后缀