Block Swap - help needed.

[amarcon]

I am asking for help. I have a huge collection of AutoLISP routines which are more or less simple tools for automating a lot of mundane drawing tasks. I really need one now to manipulate blocks, however, I have never mastered handling lists. (I prefer straight AutoLISP as we have a clone seat that doesn't do vLISP)

 

Basically I'll have an item that needs to be flipped over. This means all the current 'Near Face' blocks have to be made 'Far Face' blocks and vica versa. Blocks are always 1:1 scale and not attributed nor dynamic... an easy substitution... (A pic tells a thousand words so an example drawing is attached)

 

Example:

There may be multiple occurances of each in a drawing.

block becomes block

16NF ------> 16FF

20NF ------> 20FF

24NF ------> 24FF

 

In the same drawing:

block becomes block

16FF ------> 16NF

20FF ------> 20NF

24FF ------> 24NF

 

My thoughts on a routine are:

- create a list of ALL existing blocks (name and their insertion points)

- step though list swapping block names

- re-insert new blocks at insertion points

 

There are many more blocks than above example, however, with the right mechanics I could expand it to suit my requirements. Many thanks in advance

 

Added ACAD2000 version of example, as requested. Thanks.

example.dwg

example2000.dwg

Edited November 11, 2011 by amarcon

[Tharwat]

Is this meet your needs ?

 

(defun c:TesT (/ ss i sset e)
 ;;; Tharwat 10 Nov. 2011 ;;;
 (defun SwapBlock (block e ename)
 (if (tblsearch "BLOCK" block)
   (progn
     (entmake (list '(0 . "INSERT")
                    (cons 2 block)
                    (assoc 10 e)
                    (assoc 41 e)
                    (assoc 42 e)
                    (assoc 43 e)
                    (assoc 50 e)
              )
     )
     (entdel ename)
   )
 )
)
 (if (setq ss (ssget "_x" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss))
     (setq sset (ssname ss (setq i (1- i))))
     (setq e (entget sset))
     (cond ((eq (cdr (assoc 2 e)) "16FF")
            (SwapBlock "16NF" e sset)
           )
           ((eq (cdr (assoc 2 e)) "20FF")
            (SwapBlock "20NF" e sset)
           )
           ((eq (cdr (assoc 2 e)) "24FF")
            (SwapBlock "24NF" e sset)
           )
     )
   )
   (princ)
 )
 (princ)
)

[ketxu]

I think you only need to make a assoc list with (one . another) block, and change name of Insert (not entmake then entdel) in pair ^^

