Jump to content
flowerrobot

Rename Blocks

Recommended Posts

flowerrobot

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


Share this post


Link to post
Share on other sites
flowerrobot

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

Share this post


Link to post
Share on other sites
Lee Mac

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

Share this post


Link to post
Share on other sites
flowerrobot

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

 

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 :D,

Share this post


Link to post
Share on other sites
Lee Mac
Then there stupied idoits who deserve the error for not selecting the right thing o:)

 

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 :D,

 

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:

Share this post


Link to post
Share on other sites
flowerrobot

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 :D, when you have txt in two places editing them both causes errors :D, 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

Share this post


Link to post
Share on other sites
alanjt

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 :D, when you have txt in two places editing them both causes errors :D, 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

Share this post


Link to post
Share on other sites
Lee Mac
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...

Share this post


Link to post
Share on other sites
flowerrobot
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

Share this post


Link to post
Share on other sites
alanjt
Where does leaving an extra ')' and no error trapping count as so many errors

In the land of swirly twirlies and gumdrops.

Share this post


Link to post
Share on other sites
merlin_m007

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 [email protected]

 

Merlin Menaco

Share this post


Link to post
Share on other sites
gilsoto13
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 [email protected]

 

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.

Share this post


Link to post
Share on other sites
Astro
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 :D

Share this post


Link to post
Share on other sites
Boxer

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.

Share this post


Link to post
Share on other sites
Lt Dan's legs
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?

Share this post


Link to post
Share on other sites
Lee Mac

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.

Share this post


Link to post
Share on other sites
Lt Dan's legs

Many thanks Lee!

Share this post


Link to post
Share on other sites
Lee Mac
Many thanks Lee!

 

You're welcome :)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...