Lisp for removing part of block name

[tomwijnholt]

I'm working on a project where I'm making a library for certain profiles. I imported all the needed profiles in blocks (hundreds), but the block-name gives to much information. An example of the block-name is: 

345720__2068F4F92_7C03_4052_A151_58F9C16ECC9D

What i want to have is:
345720

So everything after the first number needs to be removed. I know that the job can be done with Rename. But the drawing contains almost thousand blocks with similar names. So ideally I would like to have a Lisp Routine where I can select multiple/all blocks at once. 

In the attachment you can find an example of the blocks.

Really hope some one can help me out here, any kind of input is appreciated. 

[Moshe-A · Accepted solution]

@tomwijnholt  hi,

check this.

enjoy

moshe

; Multi Rename Block
(defun c:mrb (/ conclusion ; local function
	        iSuccsess iFailure ss exeBName newBName p)

 (defun conclusion (ctr msg)
  (cond 
   ((or (not ctr) (= ctr 0))
    nil
   )
   ( t
    (prompt (strcat "\n" (itoa ctr) " block(s) " msg))
   )
  ); cond
 ); conclusion
  
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq ss (ssget '((0 . "insert"))))
  (progn
   (setq iSuccsess 0 iFailure 0) 
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq extBName (cdr (assoc '2 (entget ename)))) ; existing name 
    (if (and
	  (setq p (vl-string-search "__" extBName))
          (null (tblsearch "block" (setq newBName (substr extBName 1 p))))
	)
     (progn  
      (command "._rename" "block" extBName newBName)
      (setq iSuccsess (1+ iSuccsess))
     ); progn
     (setq iFailure (1+ iFailure))
    ); if 
   ); foreach
  ); progn
 ); if

 (conclusion iSuccsess "renamed.")
 (conclusion iFailure "fail to rename.")
  
 (command ".undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ) 
); c:mrb
  

[ВeekeeCZ · Accepted solution]

Here you go.

(defun c:BNameCut (/ ss i no nn)

  (if (and (setq ss (ssget '((0 . "INSERT"))))
	   (vl-cmdf "_.undo" "_be")
	   )
    (repeat (setq i (sslength ss))
      (if (and (setq no (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
	       (setq nn (itoa (atoi no)))
	       (/= nn no)
	       (/= nn "0")
	       (or (not (tblsearch "BLOCK" nn))
		   (prompt (strcat "\nRenaming '" no "' to '" nn " cancelled. Block name '" nn "' already exists.")))
	       )
	(command "_.Rename" "_Block" no nn))))
  (command "_.undo" "_end")
  (princ)
  )

[dbhunia · Accepted solution]

You can also try this for particular type of drawings and blocks .....(Assuming all starting number of block names is separated by "__" )...

(defun c:RENB ( / doc pos BN NBN)
  (vla-StartUndoMark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk (vla-get-blocks doc)
    (if (setq pos (vl-string-search "__" (setq BN (vla-get-name blk))))
		(if (not (tblsearch "BLOCK" (substr BN 1 pos)))
			(vla-put-name blk (setq NBN (substr BN 1 pos)))
		)
    )
  )
  (vla-EndUndoMark doc)
  (princ)
)

[tomwijnholt]

Perfect, exactly where I was looking for,

Thanks a lot!

[tomwijnholt]

Thanks again for the previous solution. 

It worked perfectly. 

However, I have another challenge at the moment. 

When I use your lips it only works for one block. For example, I have multiple blocks named: 

345280__6A15F1CA_D91A_42A4_9EBA_69861F2C19A7

345280__8F36CF89_BD90_4183_9C30_B9DDE9B97DB9

345280__DF8347AB_1174_43A8_8AB8_DBBB5A3CA8AC

Using your lisp I will end up with: 

345280

345280__8F36CF89_BD90_4183_9C30_B9DDE9B97DB9

345280__DF8347AB_1174_43A8_8AB8_DBBB5A3CA8AC

This is logical, because AutoCad can't make a new block with a name that already exist. 

Is there a way to update your lisp so it overwrites the other blocks. So I will end up with the same name for multiple blocks. 

There are thousands of blocks in total. So the command 'blockreplace' is to time consuming. 

Hope you can help me!

[Sea-Haven]

You can only have block name once, so do you want to replace the other blocks with the newly named block they will be permanently erased though. They are the same looking quickly at dwg ?

[Sea-Haven]

Trying this as a start but  replaced block and it moved so not sure need to check the insert point in your dwg. Obviously would put in a loop of block names.

(setq ss (ssget "X" (list (cons 0 "insert")(cons 2 "345280*"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
(vla-put-name obj "345280")
)

[Sea-Haven]

Solved the blocks are not the same starting with 345280 if you look at the  blocks the insertion point is different in  the blocks you may need to make the blocks 2 names deep 345280--8536......

Even worse some blocks with same starting sequence are mirrored.

Look at attached images. One block name has like 6 blocks all different.

[Moshe-A]

@tomwijnholt  hi,

Lets assumes the following blocks has the same geometry - ok?!

345280

345280__8F36CF89_BD90_4183_9C30_B9DDE9B97DB9

345280__DF8347AB_1174_43A8_8AB8_DBBB5A3CA8AC

before i correct the lisp here is a challenge for you, explore the blocks and tell me:

Does all these blocks has the same insertion point, XYZ scale factor and rotation angle?

cause if they don't? can you imaging the result?

Moshe

[Kent1Cooper]

---

@tomwijnholt wrote:
.... I have multiple blocks named: 

345280__6A15F1CA_D91A_42A4_9EBA_69861F2C19A7

345280__8F36CF89_BD90_4183_9C30_B9DDE9B97DB9

345280__DF8347AB_1174_43A8_8AB8_DBBB5A3CA8AC

....

---

Would it be acceptable to have the results named something like 345280_1, 345280_2, 345280_3, etc.?  Or maybe 345280A, 345280B, 345280C, etc.?

[tomwijnholt]

Moshe-A, 

thanks for the reply. 

You're right, I'm aware of the fact that the blocks have a similar name and geometry.

But this is not always the case for insertion point and rotation angle. And I can imagine how messy it's going to be after running the lisp.

However, the situation is that I have a separate AutoCad file with all the individual blocks redrawn in a simplified version. And that I have an AutoCad file with all the blocks combined in window profiles. (see attachments)

The idea is that I run the lisp in the DWG with the combined profiles, so all the blocks have the same name as in the other DWG. Than I will copy the profiles in the other DWG so the blocks will change automatically. 

I still believe it's quicker to run the lisp and adjust the locations instead of placing all the individual blocks in the right location. 

I hope it all makes sense to you, if it's not clear, let me know.

[tomwijnholt]

Kent Cooper, 

Thanks or the reply, but this is not acceptable. 
Because of the reason subscribed in my reply to moshe-A

[Moshe-A · Accepted solution]

OK, try this

; Multi Rename Block
(defun c:mrb (/ conclusion ; local function
	        iSuccsess iFailure ss exeBName newBName p elist)

 (defun conclusion (ctr msg)
  (cond 
   ((or (not ctr) (= ctr 0))
    nil
   )
   ( t
    (prompt (strcat "\n" (itoa ctr) " block(s) " msg))
   )
  ); cond
 ); conclusion
  
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq ss (ssget '((0 . "insert"))))
  (progn
   (setq iSuccsess 0 iFailure 0) 
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq extBName (cdr (assoc '2 (entget ename)))) ; existing name 
    (if (and
	  (setq p (vl-string-search "__" extBName))
          (null (tblsearch "block" (setq newBName (substr extBName 1 p))))
	)
     (progn  
      (command "._rename" "block" extBName newBName)
      (setq iSuccsess (1+ iSuccsess))
     ); progn
     (setq iFailure (1+ iFailure))
    ); if 
   ); foreach

   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq elist (entget ename))
    (setq extBName (cdr (assoc '2 elist))) ; existing name 

    (if (and
	  (setq p (vl-string-search "__" extBName))
	  (tblsearch "block" (setq newBName (substr extBName 1 p)))
        )
     (entmod (subst (cons '2 newBName) (assoc '2 elist) elist))
    ); if
   ); foreach
  ); progn
 ); if

 (conclusion iSuccsess "renamed.")
 (conclusion iFailure "fail to rename.")
  
 (command ".undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ) 
); mrb
  

[tomwijnholt]

Tanks a lot. 

Exactly what I needed.