Visual LISP, AutoLISP and General Customization

Reply
Valued Contributor
jjorovi
Posts: 58
Registered: ‎06-15-2012
Message 1 of 4 (269 Views)
Accepted Solution

Bind Prefixe

269 Views, 3 Replies
12-04-2012 01:03 PM

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)

)

 

*Expert Elite*
Kent1Cooper
Posts: 5,293
Registered: ‎09-13-2004
Message 2 of 4 (265 Views)

Re: Bind Prefixe

12-04-2012 01:54 PM in reply to: jjorovi

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

Kent Cooper
*Expert Elite*
pbejse
Posts: 2,440
Registered: ‎11-24-2009
Message 3 of 4 (251 Views)

Re: Bind Prefixe

12-04-2012 10:11 PM in reply to: jjorovi

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

 

Valued Contributor
jjorovi
Posts: 58
Registered: ‎06-15-2012
Message 4 of 4 (234 Views)

Re: Bind Prefixe

12-05-2012 08:16 AM in reply to: pbejse

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

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community