Help with writing a Block Renaming routine

[shyj9]

Hi everyone,

I am looking for lisp routine for updating all blocks in a drawing that kept in a single directory. Can anyone please help

Thanks

[Opie]

You may first want to provide additional information. Updating all blocks is a bit vague. You also may want to post some of the code you have started, if you have any.

[shyj9]

Hi, Opie,
I have got a lisp for block update from a colleague from our Sydney office and he is not reachable at the moment, I tried this one but not functioning, but there is no errors in that. I can send you the routine Can you please help me?.

Thanks
Shyju

Here it is:
(defun C:BKUPDATE ( )

(setq B (tblnext "BLOCK" T) NMDWG nil FLS nil)
(while B
(setq NM (cdr (assoc 2 B)))
(if (= "*" (substr NM 1 1))
(princ )
(setq NMDWG (cons NM NMDWG))
)
(setq B (tblnext "BLOCK"))
)

(setq FLS (vl-directory-files "..\\BlockWA\\" "*.dwg"))
(foreach n (reverse FLS)
(setq LST (cons (strcase n) LST))
)
(setq FLS LST)
(setq RG (getvar "REGENMODE"))
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(foreach n NMDWG
(if (member (strcase (strcat n ".DWG")) FLS)
(progn
(princ (strcat "\nRedefine block: " n))
(command ".INSERT" (strcat n "=..\\BlockWA\\" n))
(command)
)
)
)
(setvar "REGENMODE" RG)
(command "regenall")
(princ)
)


; (foreach n NAMES
; (if (and (tblsearch "block" n) (setq FL (findfile (strcat "..\\blocks\\" n ".dwg"))))
; (progn
; (princ "\nRedefining block :") (princ FL)
; (command ".insert" (strcat n "=" FL))
; (command)
; )
; (progn (princ "\nFile :") (princ n ) (princ " not found."))
; )
; )

[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]

[Mike.Perry]

Hi

Does anything found within the below links offer any help...

Redefining your Dynamic Blocks

Redefine block script

Can I redefine a block when inserted?

How do I to tell AutoCAD to update block?

Do any of the Blocks contain Attributes ? If yes, how do you intend dealing with them ?

Have a good one, Mike

[shyj9]

Hello everyone,
Problem 1.

The lisp routine which i got from Augi Excahnge for renaming the layers works well in some files but some files it gives me two different types of errors ie
1. Layer exists! Rename Layer or Move Entities (R/M)
2. Enter old layer name

Here is the original lisp

(defun c:renamelyr (/ rs_cmde rs_menu lay filepos)
(setq ck nil)
(setq rs_cmde(getvar "CMDECHO") rs_menu(getvar "MENUECHO")
lay(tblnext "LAYER" 1))
(setvar "CMDECHO" 0)(setvar "MENUECHO" 1)
;;;********************************************
(defun Spinner()

(if (not spinpos)(setq spinpos 1)) ; Look for global variable spinpos -
; If it doesn't exist, create it and
; initialize to 1
(if (>= spinpos 4)(setq spinpos 1)) ; If it's 5 - start over...set to 1
(princ "\010") ; Backspace
(cond ; Display appropriate spin position
((= spinpos 1)(prompt "|"))
((= spinpos 2)(prompt "/"))
((= spinpos 3)(prompt "-"))
((= spinpos 4)(prompt "\\"))
)
(setq spinpos (1+ spinpos)) ; Increment spinner position
(princ) ; Leave quietly
)
;;;********************************************
(defun ST_lsrch(str delim / len pos cnt ch)
(setq
len (strlen str)
pos nil
)
(if (> len 0)
(progn
(setq cnt 1)
(while (<= cnt len)
(setq
ch (substr str 1 1)
str (substr str 2)
)
(if (= ch delim)
(setq pos cnt)
)
(setq cnt (1+ cnt))
)
))
pos
)
;;;**********************************************
(while lay
(Spinner)
(setq old_layer(cdr (assoc 2 lay)))
(setq lenname (strlen old_layer)) ;set length of layername
(if (/= (wcmatch old_layer "*$*") nil)
(progn
(setq filepos (ST_lsrch old_layer "$")) ;Call last character position search on string
(setq temp_layer_length (+ filepos 1)) ;trap position of beginning of valid layer name
(setq lenlayeronly (- lenname temp_layer_length)) ;set length of layer only
(setq new_length (- lenname lenlayeronly))
(setq new_layer (substr old_layer temp_layer_length new_length))
(if (/= (TBLSEARCH "LAYER" new_layer) nil)
(progn
;(prompt "\nEXISTING LAYER...SKIPPED")
(if (= ck nil)
(progn
(initget 1 "R M")
(setq ck (getkword "Layer exists! Rename Layer or Move Entities (R/M)"))
(if (= (strcase ck) "M")
(progn
(prompt "\n")
(prompt old_layer)
(prompt " Should be Moved")
(setq sel1 nil)
(setq sel1 (ssget "x" (list (cons 8 (strcat "*" old_layer)))))
(command "._chprop" sel1 "" "c" "bylayer" "lt" "bylayer" "la" new_layer ""))
) ;end progn mover
(progn
(prompt "\n")
(prompt old_layer)
(prompt " Should be Renamed")
) ;end progn
) ;END IF
)

) ;end progn
(progn
(command ".RENAME" "LAYER" old_layer new_layer)

) ;end progn
) ;end if
) ; end progn
) ;end if
(setq lay(tblnext "LAYER"))
)
(setvar "CMDECHO" rs_cmde) (setvar "MENUECHO" rs_menu)(princ)
(prompt "\nFinished Renaming layers!")(princ)
)
(princ "\nBound Layer Renaming by RLB!")
(princ)
;;;****************************************************


