Jump to content

Block Rename with case statements


Recommended Posts

Posted (edited)

Hello All,

 

 

I have a question about a LISP Routine that involves Wildcards and a CASE Statement (Maybe).

 

 

I have about 500+ drawings to edit and I need this routine to ward off carpal tunnel.

 

 

Each drawing has a series of "typical blocks" that I need to rename, with the catch of various wildcards between the consistent bits.

 

 

I have a block with 18 characters followed by junk I do not need

 

 

I need to rename it with a suffix added.

 

 

12345-TACOME-22x34

 

 

Needs to become : 12345-TACOME-22x3405BOB Border

 

If I could just get this first part now - that would still save hundreds of clicks.

 

 

 

Now the tricky bit:

 

 

There are also blocks name like this:

 

 

A123-*_*_ARCH*

A123-*_*_STEEL*

A123-*_*_STRU*

A123-*_*_ELEC*

 

 

(and a few others...)

 

 

* #1 = two characters (always)

* #2 = three characters (always)

* #3 = junk that needs to be replaced with "05BOB Border"

 

 

Result:

 

 

A123-01_XYZ_ARCH05BOB Border

 

 

Possible Problem:

 

 

Following this naming convention, once processed, there could be 2, 3, 4, 5, blocks with the same name. In that event, the first block will process fine, the second block would generate an error. In that case, append a 2, 3, 4, 5 or whatever the next number in the sequence would be. I imagine this being processed from a list of block names.

 

 

 

 

Pseudo code:

 

 

get list of names that all begin with A123-

look for all blocks that fit the pattern A123-*_*_ARCH*

if the list length is 1 then rename to A123-01_XYZ_ARCH05BOB Border

else rename to A123-01_XYZ_ARCH05BOB1 Border

 

 

 

 

If I could just get the first part now - that would still save hundreds of clicks.

Edited by MarkytheSparky
Additional Information
Posted

It may be easier to just make a list of all the block names and thier new names use excel as you can use concatenate to add the BOB1 save as a csv file. You need a block name dumper also so as to make original list. Run a couple of times on different drawings. Throw into excel and sort do a if line above is same then delete cell, re sort you now have your block list.

Posted

I was originally thinking along the same lines, but each drawing file has such a random collection of these blocks with various names.

If someone could help me with the simple framework of making a list of all blocks starting with the "A123-" prefix, then a simple Case Statement, I could try and flesh it out from there.

From a random sampling, I found a worst case of 16 blocks in one drawing... granted that's a large case statement, but I need a blunt hammer to remove clicks per drawings (soon).

Posted

I poked around a little more and found this lisp

 

 

 (defun c:getblocks (/ thelist)
 (vl-load-com)
 (setq acadobject (vlax-get-Acad-Object))
 (setq activedocument (vla-get-activedocument acadobject))
 (setq BlockTable (vla-get-blocks activedocument))
 (vlax-for each BlockTable
   (setq thelist (cons (vla-get-Name each) thelist))
   (setq thelist (cons (vla-get-Comments each) thelist))
 )
 (if thelist
   (reverse thelist)
 )
) ;defun
(princ)

 

 

 

 

 

 

it makes a nice list on the screen of all the blocks in a drawing.

Now how do you truncate the list to just the blocks that contain A123-

 

 

This is a good start...

Posted

This might be a big step forward but I am not sure if this could be modified to use wild cards?

 

 

[font=Times New Roman][size=3]  [/size][color=black][font="Courier New"](defun c:Test  (/ lst ss i sn en f)[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ;;--------------------------------------------;;[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ;; Author : Tharwat . Date: 09.June.2015     ;;[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ;; A function to replace a set of block names ;;[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ;; with another as per listed in the list    ;;[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ;;--------------------------------------------;;[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  (setq lst '(("old" . "new")[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]              ("one" . "two")[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]              ("sad" . "fun")[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]              )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]        )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  (if (setq ss (ssget "_X" (list '(0 . "INSERT")[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]                                 (cons 2 (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) lst))))))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]    (repeat (setq i (sslength ss))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]      (setq sn (ssname ss (setq i (1- i)))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]            en (entget sn))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]      (if (and (setq f (assoc (cdr (assoc 2 en)) lst))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]               (tblsearch "BLOCK" (cdr f))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]               (entmake (append (list '(0 . "INSERT") (cons 2 (cdr f)))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]                 (vl-remove-if-not '(lambda (v) (member (car v) '(6 8 10 41 42 43 50 62))) en)))[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]             )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]         (entdel sn)[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]         )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]      )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]    )[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  (princ)[/font][/color]
[size=3]  [/size][color=black][font="Courier New"]  ) [/font][/color]
[size=3]  [/size][size=3] [/size]
[size=3]  [/size][/font]
Posted

This method works also, but does not concatenate the list.

 

 

(defun c:getblocks2 ( )
 (vl-load-com)
 (setq *blks*
      (vla-get-Blocks
 (vla-get-activedocument
   (vlax-get-acad-object)
 )
      )
)
(vlax-for item *blks*
 (if (eq (vla-get-IsLayout item) :vlax-false)
   (princ (strcat (vla-get-Name item)
	   " -> "
	   (vla-get-Comments item)
	   "\n")
   )
 )
)
 )

Posted

just a little farther but I cannot put it all together

 

 

 

 

Command: (cleanstr "GTR1, *SP002, *SP003, *SP004, GTR5" "*`*SP*")

"GTR1,GTR5"

 

 

 

[color=black][font=Courier New](defun cleanstr (string patern / str2lst)[/font][/color]
[color=black][font=Courier New]  (defun str2lst (str sep / pos)[/font][/color]
[color=black][font=Courier New]    (if (setq pos (vl-string-search sep str))[/font][/color]
[color=black][font=Courier New]      (cons (substr str 1 pos)[/font][/color]
[color=black][font=Courier New]        (str2lst (substr str (+ (strlen sep) pos 1)) sep)[/font][/color]
[color=black][font=Courier New]      )[/font][/color]
[color=black][font=Courier New]      (list str)[/font][/color]
[color=black][font=Courier New]    )[/font][/color]
[color=black][font=Courier New]  )[/font][/color]
[color=black][font=Courier New]  (apply[/font][/color]
[color=black][font=Courier New]    'strcat[/font][/color]
[color=black][font=Courier New]    (vl-remove-if[/font][/color]
[color=black][font=Courier New]     '(lambda (x)(wcmatch x pattern))[/font][/color]
[color=black][font=Courier New]      (mapcar[/font][/color]
[color=black][font=Courier New]       '(lambda (y)(vl-string-subst "," " " y))[/font][/color]
[color=black][font=Courier New]        (str2lst string ",")[/font][/color]
[color=black][font=Courier New]      )[/font][/color]
[color=black][font=Courier New]    )[/font][/color]
[color=black][font=Courier New]  )[/font][/color]
[color=black][font=Courier New])[/font][/color]
[font=Times New Roman][size=3]
[/size][/font]
[font=Times New Roman][size=3]

[/size][/font]

 

 

 

 

 

 

 

 

Please help me if you can.

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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