Change Layers name if it contains some characters

[hanywillim]

Hi Friends, 
i am looking for a function to put in my main lisp to delete any of these characters ( ".", "&", "~") if it found in any layer name in DWG file (Keep the same name layer without these characters).
the lisp will work with most of version of CAD

Thanks in advance

[Kent1Cooper]

That should not be difficult, but would there ever already be a Layer with the new name?  That is, if there's a Layer called "MY.LAYER", is there ever the possibility that there's already a Layer called "MYLAYER", which would cause trouble, and should be checked for?  And if that might be possible, and such a Layer name conflict is found, what should the routine do to the older Layer name?

[hanywillim]

That is a good point actually , so we can replace each item in these characters with space i.e each "." will replace with " " and by this way i will be sure there is no duplicated name for any layers 

[Moshe-A · Accepted solution]

@hanywillim  hi,

Give this RENLAY command a try.

the following is on line 68

(setq CHAR2DEL '("." "&" "~")) ; const

A list contains the characters to be remove. if more characters is appear in layers name to be remove, add these characters to this list in the same manner.

Xref layers are ignored. e.g hanywillim|Layer1 is ignore, hany$0$Layer1 is fair game 😀

at end you will be reported how many layers were renamed.

enjoy,

Moshe

(vl-load-com) ; load activex support

(defun c:renlay (/ get_canonical_layers del_redun_char is_layer_renamed summarize ; local functions
		   adoc CHAR2DEL ctr orgName s)

 (defun get_canonical_layers (/ tbl lst lname) 
  (vl-remove-if
    'not
    (mapcar
      (function
        (lambda (s)
          (vl-some
	   (function
	     (lambda (ch)
              (if (vl-string-search ch s) s)
             ); lambda
	   ); function
           CHAR2DEL
          ); vl-some
        ); lambda
      ); function
      (progn
       (while (setq tbl (tblnext "layer" (not tbl)))
        (if (not (vl-string-search "|" (setq lname (cdr (assoc '2 tbl))))) ; xdep layer is skipped
         (setq lst (cons lname lst))
        ); if
       ); while
       lst
      ); progn
    ); mapcar
  ); vl-remove-if
 );  build_data 
  
 ; del redundant characters from layer name 
 (defun del_redun_char (wName nCh / eCh)
  (foreach eCh CHAR2DEL
   (while (vl-string-search eCh wName)
    (setq wName (vl-string-subst nCh eCh wName))
   )  
  ); foreach
  wName
 ); del_redun_char

 (defun is_layer_renamed (wName oName / ename elist)
  (if (not (tblobjname "layer" wName))
   (progn
    (setq elist (entget (tblobjname "layer" oName)))
    (setq wName (vl-string-right-trim " " (vl-string-left-trim " " wName)))
    (if (entmod (subst (cons '2 wName) (assoc '2 elist) elist)) wName)
   ); progn
  ); if
 ); is_layer_renamed

 (defun summarize ()
  (cond
   ((= ctr 0)
    (princ "\n0 layer(s) found to rename.")
   ); case
   ( t
    (princ (strcat "\n" (itoa ctr) " layer(s) successfully renamed."))
   ); case
  ); cond
 ); summarize

 ; here start c:renlay
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc)
 (setq CHAR2DEL '("." "&" "~")) ; const

 (setq ctr 0) 
 (foreach orgName (reverse (get_canonical_layers))
  (cond
   ((is_layer_renamed (del_redun_char orgName "") orgName)
    (setq ctr (1+ ctr))
   ); case
   ((setq s (is_layer_renamed (del_redun_char orgName " ") orgName))
    (setq ctr (1+ ctr))
    (princ (strcat "\nLayer \"" orgName "\" is renamed to \"" s "\"."))
   ); case 
   (t
    (princ (strcat "\nfail to rename layer \"" orgName "\"."))
   ); case
  ); cond
 ); foreach

 (summarize)

 (vla-endUndoMark adoc)
 (vlax-release-object adoc)

 (princ) 
); c:renlay

[_Tharwat]

Give this a shot and let me know.

(defun c:Test (/ key int lay old lyn tmp get)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (setq key "LAYER"
        grp '(46 38 126)
  )
  (while (setq lay (tblnext key (not lay)))
    (and (not (wcmatch (setq lyn (cdr (assoc 2 lay))) "*|*,0"))
         (vl-some (function (lambda (u) (vl-position u grp)))
                  (vl-string->list lyn)
         )
         (setq get (entget (tblobjname key lyn))
               old lyn
         )
         (progn
           (setq lyn (vl-list->string
                       (vl-remove-if
                         (function (lambda (u) (vl-position u grp)))
                         (vl-string->list lyn)
                       )
                     )
           )
           (and (tblsearch key lyn)
                (setq lyn (vl-list->string
                            (mapcar (function (lambda (u)
                                                (if (vl-position u grp)
                                                  32
                                                  u
                                                )
                                              )
                                    )
                                    (vl-string->list old)
                            )
                          )
                )
           )
           (setq int 0
                 tmp ""
           )
           (and (tblsearch key lyn)
                (or (while (tblsearch key
                                      (strcat lyn
                                              (setq tmp
                                                     (strcat tmp " (" (itoa (setq int (1+ int))) ")")
                                              )
                                      )
                           )
                    )
                    (setq lyn (strcat lyn tmp))
                )
           )
           (entmod (append get (list (cons 2 lyn))))
         )
    )
  )
  (princ)
) (vl-load-com)

[ronjonp]

And another:

(defun c:foo nil
  (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if	(wcmatch (vla-get-name l) "*`.*,*`&*,*`~*")
      (vl-catch-all-apply 'vla-put-name (list l (vl-string-translate ".&~" "   " (vla-get-name l))))
    )
  )
  (princ)
)

[hanywillim]

That is great , and it is working very well
But can  you update it to Unlock and Unfreeze all layer First in the beginning and then delete the specified characters ?

[Moshe-A]

@hanywillim  hi,

---

@hanywillim wrote:

That is great , and it is working very well
But can  you update it to Unlock and Unfreeze all layer First in the beginning and then delete the specified characters ?

---

i would not mix these two functions together. this is two different tasks (although in autolisp you could do anything 😀) if you want to keep things in order, unlocking\thawing should be put in another lisp.

why using layer properties manager is not convenient?

Moshe

(defun c:unlall ()
 (command "._layer" "_unlock" "*" "")
)

(defun c:thwall ()
 (command "._layer" "_thaw" "*" "")
)