Bind Prefixe

[jjorovi]

Hi all.
I need help with a code.
The code removes prefixes bind ($ 0 $), renaming layers, blocks, dimension styles, but some objects do not change the name as linetypes, text styles and duplicate names.
How I can fix that?
If I have an existing name, I want to change the name with a (2) at the end.
Example.
Layer: FloorLevel$0$Door90
If the layer "Door90" is existing, is renamed to "Door90 (2)"

(defun c:delprefixe(/ ActDoc Name NewName)

(vl-load-com)

(defun RemoveBindPrefix (String / Pos LastPos)

(if (setq Pos (vl-string-search "$" String))

(progn

(setq LastPos Pos)

(while (setq Pos (vl-string-search "$" String (1+ Pos)))

(setq LastPos Pos)

)

(substr String (+ 2 LastPos))

)

String

)

)

;---------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))

(vlax-for Obj (vla-get-Layers ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Layer: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-Blocks ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Block: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-TextStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Text style: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-Views ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n View: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-UserCoordinateSystems ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n UCS: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-DimStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Dimension style: " Name " was not renamed."))

)

)

)

(princ)

)

[Kent1Cooper]

---

@jjorovi wrote:

....
The code removes prefixes bind ($ 0 $), renaming layers, blocks, dimension styles, but some objects do not change the name as linetypes, text styles and duplicate names.
How I can fix that?
If I have an existing name, I want to change the name with a (2) at the end.
.... 

....
(defun RemoveBindPrefix (String / Pos LastPos)
  (if (setq Pos (vl-string-search "$" String))
    (progn
      (setq LastPos Pos)
      (while (setq Pos (vl-string-search "$" String (1+ Pos)))
        (setq LastPos Pos)
      )
      (substr String (+ 2 LastPos))
    )
    String
  )
)
....

---

That would require a series of

(if (tblsearch ...

functions to determine whether those names are already in use, and presumably also a check for the name with the suffix number already existing, and incrementing of that accordingly.  I can't work on that right now, but may come back to it if someone else doesn't jump in.  There are other threads with similar elements, if you can figure out what to Search for.

But I have a quick suggestion unrelated to that question....  The sub-routine quoted above can be simplified by using (vl-string-position) rather than (vl-string-search), because (vl-string-position) can search from the end, meaning you can find the last $ character in one shot, so you don't need to step through:

(defun RemoveBindPrefix (String / Pos)
  (if (setq Pos (vl-string-position 36 String nil T)); T = search-from-the-end
    (substr String (+ 2 Pos)); then

    String ; else
  ); if
); defun

It does require an ASCII character code for the character, instead of the character itself.  36 is the one for $.  It could also be done this way, if you want to see in the code what character you're looking for:

.... (vl-string-position (ascii "$") String nil T))

[pbejse · Accepted solution]

---

@jjorovi wrote:

Hi all.
I need help with a code.
The code removes prefixes bind ($ 0 $), renaming layers, blocks, dimension styles, but some objects do not change the name as linetypes, text styles and duplicate names.
How I can fix that?
If I have an existing name, I want to change the name with a (2) at the end.
Example.
Layer: FloorLevel$0$Door90
If the layer "Door90" is existing, is renamed to "Door90 (2)"

---

Building from your code and Kent's post

(defun c:RenBLD ( / aDoc RemoveBindPrefix _taken aDoc name newname)
;;;		Kent Cooper		;;;
(defun RemoveBindPrefix (String / Pos)
  (if (setq Pos (vl-string-position 36 String nil T)); T = search-from-the-end
    (substr String (+ 2 Pos)); then
    String ; else
  ); if
)
;;;		pBe		;;;
(defun _taken	(doc tbl nm i / nme)
	  (if (not (vl-catch-all-error-p
		     (vl-catch-all-apply
		       'vla-item
		       (list (vlax-get doc tbl) (setq nme (strcat nm " (" (itoa i) ")")))
		     ) ;_ end of vl-catch-all-apply
		   ) ;_ end of vl-catch-all-error-p
	      ) ;_ end of not
			(_taken doc tbl nm (1+ i))
	    nme))  
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (foreach item	'("Layers" "DimStyles" "TextStyles" "Blocks" "Linetypes")
    (vlax-for itm (vlax-get aDoc item)
      (cond ((and
	       (vl-string-position 36 (setq name (vla-get-name itm)) nil T)
	       (setq newname (RemoveBindPrefix name))
	       (setq newname
		      (if (vl-catch-all-error-p
			    (vl-catch-all-apply 'vla-item (list (vlax-get aDoc item) newname))
			  ) ;_ end of vl-catch-all-error-p
			newname
			(_taken aDoc item newname 2)
		      ) ;_ end of if
	       ) ;_ end of setq
	       (if (eq item "TextStyles")
		 (progn
		   (setq ent (entget (tblobjname "Style" name)))
		   (entmod (subst (Cons 2 newname) (assoc 2 ent) ent))
		 ) ;_ end of progn
		 (vlax-put itm 'Name newname)
	       ) ;_ end of if
	     ) ;_ end of and
	    )
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of foreach
  (princ)
)

command: Renbld

HTH

[jjorovi]

Friends, thank you both for the help.
I am pleased to receive a quick response to my concerns.
Greetings from C.R