Author Topic: Search for a Lisp to replace copies of original blocks with origin block  (Read 5130 times)

0 Members and 1 Guest are viewing this topic.

One Shot

  • Guest
I am working on a dwg files that was once a dgn file. When the dgn file was converted to a dwg file. I took each block and multiplied them several times over. Another words, It made the copies orginal block and gave it a name of its own. So I am searching for a way to replace all the copys of that block and replace it with the orginal. It would have to keep the same orientation of each copied block.

Please look at this file and you will see what I am up against. I would like to do this pick the original to keep and replace all the copies with it at one time.

Thank you,

Brad

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16723
  • Superior Stupidity at its best
Do you need to do this in AutoCAD?
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

SomeCallMeDave

  • Guest
This is an old routine that will insert a new block reference for each block reference in a selection set.

So if you can easily select the blockrefs you want to replace, do so,  run the routine then delete the selection set (or add the delete to the LISP routine)

I looked at your drawing, but I'm not sure which blockrefs need to be replaced.

Hope this helps.

Code: [Select]

(defun c:putblock()

   (setq InsertName (getstring T "\nEnter Block Name to Insert ")
         ss1 (ssget)
         count 0
    )
     
   (repeat (sslength ss1)
      (setq elist1 (entget (ssname ss1 count))
            code2 (cons 2 InsertName)
             code10 (assoc 10 elist1)
             code41 (assoc 41 elist1)
             code42 (assoc 42 elist1)
             code43 (assoc 43 elist1)
             code50 (assoc 50 elist1)
             code70 (assoc 70 elist1)
             code71 (assoc 71 elist1)
             code44 (assoc 44 elist1)
             code45 (assoc 45 elist1)
             code210 (assoc 210 elist1)
             count (+ count 1)
        );setq
   
      (entmake (list
      '(0 . "INSERT")
      code2
      code10
      code41
      code42
      code43
      code50
      code70
      code71
      code44
      code45
      code210
      ); end list
      ); end entmake
       
   ); end repeat

);end function


jbuzbee

  • Swamp Rat
  • Posts: 833
This works on Xrefs as well:

