Topic: Re-defining blocks

[hudster]

I'm trying to write a lisp that will get a list of the blocks in a drawing and re-define them using the standard blocks we use in our office.

I have this piece of code.

Code: [Select]

(defun c:REDEF ()
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (command "-insert" "SS=C:/RYBKA_BLOCKS/BLOCKS/" SS)
  (command)
  (PRINC)
)


but it down't work, it gets the list, but how do i get it to redefine each block on the list?

[CAB]

http://theswamp.org/phpBB2/viewtopic.php?t=977&highlight=insert+replace

http://theswamp.org/phpBB2/viewtopic.php?t=299&highlight=insert+replace

[hudster]

I had already looked both those threads, but they don't quite do what I want them to.

This piece of code

Code: [Select]


(command "-insert" "titleblock=c:/blks/titleblocks/titleblock")(command)

is almost there, but how do i substitute the "titleblock= " part of it so it uses the block list obtained by the

Code: [Select]

(setq ss (ssget "_X" '((0 . "INSERT"))))

[CAB]

Something like this.. untested..

Code: [Select]

(defun c:REDEF ()
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (setq idx (sslength ss))
  (while (>= (setq idx (1- idx)) 0)
    (setq blknm (ssname ss idx))
    (command "-insert" (strcat blknm "=C:/RYBKA_BLOCKS/BLOCKS/" blknm))
    (command)
  )
  (PRINC)
)

[hudster]

When I run this I get the following message.

Code: [Select]

Command: REDEF ; error: bad argument type: stringp <Entity name: 7e830f60>
Enter block name or [?] <A$C6F405EDD>:


[CAB]

Sorry about that...  routine needed the acutal block name

Code: [Select]

(defun c:REDEF ()
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (setq idx (sslength ss))
  (while (>= (setq idx (1- idx)) 0)
    (setq blknm (cdr (assoc 2 (entget(ssname ss idx)))))
    (command "-insert" (strcat blknm "=C:/RYBKA_BLOCKS/BLOCKS/" blknm))
    (command)
  )
  (PRINC)
)

[hudster]

Brilliant.

your definately THE DADDY.

[CAB]

Glad it worked for you, it's quick and dirty.
Not sure how it would do with x-ref's, it may choke.

Be aware that if the block is not found you don't get any warning.

CAB

I take that back, you get a message at the command line if it fails
to replace the block or if it is an x-ref.

[CAB]

Here are some more elaborate routines.
I have not tried them.

Code: [Select]

(defun c:rb (/ entiteold entitenew eoname enname jeusel1 i ent_actu
             ent_data)
  (setvar "cmdecho" 0)
  (command "_.undo" "_begin")

  (princ "automatically substitute blocks within a selection\n")
  (setq entiteold
         (car (entsel
                "pick a block, the type which will be replaced\n"))
  )
  (setq entitenew (car (entsel "pick a block of the new type\n")))
  (setq eoname (cdr (assoc 2 (entget entiteold))))
  (princ eoname)
  (princ " -> ")
  (setq enname (cdr (assoc 2 (entget entitenew))))
  (princ enname)
  (if (/= (liste_att_ds_bloc entiteold) nil)
    (alert (strcat "Warning, the replaced block contains attributes "
                   "\n \n This can give unexpected results "
                   "\n \n Use ATTREDEF instead.")
    )
  )

  (if (/= (liste_att_ds_bloc entitenew) nil)
    (alert (strcat "Warning, the replacement block contains attributes "
                   "\n \n This can give unexpected results"
                   "\n \n Use ATTREDEF instead.")
    )
  )

  (princ (strcat"\n Select objects for which the replacement will be performed "
                "[do an empty selection to perform on entire drawing] :")
  )

  (setq jeusel1 (ssget (list (cons 0 "INSERT") (cons 2 eoname))))

  (if (= jeusel1 nil)
    (setq jeusel1 (ssget "x" (list (cons 0 "INSERT") (cons 2 eoname))))
  )

  (setq i 0)
  (repeat (sslength jeusel1)
    (setq ent_actu (ssname jeusel1 i)
          ent_data (entget ent_actu)
    ) ;setq
    (setq i (1+ i))

    (setq ent_data (subst (cons 2 enname) (assoc 2 ent_data) ent_data))
    (entmod ent_data)

  ) ;repeat

  (command "_.undo" "_end")
  (setvar "cmdecho" 1)
  (princ)

)

Code: [Select]

;Here is a little code I had that will do this. It will also swap one attribute.
 
;Peter Jamtgaard
 
;****************************RBLKS.LSP*******************************************
; Written By   : Peter Jamtgaard
;.Purpose<RBLKS>: Replaces Selected BLOCKS with another picked BLOCK
;******************************************************************************
(defun rtd (a)(/ (* a 180.0) pi)) ;.radians to degrees    z
(defun C:RBLKS () ;.REPLACE BLOCKS
 (setvar "ATTDIA" 0)
 (setq OLDATT nil)
 (princ "\nSelect BLOCKS to be replaced: ")
 (setq B 0 C 0)
;****************************************************************************
 (setq SSET (ssget))
 (if (= SSET nil)
  (progn
   (princ "\nNo entities were selected: ")
   (setq B 1)
  )
  (progn
   (setq NEWBLK (car (entsel "\nSelect block replacement: ")));new block name
   (setq NEWLAYR (cdr (assoc 8 (entget NEWBLK))))          ;new lyr ent name
   (setq NEWLT (cdr (assoc 6 (entget NEWBLK))))            ;new lt ent name
   (setq NEWCLR (cdr (assoc 62 (entget NEWBLK))))          ;new clr ent name
   (setq NEWTYPE (cdr (assoc 0 (entget NEWBLK))))          ;new ent type test
   (if (= NEWTYPE "INSERT")
    (setq B 0)
    (progn
     (princ "\nYour last selection was not a block: ")
     (setq B 1)
    )
   )
  )
 )
;****************************************************************************
 (while (= B 0)
  (setq OLDENT (ssname SSET C));old BLOCK name
  (if (= OLDENT nil)(setq B 1)
   (progn
    (setq OLDED (entget OLDENT))
    (setq OLDTYPE (cdr (assoc 0 OLDED)))          ;old ent type test
    (if (/= OLDTYPE "INSERT")(setq SSET (ssdel OLDENT SSET))
     (progn
      (setq OLDBLK OLDENT)
      (setq SCX (cdr (assoc 41 OLDED)))             ;old blk insertion
      (setq SCY (cdr (assoc 42 OLDED)))
      (setq ROT (rtd (cdr (assoc 50 OLDED))))       ;old blk rotation
      (setq INS (cdr (assoc 10 OLDED)))             ;old blk insertion
      (setq OLDTYPE (cdr (assoc 0 OLDED)))          ;old ent type test
      (setq REP (cdr (assoc 2 (entget NEWBLK))))              ;blk name replacement
      (if (= (entnext OLDBLK) nil)(princ)
       (if (= "ATTRIB" (cdr (assoc 0 (entget (entnext OLDBLK)))))
        (progn
         (setq OLDATT (cdr (assoc 1 (entget (entnext OLDBLK)))));Old Att. Value
         (setq OLDATTANG (cdr (assoc 50 (entget (entnext OLDBLK)))));Old Att. Angle
         (setq OLDATTWID (cdr (assoc 41 (entget (entnext OLDBLK)))));Old Att. Width
        )
        (princ "\nOld BLOCK didn't contain attributes: ")
       )
      )
      (if (= "INSERT" OLDTYPE)        ;test valid input
       (progn
        (command "INSERT" REP INS SCX SCY ROT);Insert NEWBLK over OLDBLK
        (setq ENT (entlast))
        (setq ED (entget ENT))
        (setq ED (subst (cons 8 NEWLAYR) (assoc 8 ED) ED))
        (if (= OLDATT nil)
         (princ)
         (progn
          (setq NENT (entnext ENT))
          (if (= NENT nil)(princ "\nLast Block has no attributes: ")
           (progn
            (setq NED (entget NENT))
            (setq NENTTYPE  (cdr (assoc 0 NED)))
            (if (= NENTTYPE "ATTRIB")
             (progn
              (setq NED (subst (cons 1 OLDATT)(assoc 1 NED) NED))
              (setq NED (subst (cons 50 OLDATTANG)(assoc 50 NED) NED))
              (setq NED (subst (cons 41 OLDATTWID)(assoc 41 NED) NED))
              (entmod NED)
             )
             (princ "\nNew Symbol doesn't contain Attributes: ")
            )
           )
          )
         )
        )    
        (entmod ED)
        (if (/= NEWLT nil)
         (command "CHANGE" ENT "" "P" "LT" NEWLT "")
        )
        (if (/= NEWCLR nil)
         (command "CHANGE" ENT "" "P" "C" NEWCLR "")
        )
        (setq C (+ C 1))
        (princ "\nC+ ")
       )
       (progn
        (princ "\nInvalid entity: ")
        (setq B 1)
       )
      )
     )
    )
   )
  )
 )
 (command "erase" sset "")
 (setvar "attdia" 1)
 (prin1)
)