( i haven't CAD here to test my idea)

[Tharwat]

I think you only need to make a assoc list with (one . another) block, and change name of Insert (not entmake then entdel) in pair ^^

( i haven't CAD here to test my idea)

 

I did not get your point .

[MSasu]

I think you only need to make a assoc list with (one . another) block, and change name of Insert (not entmake then entdel) in pair ^^

( i haven't CAD here to test my idea)

 

You are right!

 

Regards,

Mircea

[Lee Mac]

I think you only need to make a assoc list with (one . another) block, and change name of Insert (not entmake then entdel) in pair ^^

( i haven't CAD here to test my idea)

 

This method will work for non-attributed blocks, but be careful with attributed blocks, since attributes can be created outside of the block definition, they may be left behind when the referenced block definition is switched. Also, you will need to ensure the new block definition exists in the drawing.

 

You should be OK though for this case, since the OP states the blocks are not attributed

[ReMark]

Does the fact that each point has an unique insertion point keep the routine from looping? 16NF--->16FF--->16NF--->16FF.......etc, etc, etc.

[ketxu]

Does the fact that each point has an unique insertion point keep the routine from looping? 16NF--->16FF--->16NF--->16FF.......etc, etc, etc.

I don't think so, since we only loop through an entity once time in Selection Set.

Srr for missing CAD to test and my poor English ^^

[amarcon]

Thanks Tharwat for your code, and others for contributing to the thought process.

Unfortunately on vanilla 2012 (with all required blocks in drawing) I get no result from running this routine? ;(

[ReMark]

Maybe you did get a result but it wasn't what you were expecting. Perhaps the point I raised in my last point has been realized. That is on the first pass 16NF is changed to 16FF but on the second pass 16FF is changed back to 16NF. Maybe yes?

[ketxu]

Thanks Tharwat for your code, and others for contributing to the thought process.

Unfortunately on vanilla 2012 (with all required blocks in drawing) I get no result from running this routine? ;(

Can you post file CAD with older version, and we let to test together ^^ (Many member not use CAD12, so they can't test your drawing)

[Tharwat]

Thanks Tharwat for your code, and others for contributing to the thought process.

Unfortunately on vanilla 2012 (with all required blocks in drawing) I get no result from running this routine? ;(

 

That's because you do not have any of the blocks into your drawing , and logically it would does nothing .

 

I tested the drawing you uploaded and there is not any of the blocks that you have mentioned to replace into that drawing .

[ReMark]

No blocks? What did he do, explode them all instead?

[Tharwat]

No blocks? What did he do, explode them all instead?

 

Check the second drawing and you will find out that by your self . I am really surprised with that conflict .

[amarcon]

Okay, there seems to be a bit of confusion maybe?

I have uploaded and example showing my goal. Blocks are included with a visual to help explain. Saved in Acad2000 format.

 

Thanks Tharwat for your code, however, it doesn't seem to work. I would need some comments to decipher your clever logic. Could it be made to window 'select' an individual panel on a drawing (that contained several) instead of a global swap routine?

 

As mentioned, I wish to adjust the code to suit our final needs, I just don't know how to handle a list of blocks.

Block_Swap_Goal.dwg

[Lee Mac]

I think things are getting a little sidetracked here.

 

To clarify with everyone:

 

Tharwat's code will not work because the string comparison in their code is case-sensitive and hence not replacing any of the blocks.

 

But that is beside the point - the method being used by Tharwat is unnecessary for this task and will furthermore wipe all original block properties, such as Layer / Linetype / Lineweight / Colour etc. etc. replacing these properties with those set at the time the program is run (which may be drastically different).

 

Instead, as explained in my earlier post, since the OP's blocks are neither dynamic nor attributed (as stated in the first post), switching the block name will point the Block Reference (Insert) to a different Block Definition (Block), and will update the appearance of the block, whilst retaining all Block Reference (Insert) properties (as only the name [DXF Group 2] is changed).

 

To answer ReMark:

 

Maybe you did get a result but it wasn't what you were expecting. Perhaps the point I raised in my last point has been realized. That is on the first pass 16NF is changed to 16FF but on the second pass 16FF is changed back to 16NF. Maybe yes?

 

No, this is not a problem, as explained by Ketxu - the SelectionSet is only iterated once, hence each Block Reference (Insert) is only processed and substituted once.

 

To conclude, here is how I might approach this task, using the list shown in the OP:

 

([color=BLUE]defun[/color] c:BlockSwap ( [color=BLUE]/[/color] bf bn cmd en i lst ss )

   ([color=BLUE]setq[/color] lst
      '(
           ([color=MAROON]"16NF"[/color] . [color=MAROON]"16FF"[/color])
           ([color=MAROON]"20NF"[/color] . [color=MAROON]"20FF"[/color])
           ([color=MAROON]"24NF"[/color] . [color=MAROON]"24FF"[/color])
           ([color=MAROON]"16FF"[/color] . [color=MAROON]"16NF"[/color])
           ([color=MAROON]"20FF"[/color] . [color=MAROON]"20NF"[/color])
           ([color=MAROON]"24FF"[/color] . [color=MAROON]"24NF"[/color])
       )
   )

   ([color=BLUE]setq[/color] lst
       ([color=BLUE]mapcar[/color]
           ([color=BLUE]function[/color]
               ([color=BLUE]lambda[/color] ( x )
                   ([color=BLUE]cons[/color] ([color=BLUE]strcase[/color] ([color=BLUE]car[/color] x)) ([color=BLUE]strcase[/color] ([color=BLUE]cdr[/color] x)))
               )
           )
           lst
       )
   )

   ([color=BLUE]if[/color]
       ([color=BLUE]setq[/color] ss
           ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]
               ([color=BLUE]list[/color] '(0 . [color=MAROON]"INSERT"[/color])
                   ([color=BLUE]cons[/color] 2
                       ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color]
                           ([color=BLUE]cdr[/color]
                               ([color=BLUE]apply[/color] '[color=BLUE]append[/color]
                                   ([color=BLUE]mapcar[/color]
                                       ([color=BLUE]function[/color]
                                           ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]list[/color] [color=MAROON]","[/color] ([color=BLUE]car[/color] x)))
                                       )
                                       lst
                                   )
                               )
                           )
                       )
                   )
               )
           )
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
           ([color=BLUE]setq[/color] en ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                 bn ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]strcase[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 en))) lst))
           )
           ([color=BLUE]if[/color]
               ([color=BLUE]or[/color]
                   ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] bn)
                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bf ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=MAROON]".dwg"[/color])))
                        ([color=BLUE]progn[/color]
                            ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'CMDECHO))
                            ([color=BLUE]setvar[/color] 'CMDECHO 0)
                            ([color=BLUE]command[/color] [color=MAROON]"_.-insert"[/color] bf [color=BLUE]nil[/color])
                            ([color=BLUE]setvar[/color] 'CMDECHO cmd)
                            ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] bn)
                        )
                   )
               )
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] en ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 2 bn) ([color=BLUE]assoc[/color] 2 en) en)))
                   ([color=BLUE]entupd[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 en)))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