Code: [Select]
;;; ;
;;; Swap Block ;
;;; ;
(defun c:jbSwap( / )
  (prompt "\nSelect Blocks or Xrefs to Swap!")
  (princ "\nSelect Block to Clone:")
  (setq newBlockName(ssget ":s" '((0 . "INSERT"))))
  (if newBlockName
    (progn
      (jb:Swap(cdr(assoc 2(entget(ssname newBlockName 0)))))
    (princ "\nNot a Block!")
    )
  )
  (princ))
 

(defun jb:swapblock  (ent newBlockName / new_blk)
  (setq new_blk (subst (cons 2 newBlockName) (assoc 2 ent) ent))
  (entmod new_blk)
  (princ "\nBlock swapped!"))

(defun jb:Swap  (newBlockName / *error* a x SS NUM CNT e blk ANS new_blk)
  (defun *Error*  (Msg)
    (cond ((or (not Msg)
               (member Msg '("console break" "Function cancelled" "quit / exit abort"))))
          ((princ (strcat "\nError: " Msg))))
    (princ))
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if newBlockName
    (progn (setq x (tblsearch "block" newBlockName))
           (if x
             (progn (prompt "\nSelect blocks to be swapped: ")
                    (setq SS (ssget '((0 . "INSERT"))))))))
  (if SS
    (progn
      (setq NUM (sslength SS)
            CNT 0)
      (while (< CNT NUM)
        (setq e (ssname SS CNT))
        (cond
          ((= (vlax-property-available-p (vlax-ename->vla-object e) 'IsDynamicBlock)
              :vlax-false)
           (if (= (vlax-get (vlax-ename->vla-object e) 'IsDynamicBlock) :vlax-false)
             (jb:swapblock (entget e) newBlockName)))
          (t (jb:swapblock (entget e) newBlockName)))
        (setq CNT (1+ CNT)))
      (princ "  Done... "))
    (princ "  Nothing selected. "))
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (princ))
James Buzbee
Windows 8

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16723
  • Superior Stupidity at its best
Here is my bit of code ... I use regularly .. it changes the DXF value the user specifies. Works great for blocks ...

Specify assoc value 2 and type in the name of the block
The block name specified must exist in the drawing

Code: [Select]
;;;   ----------- ChangeDXF - Version 3.0 -----------
;;;   Copyright (C) 1997-2008  by ResourceCAD International
;;;   Author:   K.E. Blackie
;;;   
;;;   
;;;   RESOURCECAD INTERNATIONAL PROVIDES THIS PROGRAM "AS IS" AND WITH
;;;   ALL FAULTS. RESOURCECAD INTERNATIONAL SPECIFICALLY DISCLAIMS ANY
;;;   IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR
;;;   USE.  RESOURCECAD INTERNATIONAL DOES NOT WARRANT THAT THE OPERATION
;;;   OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.
;;;   
;;;   
;;;   ResouceCAD International
;;;   http://www.resourcecad.com
;;;   
;;;   DESCRIPTION
;;;   ChangeDXF will change specified DXF values of selected entities
;;;   if the selected values are legal. Limited error checking is provided
;;;   however, incorrect values may fail to apply without notification.
;;;
;;;   January 21, 1997 Original Version
;;;   May 5, 2003 Added support for more group codes
;;;   May 9, 2008 Cleaned up for mass consumption
;;;
;;;   ------------------------------------------------------------

;;; Long name
(DEFUN C:ChangeDXF()
  (C:CV)
)

;;; Short name
(DEFUN C:CV( / ss assoc_value)
 (setq ss (ssget))
 (prompt"\nAssoc value to change: ")
 (setq assoc_value (getint))
 (cond
      ((= assoc_value -1)(princ "\nCannot change entity name"))
      ((= assoc_value -2)(princ "\nCannot change reference entity name"))
      ((= assoc_value -3)(princ "\nCannot change extended data"))
      ((= assoc_value -4)(princ "\nCannot change conditional operator"))
      ((= assoc_value 0)(princ "\nCannot change entity type")) ;really you can but in most cases it will fail anyway ... try changing ATTDEF to TEXT
      ((and(> assoc_value 0)(< assoc_value 5))(chgval 1))
      ((= assoc_value 0)(CHGTXT))
      ((= assoc_value 5)(princ "\nCannot change entity handle"))
      ((and(> assoc_value 5)(< assoc_value 9))(chgval 1))
      ((and(> assoc_value 9)(< assoc_value 19))(chgval 2))
      ((and(> assoc_value 38)(< assoc_value 46))(chgval 3))
      ((and(> assoc_value 49)(< assoc_value 54))(chgval 3))
      ((and(> assoc_value 65)(< assoc_value 76))(chgval 3))
      ((= assoc_value 62)(chgval 3))
      ((= assoc_value 210)(chgval 2))
 )
 (PRINC)
)

(DEFUN CHGVAL( valtype / new_value ssl index e as )
 (prompt"\nValue to change to: ")
 (cond
   ((= valtype 1)(setq new_value (getstring t))) ;strings
   ((= valtype 2)(divine_integer (getreal)))     ;numbers
   ((= valtype 3)(setq new_value (getpoint)))    ;points
 )
 (setq ssl(sslength ss))
 (setq index 0)
 (repeat ssl
  (setq e (entget(ssname ss index)))
  (setq as (assoc assoc_value e))
  (setq e (subst (cons assoc_value new_value) as e))
  (entmod e)
  (setq index (+ 1 index))
 )
 (PRINC)
)

;;; convert to integer if the user specified a whole number
(defun divine_integer( new_value )
 (if (= new_value (fix new_value))
   (setq new_value (atoi (rtos new_value 2 0)))
 )
)

Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

One Shot

  • Guest
Do you need to do this in AutoCAD?

Yes, this is for AutoCAD.  Please list all the blocks and you will see duplicates of the original.  Example for block name CHE.  Then you will see CHEA_1 and etc....

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16723
  • Superior Stupidity at its best
The code I posted will make it very easy
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

One Shot

  • Guest
The code I posted will make it very easy
Keith,

It works good.  Is there a way to designate which blocks with the the original name an replace each group one group at a time?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16723
  • Superior Stupidity at its best
I am sure there is .. I always just select the block to replace ... I don't have time to mess with it right now though
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

One Shot

  • Guest
Keith,

No rush, I will try it to see of a way.

T.Willey

  • Needs a day job
  • Posts: 5218
Since you are trying, here is a fish.  It will rename all the blocks that have an underscore followed by numbers to the block name that is before the underscore.  So block 'CHA_3' will now be named 'CHA'.  It seems to work because it purged out all the blocks that it should have after I can the code.

Let me know if you need help understanding the code.  One thing I should mentions is that it will error if items are on locked layers, like some were, so I had to unlock all layers and run the command.
Code: [Select]
(defun c:Test (/ ActDoc bAllNumbers Pos tempPos tempName)
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (if (ssget "x" '((0 . "INSERT")))
        (vlax-for obj (vla-get-ActiveSelectionSet ActDoc)
            (setq bAllNumbers T)
            (if
                (and
                    (setq Pos (vl-string-search "_" (setq tempName (vla-get-Name obj))))
                    (setq tempPos (+ 2 Pos))
                    (progn
                        (while (<= tempPos (strlen tempName))
                            (if (not (<= 48 (ascii (substr tempName tempPos 1)) 57))
                                (setq bAllNumbers nil)
                            )
                            (setq tempPos (1+ tempPos))
                        )
                        bAllNumbers
                    )
                    (tblsearch "block" (substr tempName 1 Pos))
                )
                (vla-put-Name obj (substr tempName 1 Pos))
            )
        )
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)
Quote from: Purge after command
Deleting block "*U201".
Deleting block "475A_1".
Deleting block "475A_2".
Deleting block "475A_3".
Deleting block "ACD224_1".
Deleting block "ACD224_2".
Deleting block "ACD224_3".
Deleting block "ACR22_1".
Deleting block "ACR22_2".
Deleting block "ACR22_3".
Deleting block "ACR22_4".
Deleting block "ACR22_5".
Deleting block "ACRTRN_1".
Deleting block "ACRTRN_2".
Deleting block "ACRTRN_3".
Deleting block "ACRTRN_4".
Deleting block "ACRTRN_5".
Deleting block "CHEA_10".
Deleting block "CHEA_11".
Deleting block "CHEA_12".
Deleting block "CHEA_13".
Deleting block "CHEA_14".
Deleting block "CHEA_15".
Deleting block "CHEA_16".
Deleting block "CHEA_17".
Deleting block "CHEA_18".
Deleting block "CHEA_19".
Deleting block "CHEA_2".
Deleting block "CHEA_20".
Deleting block "CHEA_3".
Deleting block "CHEA_4".
Deleting block "CHEA_5".
Deleting block "CHEA_6".
Deleting block "CHEA_7".
Deleting block "CHEA_8".
Deleting block "CHEA_9".
Deleting block "CHR09_1".
Deleting block "CHR09_10".
Deleting block "CHR09_11".
Deleting block "CHR09_12".
Deleting block "CHR09_13".
Deleting block "CHR09_14".
Deleting block "CHR09_17".
Deleting block "CHR09_18".
Deleting block "CHR09_19".
Deleting block "CHR09_2".
Deleting block "CHR09_20".
Deleting block "CHR09_3".
Deleting block "CHR09_4".
Deleting block "CHR09_5".
Deleting block "CHR09_6".
Deleting block "CHR09_7".
Deleting block "CHR09_8".
Deleting block "CHR09_9".
Deleting block "CHR10_1".
Deleting block "CHR10_10".
Deleting block "CHR10_11".
Deleting block "CHR10_12".
Deleting block "CHR10_13".
Deleting block "CHR10_14".
Deleting block "CHR10_15".
Deleting block "CHR10_16".
Deleting block "CHR10_17".
Deleting block "CHR10_18".
Deleting block "CHR10_19".
Deleting block "CHR10_2".
Deleting block "CHR10_20".
Deleting block "CHR10_21".
Deleting block "CHR10_22".
Deleting block "CHR10_23".
Deleting block "CHR10_24".
Deleting block "CHR10_25".
Deleting block "CHR10_26".
Deleting block "CHR10_27".
Deleting block "CHR10_28".
Deleting block "CHR10_29".
Deleting block "CHR10_3".
Deleting block "CHR10_30".
Deleting block "CHR10_31".
Deleting block "CHR10_32".
Deleting block "CHR10_33".
Deleting block "CHR10_34".
Deleting block "CHR10_35".
Deleting block "CHR10_36".
Deleting block "CHR10_37".
Deleting block "CHR10_38".
Deleting block "CHR10_39".
Deleting block "CHR10_4".
Deleting block "CHR10_40".
Deleting block "CHR10_41".
Deleting block "CHR10_42".
Deleting block "CHR10_43".
Deleting block "CHR10_44".
Deleting block "CHR10_45".
Deleting block "CHR10_46".
Deleting block "CHR10_47".
Deleting block "CHR10_48".
Deleting block "CHR10_49".
Deleting block "CHR10_5".
Deleting block "CHR10_50".
Deleting block "CHR10_51".
Deleting block "CHR10_52".
Deleting block "CHR10_53".
Deleting block "CHR10_6".
Deleting block "CHR10_7".
Deleting block "CHR10_8".
Deleting block "CHR10_9".
Deleting block "CHR33_1".
Deleting block "CHR33_2".
Deleting block "CHR33_3".
Deleting block "CHRE1_1".
Deleting block "DF_1".
Deleting block "DF_2".
Deleting block "DL36_1".
Deleting block "DL36_2".
Deleting block "DL36_3".
Deleting block "DL36_4".
Deleting block "DOT_6".
Deleting block "DOT_8".
Deleting block "DR36_1".
Deleting block "DR36_10".
Deleting block "DR36_11".
Deleting block "DR36_2".
Deleting block "DR36_3".
Deleting block "DR36_4".
Deleting block "DR36_5".
Deleting block "DR36_6".
Deleting block "DR36_7".
Deleting block "DR36_8".
Deleting block "DR36_9".
Deleting block "ESIGN_1".
Deleting block "KWS48_1".
Deleting block "KWS48_10".
Deleting block "KWS48_11".
Deleting block "KWS48_12".
Deleting block "KWS48_13".
Deleting block "KWS48_14".
Deleting block "KWS48_15".
Deleting block "KWS48_16".
Deleting block "KWS48_17".
Deleting block "KWS48_18".
Deleting block "KWS48_19".
Deleting block "KWS48_20".
Deleting block "KWS48_21".
Deleting block "KWS48_24".
Deleting block "KWS48_8".
Deleting block "KWS48_9".
Deleting block "L1X1_1".
Deleting block "ORG24A_1".
Deleting block "ORG42B_1".
Deleting block "RECPT_7".
Deleting block "SPHD_1".
Deleting block "SPHD_2".
Deleting block "SPHD_3".
Deleting block "SPHD_4".
Deleting block "SPHD_5".
Deleting block "SPKR_1".
Deleting block "T4830_1".
Deleting block "TB24_1".
Deleting block "TB24_10".
Deleting block "TB24_11".
Deleting block "TB24_12".
Deleting block "TB24_2".
Deleting block "TB24_3".
Deleting block "TB24_4".
Deleting block "TB24_5".
Deleting block "TB24_6".
Deleting block "TB24_7".
Deleting block "TB24_8".
Deleting block "TB24_9".
Deleting block "TLPL07_10".
Deleting block "TLPL07_11".
Deleting block "TLPL07_12".
Deleting block "TLPL07_13".
Deleting block "TLPL07_14".
Deleting block "TLPL07_15".
Deleting block "TLPL07_16".
Deleting block "TLPL07_17".
Deleting block "TLPL07_18".
Deleting block "TLPL07_19".
Deleting block "TLPL07_20".
Deleting block "TLPL07_21".
Deleting block "TLPL07_22".
Deleting block "TLPL07_23".
Deleting block "TLPL07_24".
Deleting block "TLPL07_25".
Deleting block "TLPL07_26".
Deleting block "TLPL07_5".
Deleting block "TLPL07_6".
Deleting block "TLPL07_7".
Deleting block "TLPL07_8".
Deleting block "TLPL07_9".
Deleting block "WS7242_1".
Deleting block "WS7242_10".
Deleting block "WS7242_11".
Deleting block "WS7242_12".
Deleting block "WS7242_13".
Deleting block "WS7242_15".
Deleting block "WS7242_2".
Deleting block "WS7242_3".
Deleting block "WS7242_4".
Deleting block "WS7242_5".
Deleting block "WS7242_6".
Deleting block "WS7242_7".
Deleting block "WS7242_8".
Deleting block "WS7242_9".
206 blocks deleted.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

One Shot

  • Guest
Tim,

Thank you very much for the fish!  I am trying to get back into lisp after not doing it for 2 years now.  I will give it a test run and will get back to you with questions.

Brad


Since you are trying, here is a fish.  It will rename all the blocks that have an underscore followed by numbers to the block name that is before the underscore.  So block 'CHA_3' will now be named 'CHA'.  It seems to work because it purged out all the blocks that it should have after I can the code.

Let me know if you need help understanding the code.  One thing I should mentions is that it will error if items are on locked layers, like some were, so I had to unlock all layers and run the command.
Code: [Select]
(defun c:Test (/ ActDoc bAllNumbers Pos tempPos tempName)
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (if (ssget "x" '((0 . "INSERT")))
        (vlax-for obj (vla-get-ActiveSelectionSet ActDoc)
            (setq bAllNumbers T)
            (if
                (and
                    (setq Pos (vl-string-search "_" (setq tempName (vla-get-Name obj))))
                    (setq tempPos (+ 2 Pos))
                    (progn
                        (while (<= tempPos (strlen tempName))
                            (if (not (<= 48 (ascii (substr tempName tempPos 1)) 57))
                                (setq bAllNumbers nil)
                            )
                            (setq tempPos (1+ tempPos))
                        )
                        bAllNumbers
                    )
                    (tblsearch "block" (substr tempName 1 Pos))
                )
                (vla-put-Name obj (substr tempName 1 Pos))
            )
        )
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)
Quote from: Purge after command
Deleting block "*U201".
Deleting block "475A_1".
Deleting block "475A_2".
Deleting block "475A_3".
Deleting block "ACD224_1".
Deleting block "ACD224_2".
Deleting block "ACD224_3".
Deleting block "ACR22_1".
Deleting block "ACR22_2".
Deleting block "ACR22_3".
Deleting block "ACR22_4".
Deleting block "ACR22_5".
Deleting block "ACRTRN_1".
Deleting block "ACRTRN_2".
Deleting block "ACRTRN_3".
Deleting block "ACRTRN_4".
Deleting block "ACRTRN_5".
Deleting block "CHEA_10".
Deleting block "CHEA_11".
Deleting block "CHEA_12".
Deleting block "CHEA_13".
Deleting block "CHEA_14".
Deleting block "CHEA_15".
Deleting block "CHEA_16".
Deleting block "CHEA_17".
Deleting block "CHEA_18".
Deleting block "CHEA_19".
Deleting block "CHEA_2".
Deleting block "CHEA_20".
Deleting block "CHEA_3".
Deleting block "CHEA_4".
Deleting block "CHEA_5".
Deleting block "CHEA_6".
Deleting block "CHEA_7".
Deleting block "CHEA_8".
Deleting block "CHEA_9".
Deleting block "CHR09_1".
Deleting block "CHR09_10".
Deleting block "CHR09_11".
Deleting block "CHR09_12".
Deleting block "CHR09_13".
Deleting block "CHR09_14".
Deleting block "CHR09_17".
Deleting block "CHR09_18".
Deleting block "CHR09_19".
Deleting block "CHR09_2".
Deleting block "CHR09_20".
Deleting block "CHR09_3".
Deleting block "CHR09_4".
Deleting block "CHR09_5".
Deleting block "CHR09_6".
Deleting block "CHR09_7".
Deleting block "CHR09_8".
Deleting block "CHR09_9".
Deleting block "CHR10_1".
Deleting block "CHR10_10".
Deleting block "CHR10_11".
Deleting block "CHR10_12".
Deleting block "CHR10_13".
Deleting block "CHR10_14".
Deleting block "CHR10_15".
Deleting block "CHR10_16".
Deleting block "CHR10_17".
Deleting block "CHR10_18".
Deleting block "CHR10_19".
Deleting block "CHR10_2".
Deleting block "CHR10_20".
Deleting block "CHR10_21".
Deleting block "CHR10_22".
Deleting block "CHR10_23".
Deleting block "CHR10_24".
Deleting block "CHR10_25".
Deleting block "CHR10_26".
Deleting block "CHR10_27".
Deleting block "CHR10_28".
Deleting block "CHR10_29".
Deleting block "CHR10_3".
Deleting block "CHR10_30".
Deleting block "CHR10_31".
Deleting block "CHR10_32".
Deleting block "CHR10_33".
Deleting block "CHR10_34".
Deleting block "CHR10_35".
Deleting block "CHR10_36".
Deleting block "CHR10_37".
Deleting block "CHR10_38".
Deleting block "CHR10_39".
Deleting block "CHR10_4".
Deleting block "CHR10_40".
Deleting block "CHR10_41".
Deleting block "CHR10_42".
Deleting block "CHR10_43".
Deleting block "CHR10_44".
Deleting block "CHR10_45".
Deleting block "CHR10_46".
Deleting block "CHR10_47".
Deleting block "CHR10_48".
Deleting block "CHR10_49".
Deleting block "CHR10_5".
Deleting block "CHR10_50".
Deleting block "CHR10_51".
Deleting block "CHR10_52".
Deleting block "CHR10_53".
Deleting block "CHR10_6".
Deleting block "CHR10_7".
Deleting block "CHR10_8".
Deleting block "CHR10_9".
Deleting block "CHR33_1".
Deleting block "CHR33_2".
Deleting block "CHR33_3".
Deleting block "CHRE1_1".
Deleting block "DF_1".
Deleting block "DF_2".
Deleting block "DL36_1".
Deleting block "DL36_2".
Deleting block "DL36_3".
Deleting block "DL36_4".
Deleting block "DOT_6".
Deleting block "DOT_8".
Deleting block "DR36_1".
Deleting block "DR36_10".
Deleting block "DR36_11".
Deleting block "DR36_2".
Deleting block "DR36_3".
Deleting block "DR36_4".
Deleting block "DR36_5".
Deleting block "DR36_6".
Deleting block "DR36_7".
Deleting block "DR36_8".
Deleting block "DR36_9".
Deleting block "ESIGN_1".
Deleting block "KWS48_1".
Deleting block "KWS48_10".
Deleting block "KWS48_11".
Deleting block "KWS48_12".
Deleting block "KWS48_13".
Deleting block "KWS48_14".
Deleting block "KWS48_15".
Deleting block "KWS48_16".
Deleting block "KWS48_17".
Deleting block "KWS48_18".
Deleting block "KWS48_19".
Deleting block "KWS48_20".
Deleting block "KWS48_21".
Deleting block "KWS48_24".
Deleting block "KWS48_8".
Deleting block "KWS48_9".
Deleting block "L1X1_1".
Deleting block "ORG24A_1".
Deleting block "ORG42B_1".
Deleting block "RECPT_7".
Deleting block "SPHD_1".
Deleting block "SPHD_2".
Deleting block "SPHD_3".
Deleting block "SPHD_4".
Deleting block "SPHD_5".
Deleting block "SPKR_1".
Deleting block "T4830_1".
Deleting block "TB24_1".
Deleting block "TB24_10".
Deleting block "TB24_11".
Deleting block "TB24_12".
Deleting block "TB24_2".
Deleting block "TB24_3".
Deleting block "TB24_4".
Deleting block "TB24_5".
Deleting block "TB24_6".
Deleting block "TB24_7".
Deleting block "TB24_8".
Deleting block "TB24_9".
Deleting block "TLPL07_10".
Deleting block "TLPL07_11".
Deleting block "TLPL07_12".
Deleting block "TLPL07_13".
Deleting block "TLPL07_14".
Deleting block "TLPL07_15".
Deleting block "TLPL07_16".
Deleting block "TLPL07_17".
Deleting block "TLPL07_18".
Deleting block "TLPL07_19".
Deleting block "TLPL07_20".
Deleting block "TLPL07_21".
Deleting block "TLPL07_22".
Deleting block "TLPL07_23".
Deleting block "TLPL07_24".
Deleting block "TLPL07_25".
Deleting block "TLPL07_26".
Deleting block "TLPL07_5".
Deleting block "TLPL07_6".
Deleting block "TLPL07_7".
Deleting block "TLPL07_8".
Deleting block "TLPL07_9".
Deleting block "WS7242_1".
Deleting block "WS7242_10".
Deleting block "WS7242_11".
Deleting block "WS7242_12".
Deleting block "WS7242_13".
Deleting block "WS7242_15".
Deleting block "WS7242_2".
Deleting block "WS7242_3".
Deleting block "WS7242_4".
Deleting block "WS7242_5".
Deleting block "WS7242_6".
Deleting block "WS7242_7".
Deleting block "WS7242_8".
Deleting block "WS7242_9".
206 blocks deleted.

One Shot

  • Guest
Tim,
 I dno't know how to modify the code to search in existing and unname blocks for the routine to work.  It ran really great.  Also, if you get a chance would you be willing to help me understand the code?

Thank you,

Brad

T.Willey

  • Needs a day job
  • Posts: 5218
Tim,
 I dno't know how to modify the code to search in existing and unname blocks for the routine to work.  It ran really great.  Also, if you get a chance would you be willing to help me understand the code?

Thank you,

Brad
Brad,

  If you want to search all blocks to rename the nested ones, then I would step through the block collection.  That way it will check almost everyplace that a block can be inserted.

When I get a chance I will comment up the code.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5218
Hope this clears it up for you, so you can understand it a little better Brad.
Code: [Select]
(defun c:Test (/ ActDoc bAllNumbers Pos tempPos tempName)
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    ; get the active drawing
    (vla-EndUndoMark ActDoc)
    ; end any undo mark that might be left open, pecautionary device
    (vla-StartUndoMark ActDoc)
    ; start our own undo mark, so a single undo will undo the whole code
    (if (ssget "x" '((0 . "INSERT")))
    ; if a valid selection set of inserts is gotten, then do what follows
        (vlax-for obj (vla-get-ActiveSelectionSet ActDoc)
        ; lets step through the selection set of the active drawing, but as vla-objects instead of enames
            (setq bAllNumbers T)
            ; set a variable that will let us know that all the characters following the underscore are numbers
            (if
                (and
                    (setq Pos (vl-string-search "_" (setq tempName (vla-get-Name obj))))
                    ; if there is an underscore in the string set the variable Pos to the position of it
                    (setq tempPos (+ 2 Pos))
                    ; vl-string-search starts at index 0, but substr starts at index 1, so we have to add 2 character positions
                    ; to get the first character after the underscore
                    (progn
                    ; we use progrn, because we only care that the last value, which will be returned, will be true, since we use an 'and' statement
                        (while (<= tempPos (strlen tempName))
                        ; while our test position 'tempos' is less than or equal to the number of characters in the string, run what is below
                            (if (not (<= 48 (ascii (substr tempName tempPos 1)) 57))
                            ; if the character is not a number, detrimed by if the ascii character value is between 48 and 57 or equal to the lowest or greatest
                                (setq bAllNumbers nil)
                                ; if it's not a number, set our variable to nil
                            )
                            (setq tempPos (1+ tempPos))
                            ; set our test postion to the next character
                        )
                        bAllNumbers
                        ; return the check to see if they are all numbers after the underscore
                    )
                    (tblsearch "block" (substr tempName 1 Pos))
                    ; this tests to make sure that the block we are going to rename the block to, if it passed all the tests before this one,
                    ; exists in the drawing
                )
                ; this will only be true only if all the tests are passed
                (vla-put-Name obj (substr tempName 1 Pos))
                ; since it passed all the tests, change the name to be the name minus the underscore and everything after it.
            )
        )
    )
    (vla-EndUndoMark ActDoc)
    ; end our undo mark
    (princ)
    ; exit quietly
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.