Rename Blocks

Thought some one could make use of this

Will rename all blocks or just a single block, from selecting the target , Good for those random blocks or bad memory

;|
Rename Blocks
Created by FlowerRobot
Created on 20/12/09
Rev 1.1

Will rename a single block or all blocks

Rev history
Rev 1.0 (unkown)
 Created
Rev 1.1 20/12/09
 Command defined simpler
 Varibles localised and tidy up

|;
(defun c:rre
(/  Ent_BlkData Str_BkNme Str_NwBlkNme Bol_All Pt_BkPt Xscle Yscle Zscle Rotation OldOs Lst_EntInfo SS_1Block
;Subs
 *error*
 GetBlockEnts
)
(defun *error* (Str_ErrorMsg /)
 (if ErrorDump (princ Str_ErrorMsg))
 (vl-cmdf "_.undo" "_end")
 (vl-cmdf "_.undo" "1")
(princ "An error accured exiting")
 (setvar "cmdecho" 1)
 (princ)
)
(vl-load-com)
(setvar "cmdecho" 0)
(vl-cmdf "_.undo" "_begin")
(defun GetBlockEnts (Str_BkNme / Ent_Blk lst_Item Ent_Nxt)
 (setq Ent_Blk (cdr (assoc -2 (tblsearch "block" Str_BkNme)))
  lst_Item (list (cdr (assoc -1(entget Ent_Blk))))
  Ent_Nxt (entnext Ent_Blk))
 (while Ent_Nxt
   (setq lst_Item (append   (list(cdr (assoc -1(entget Ent_Nxt))))lst_Item) 
   Ent_Nxt (entnext Ent_Nxt))
 )
  lst_Item
)
(princ "\nSelect Block")
(if(and
  (setq SS_1Block (ssget ":S" '((0 . "INSERT"))))
  (< 0 (strlen (setq Str_NwBlkNme (getstring "\nWhat is new name: "))))
 )
 (progn
  (setq Ent_BlkData (ssname SS_1Block 0)
   Lst_EntInfo (entget Ent_BlkData)
   Str_BkNme (cdr (assoc 2 Lst_EntInfo))
  )
  (initget  0 "YES NO")
  (cond
   ((tblsearch "block" Str_NwBlkNme)
    (princ (strcat "A Block \""  Str_NwBlkNme "\" already exists")))
   ((if (= "NO" (getkword "\nRename all? : [YES/NO] <YES>")) nil t)
    (vl-cmdf "_Rename" "Block"  Str_BkNme Str_NwBlkNme))
   (t
    (entmake (list (cons 0 "BLOCK")(cons 2 Str_NwBlkNme)(cons 70 2)(cons 10 (list 0 0 0))))
     (foreach Ent_Item (GetBlockEnts Str_BkNme)
      (entmake (entget  Ent_Item))
     )
    (entmake (list (cons 0 "ENDBLK")))
    (setq Pt_BkPt (cdr (assoc 10 Lst_EntInfo))
      Xscle (cdr (assoc 41 Lst_EntInfo))
      Yscle (cdr (assoc 42 Lst_EntInfo))
      Rotation (cdr (assoc 50 Lst_EntInfo))
      OldOs (getvar "osmode")
    )
    (entdel Ent_BlkData)
    (setvar "osmode" 0)
    (vl-cmdf "_.Insert" Str_NwBlkNme Pt_BkPt Xscle Yscle (/(* 180 Rotation)pi))
    (setvar "osmode" OldOs)
   )
  )
 )
 (princ "Invalid data, Please try again tommorro")
)
(vl-cmdf "_.undo" "_end")
(setvar "cmdecho" 1)
(princ)
)

Similar thread:

http://www.cadtutor.net/forum/showthread.php?t=36729

Ahh lee, Here i thought i wasted my time again, Least mine will change an inderivual block

Wish i had seen the thread earlyer tho, would of approched it differently

What if the user fails to select a block? I can see lselstp nil coming... :wink:

Then there stupied idoits who deserve the error for not selecting the right thing

Excuse my harshness but im one of those who belive in suvival of the fittest... If some one dumbenought to do it, Dont make a law against it we would be better with out them ,

Then there stupied idoits who deserve the error for not selecting the right thing

 

Excuse my harshness but im one of those who belive in suvival of the fittest... If some one dumbenought to do it, Dont make a law against it we would be better with out them ,

I'm not looking at it with that viewpoint, but from the perspective of proper programming technique.

EDIT: Also, watch the parentheses on your COND statement :wink:

I can understand what you saying, But im too lasy/Not enough fee time, to really do it propperly on simple code, Dont get me wrong i do it on propper(larger) programs.

yer i get caught by that some time , when you have txt in two places editing them both causes errors , I kno, Shouldnt use two softwares but once has nice fonts/background, the other a debu-ger

but you are right, I spent that dreaded 2min and added error control code updated

A simple and statement goes a long way.

I can understand what you saying, But im too lasy/Not enough fee time, to really do it propperly on simple code, Dont get me wrong i do it on propper(larger) programs.

 

yer i get caught by that some time , when you have txt in two places editing them both causes errors , I kno, Shouldnt use two softwares but once has nice fonts/background, the other a debu-ger

 

but you are right, I spent that dreaded 2min and added error control code updated

I can understand what you saying, But im too lasy/Not enough fee time, to really do it propperly on simple code, Dont get me wrong i do it on propper(larger) programs.

Well, if something is worth doing, its worth doing properly, and if it is such "simple code", then why does it contain so many errors...

Well, if something is worth doing, its worth doing properly, and if it is such "simple code", then why does it contain so many errors...

Where does leaving an extra ')' and no error trapping count as so many errors

Where does leaving an extra ')' and no error trapping count as so many errors

In the land of swirly twirlies and gumdrops.

Pls help me with a Auto cad lisp programme which find and replaces attribute values in autocad attributes

eg if the VALUES of different attributes are CAXXXXYYYY001,CAXXXXYYYY002,CAXXXXYYYY003 etc

then

I would like to replace 2nd letter 'C' with letter 'D'

thus it becomes

CDXXXXYYYY001,CDXXXXYYYY002,CDXXXXYYYY003 etc

already got one .exe programme but system security does not allow me to install the programme to my system thats y I badly need a lisp

kindly help

thanks in advance

pls send the code to rajtoms@saudia.com

Merlin Menaco

Pls help me with a Auto cad lisp programme which find and replaces attribute values in autocad attributes

 

eg if the VALUES of different attributes are CAXXXXYYYY001,CAXXXXYYYY002,CAXXXXYYYY003 etc

then

I would like to replace 2nd letter 'C' with letter 'D'

thus it becomes

CDXXXXYYYY001,CDXXXXYYYY002,CDXXXXYYYY003 etc

 

already got one .exe programme but system security does not allow me to install the programme to my system thats y I badly need a lisp

 

kindly help

 

thanks in advance

 

pls send the code to rajtoms@saudia.com

 

Merlin Menaco

I think there's no need for a lisp..

Command "Find" can find and replace text on attributes, at leat in autocad 2009 it does.

Thought some one could make use of this

 

Will rename all blocks or just a single block, from selecting the target , Good for those random blocks or bad memory

 

 

;|
Rename Blocks
Created by FlowerRobot
Created on 20/12/09
Rev 1.1

Will rename a single block or all blocks

Rev history
Rev 1.0 (unkown)
 Created
Rev 1.1 20/12/09
 Command defined simpler
 Varibles localised and tidy up

|;
(defun c:rre
(/  Ent_BlkData Str_BkNme Str_NwBlkNme Bol_All Pt_BkPt Xscle Yscle Zscle Rotation OldOs Lst_EntInfo SS_1Block
;Subs
 *error*
 GetBlockEnts
)
(defun *error* (Str_ErrorMsg /)
 (if ErrorDump (princ Str_ErrorMsg))
 (vl-cmdf "_.undo" "_end")
 (vl-cmdf "_.undo" "1")
(princ "An error accured exiting")
 (setvar "cmdecho" 1)
 (princ)
)
(vl-load-com)
(setvar "cmdecho" 0)
(vl-cmdf "_.undo" "_begin")
(defun GetBlockEnts (Str_BkNme / Ent_Blk lst_Item Ent_Nxt)
 (setq Ent_Blk (cdr (assoc -2 (tblsearch "block" Str_BkNme)))
  lst_Item (list (cdr (assoc -1(entget Ent_Blk))))
  Ent_Nxt (entnext Ent_Blk))
 (while Ent_Nxt
   (setq lst_Item (append   (list(cdr (assoc -1(entget Ent_Nxt))))lst_Item) 
   Ent_Nxt (entnext Ent_Nxt))
 )
  lst_Item
)
(princ "\nSelect Block")
(if(and
  (setq SS_1Block (ssget ":S" '((0 . "INSERT"))))
  (< 0 (strlen (setq Str_NwBlkNme (getstring "\nWhat is new name: "))))
 )
 (progn
  (setq Ent_BlkData (ssname SS_1Block 0)
   Lst_EntInfo (entget Ent_BlkData)
   Str_BkNme (cdr (assoc 2 Lst_EntInfo))
  )
  (initget  0 "YES NO")
  (cond
   ((tblsearch "block" Str_NwBlkNme)
    (princ (strcat "A Block \""  Str_NwBlkNme "\" already exists")))
   ((if (= "NO" (getkword "\nRename all? : [YES/NO] <YES>")) nil t)
    (vl-cmdf "_Rename" "Block"  Str_BkNme Str_NwBlkNme))
   (t
    (entmake (list (cons 0 "BLOCK")(cons 2 Str_NwBlkNme)(cons 70 2)(cons 10 (list 0 0 0))))
     (foreach Ent_Item (GetBlockEnts Str_BkNme)
      (entmake (entget  Ent_Item))
     )
    (entmake (list (cons 0 "ENDBLK")))
    (setq Pt_BkPt (cdr (assoc 10 Lst_EntInfo))
      Xscle (cdr (assoc 41 Lst_EntInfo))
      Yscle (cdr (assoc 42 Lst_EntInfo))
      Rotation (cdr (assoc 50 Lst_EntInfo))
      OldOs (getvar "osmode")
    )
    (entdel Ent_BlkData)
    (setvar "osmode" 0)
    (vl-cmdf "_.Insert" Str_NwBlkNme Pt_BkPt Xscle Yscle (/(* 180 Rotation)pi))
    (setvar "osmode" OldOs)
   )
  )
 )
 (princ "Invalid data, Please try again tommorro")
)
(vl-cmdf "_.undo" "_end")
(setvar "cmdecho" 1)
(princ)
)

Thanks FlowerRobot, this is exactly what i was looking for

Thanks for the routine; I found it helpful for what I need. The only thing I have to say is to remember to use quotes around your block name if your new block name has spaces in it.

Perhaps also useful:

http://www.cadtutor.net/forum/showthread.php?48840-CopyBlock-COPIES-THE-SELECTED-BLOCK-WITH-A-NEW-NAME

Or, using the same principle:

Copy Block.lsp

What if the user fails to select a block? I can see lselstp nil coming... :wink:

Hi Lee! how do you prevent an error when user fail's to select a block?

I tried but failed

(defun c:BNUM (/ wait ent all)
 (setq wait t)
 (while wait
   (setq ent (entget (car (entsel"\nSelect block to count: "))))
   (if (or(/= (cdr (assoc 0 ent)) "INSERT")(= ent nil))
(prompt "\n**Please select a block!**")
(setq wait nil))
   )
 (setq all (ssget "_x" (list (assoc 2 ent))))
 (alert (strcat "\nThere's (" (itoa (sslength all)) ") " (cdr (assoc 2 ent)) " block(s) in this drawing.\n\n   **Created by Reid B.**   "))
 (princ)
 )

Edit: Also wondering, why will this LISP work for some dynamic blocks and not others?

You need to check that the selection set is valid before using any selection set manipulation functions on it, as such examples as "(sslength nil)" will error.

(defun c:bNum ( / e ss )

 (while
   (not
     (and
       (setq e (car (entsel "\nSelect Block to Count: ")))
       (eq "INSERT" (cdr (assoc 0 (setq e (entget e)))))
     )
   )
   (princ "\n** Invalid Selection **")
 )

 (if (setq ss (ssget "_X" (list (assoc 0 e) (assoc 2 e))))
   (alert
     (strcat "\nThere "
       (if (< 1 (setq n (sslength ss))) "are " "is ")
       (itoa n) " "
       (cdr (assoc 2 e))
       " block" (if (< 1 n) "s" "")
       " in this drawing."
     )
   )
 )

 (princ)
)

As for DynBlocks, when the visibility state changes, they are transformed into anonymous blocks. Check my 'Upgraded BCount' program.

Many thanks Lee!

Many thanks Lee!

You're welcome