[编程交流] 为所有la添加前缀或后缀

(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/Suffix] <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

;;  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)

 : ")</prefix></p>
<p>        str    (getstring "\nString to add <exit> : ")</exit></p>
<p>        ) ;_ end of setq</p>
<p>  (vla-startundomark adoc)</p>
<p>  (if (not answer)</p>
<p>    (setq answer "P")</p>
<p>    ) ;_ end of if</p>
<p>  (vlax-for item (vla-get-layers adoc)</p>
<p>    (vl-catch-all-apply</p>
<p>      'vla-put-name</p>
<p>      (list</p>
<p>        item</p>
<p>        (cond</p>
<p>          ((= answer "P")</p>
<p>           (strcat str (vla-get-name item))</p>
<p>           )</p>
<p>          (t</p>
<p>           (strcat (vla-get-name item) str)</p>
<p>           )</p>
<p>          ) ;_ end of cond</p>
<p>        ) ;_ end of list</p>
<p>      ) ;_ end of VL-CATCH-ALL-APPLY</p>
<p>    ) ;_ end of vlax-for</p>
<p>  (vla-endundomark adoc)</p>
<p>      )</p>
<p>      )</p>
<p>  (if(= ser1 "Single")</p>
<p>     (progn</p>
<p> </p>
<p>;;  Use these to change the string</p>
<p>(defun c:ChgPrefix ()</p>
<p>  (while</p>
<p>    (progn</p>
<p>      (initget 1)</p>
<p>      (setq *prefix (getstring t "\nEnter the prefix: "))</p>
<p>      (= "" *prefix)</p>
<p>    )</p>
<p>    (princ)</p>
<p>  )</p>
<p>)(defun c:ChgSuffix ()</p>
<p>  (while</p>
<p>    (progn</p>
<p>      (initget 1)</p>
<p>      (setq *suffix (getstring t "\nEnter the suffix: "))</p>
<p>      (= "" *suffix)</p>
<p>    )</p>
<p>  )</p>
<p>   (princ)</p>
<p>)</p>
<p> </p>
<p> </p>
<p>(defun LayerRename (pre / obj lyr newlyr str getlyr)</p>
<p>  (defun GetLayer (Obj)</p>
<p>    (vla-get-name (vla-item (vla-get-layers *doc*) (vla-get-layer Obj)))</p>
<p>  )</p>
<p>  (vl-load-com)</p>
<p>  (or *acad* (setq *acad* (vlax-get-acad-object)))</p>
<p>  (or *doc* (setq *doc* (vla-get-activedocument *acad*)))</p>
<p>  (if Pre</p>
<p>    (if (or (null *prefix) (= *prefix "")) (c:ChgPrefix))</p>
<p>    (if (or (null *suffix) (= *suffix "")) (c:ChgSuffix))</p>
<p>  )</p>
<p>  (if Pre</p>
<p>    (setq str *prefix)</p>
<p>    (setq str *suffix)</p>
<p>  )</p>
<p>  (while</p>
<p>    (setq ent (entsel "\nSelect an object to rename the layer."))</p>
<p>    (setq obj (vlax-ename->vla-object (car ent)))</p>
<p>    (cond</p>
<p>      ((wcmatch (setq lyr (getlayer obj)) "*|*")</p>
<p>       (prompt "\n**  Can not rename a xref layer.")</p>
<p>      )</p>
<p>      ((wcmatch lyr (strcat "*" str "*")) ; potential problems here</p>
<p>       ;;  if the layer name inadvertenlt has the matching string</p>
<p>       (prompt "\n**  This layer is already renamed.")</p>
<p>      )</p>
<p>      (t</p>
<p>       (if Pre (setq newlyr (strcat str lyr)) (setq newlyr (strcat lyr str)))</p>
<p>       (if (vl-catch-all-error-p</p>
<p>             (vl-catch-all-apply</p>
<p>               'vla-put-name</p>
<p>               (list (vla-item (vla-get-layers *doc*) (vla-get-layer Obj))</p>
<p>                     newlyr)))</p>
<p>         (prompt (strcat "\n**  Layer " lyr " could not be renamed."))</p>
<p>         (prompt (strcat "\nLayer " lyr " has been renamed."))</p>
<p>       )</p>
<p>      )</p>
<p>    )</p>
<p> </p>
<p>    )</p>
<p>  (princ)</p>
<p>)</p>
<p>       )</p>
<p>)</p>
<p>)</p>
<p>;;;;;;;;;;;;</p>
<p>any help will be a ppreciated</p>
                        
                 <p> </p>
<p>Hi gman,</p>
<p>test this code</p>
<p></p>
[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