Type 'BlockSwap' to run the above code, edit the lst if necessary.

[alanjt]

Nicely done Lee. I hope you don't mind, but I made one minor change, just to ensure the user knows of any possible mishaps in replacements.

 

Untested, so I *hope* I didn't miss something...

 

(defun c:BlockSwap (/ bf bn cmd en i lst ss pair missed)

 (setq lst '(("16NF" . "16FF")
             ("20NF" . "20FF")
             ("24NF" . "24FF")
             ("16FF" . "16NF")
             ("20FF" . "20NF")
             ("24FF" . "24NF")
            )
 )
 (setq lst (mapcar (function (lambda (x) (cons (strcase (car x)) (strcase (cdr x))))) lst))

 (if (setq ss
            (ssget
              "_:L"
              (list
                '(0 . "INSERT")
                (cons
                  2
                  (apply 'strcat
                         (cdr (apply 'append (mapcar (function (lambda (x) (list "," (car x)))) lst)))
                  )
                )
              )
            )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq en   (entget (ssname ss (setq i (1- i))))
             bn   (cdr (assoc (strcase (cdr (assoc 2 en))) lst))
             pair (cons (strcase (cdr (assoc 2 en))) bn) ; alanjt edit
       )
       (if (and (not (member pair missed)) ; alanjt edit
                (or (tblsearch "BLOCK" bn)
                    (and (setq bf (findfile (strcat bn ".dwg")))
                         (progn (setq cmd (getvar 'CMDECHO))
                                (setvar 'CMDECHO 0)
                                (command "_.-insert" bf nil)
                                (setvar 'CMDECHO cmd)
                                (tblsearch "BLOCK" bn)
                         )
                    )
                )
           )
         (if (setq en (entmod (subst (cons 2 bn) (assoc 2 en) en)))
           (entupd (cdr (assoc -1 en)))
         )
         (if (not (member pair missed)) ; alanjt edit
           (setq missed (cons pair missed))
         )
       )
     )
     ;; alanjt edit
     (if missed
       (alert
         (apply
           'strcat
           (cons "The following replacements could not occur:\n"
                 (apply 'append (mapcar '(lambda (p) (list "\n" (car p) " -> " (cdr p))) missed))
           )
         )
       )
     )
   )
 )
 (princ)
)

Edited November 12, 2011 by alanjt

[Lee Mac]

Thanks Alan, but I don't see the point of your modification? I thought my code was fine as it was...

[alanjt]

Thanks Alan, but I don't see the point of your modification? I thought my code was fine as it was...

It was, except that, if any of the replacement blocks required could not be found, those particular blocks could not be replaced and the user would not be aware of skipped over blocks. You code just checked if a block could be replaced and if not, the user was not informed. That's the point of the modification. Looking back at my post, I put the missed list creation in the wrong spot - fixed.

[amarcon]

Job well done by all. I finally have a nice routine to add to our detailing set

I sincerely want to thank all that have participated. I love the 'friendly' rivalry here which pushes everyone to be better at all they do

 

Tharwat - your contribution got the minds a thinking. Many thanks.

Lee - your code is elegant, efficient and solved my problem..... (as you do for most). Many thanks.

Alanjt - your added 'safety net' is the icing that makes this routine friendly. Many thanks also.