Problem 2.

I am having a problem with a lisp routine, which I got from the Augi Exchange. Got a lisp for renaming the layers (renaming the xreflayer ie to remove this $0$ from the names) it works well for renaming the layers. I modified the lisp to make a similar one for renaming blocks too. But it doesn't works well. Can you please help me guys?

Here is the lisp which I modified
Thanks in Advance
Shyju

(defun c:renameblk (/ rs_cmde rs_menu blk filepos)
(setq ck nil)
(setq rs_cmde (getvar "CMDECHO")
rs_menu (getvar "MENUECHO")
blk (tblnext "block" 1)
)
(setvar "CMDECHO" 0)
(setvar "MENUECHO" 1)
;;;********************************************
(defun Spinner ()

(if (not spinpos)
(setq spinpos 1)
) ; Look for global variable spinpos -
; If it doesn't exist, create it and
; initialize to 1
(if (>= spinpos 4)
(setq spinpos 1)
) ; If it's 5 - start over...set to 1
(princ "\010") ; Backspace
(cond ; Display appropriate spin position
((= spinpos 1) (prompt "|"))
((= spinpos 2) (prompt "/"))
((= spinpos 3) (prompt "-"))
((= spinpos 4) (prompt "\\"))
)
(setq spinpos (1+ spinpos)) ; Increment spinner position
(princ) ; Leave quietly
)
;;;********************************************
(defun ST_lsrch (str delim / len pos cnt ch)
(setq
len (strlen str)
pos nil
)
(if (> len 0)
(progn
(setq cnt 1)
(while (<= cnt len)
(setq
ch (substr str 1 1)
str (substr str 2)
)
(if (= ch delim)
(setq pos cnt)
)
(setq cnt (1+ cnt))
)
)
)
pos
)
;;;**********************************************
(while blk
(Spinner)
(setq old_block (cdr (assoc 2 blk)))
(setq lenname (strlen old_block)) ;set length of blockname
(if (/= (wcmatch old_block "*$*") nil)
(progn
(setq filepos (ST_lsrch old_block "$"))
;Call last character position search on string
(setq temp_block_length (+ filepos 1))
;trap position of beginning of valid block name
(setq lenblockonly (- lenname temp_block_length))
;set length of block only
(setq new_length (- lenname lenblockonly))
(setq new_block (substr old_block temp_block_length new_length))
(if (/= (TBLSEARCH "block" new_block) nil)
(progn
;(prompt "\nEXISTING BLOCK...SKIPPED")
(if (= ck nil)
(progn
(initget 1 "R M")
(setq ck
(getkword
"Block exists! Rename Block or Move Entities (R/M)"
)
)
(if (= (strcase ck) "M")
(progn
(prompt "\n")
(prompt old_block)
(prompt " Should be Moved")
(setq sel1 nil)
(setq sel1
(ssget "x"
(list (cons 8 (strcat "*" old_block)))
)
)
(command "._chprop" sel1 ""
"c" "byblock" "lt" "byblock"
"la" new_block ""
)
)
) ;end progn mover
(progn
(prompt "\n")
(prompt old_block)
(prompt " Should be Renamed")
) ;end progn
) ;END IF
)

) ;end progn
(progn
(command ".RENAME" "BLOCK" old_block new_block)

) ;end progn
) ;end if
) ; end progn
) ;end if
(setq blk (tblnext "BLOCK"))
)
(setvar "CMDECHO" rs_cmde)
(setvar "MENUECHO" rs_menu)
(princ)
(prompt "\nFinished Renaming blocks!")
(princ)
)
(princ "\nBound block Renaming by RLB!")
(princ)
;;;*********************************************** *****[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]

[Doodlemusmaximus]

In what way dosen't it work too well, can you give me a example to work with here?

[shyj9]

Hi, Beldin its the second one not working , I am very much concerned about my old thread, can you pl. help me? someone told me that i need to keep the directory in the support search path or something like that, can you please check?

thanks
Shyju

[Doodlemusmaximus]

Hi, Beldin its the second one not working , I am very much concerned about my old thread, can you pl. help me? someone told me that i need to keep the directory in the support search path or something like that, can you please check?

thanks
Shyju
it works up to a point in that it changes the name to 3 letters long. Trying to figure out where the problem is. And yes it does help if your in the support directory.

I'm hoping here that someone with a little more know how in lisps will be a better bet on this one. Like I said earlier Im a tadd rusty pn these, but will keep on plugging away to try to get it sorteds out

[kennet.sjoberg]

There is no simple way to rename a layer, linetype, textstyle, block, dimensionstyles or what$0$ever if the symbolname already exist in current file.

To prevent this problem to occur
"Bind as Insert" ( and NOT Bind as Bind )

: ) Happy Computing !

kennet