Author Topic: Block Cleanup and Update Routine  (Read 3362 times)

0 Members and 1 Guest are viewing this topic.


  • Newt
  • Posts: 55
Block Cleanup and Update Routine
« on: September 20, 2006, 08:01:01 AM »
Hi Swamp Members:

I have inherited a mess of drawings where I need to perform a lot of cleanup and reorganizing to get the blocks on the drawings standardized to company format and in usable shape.

I am relatively new to VBA and have been trying to develop a routine that could be used on a selected group of drawings and provide buttons with the following options:

1) Rename blocks on the drawings
2) Redefine blocks on the drawings
3) Replace blocks on the drawings (replace existing existing blocks with new ones)
4) Update a block and sync the attributes on the drawings

So far I have had little success in accomplishing this task.....can anyone provide some assistance or give me direction as to where I could find the sub-routines I am looking for or do some research to develop them.

Any help would be appreciated.....!



  • Guest
Re: Block Cleanup and Update Routine
« Reply #1 on: September 20, 2006, 12:41:29 PM »
This might help you for a part of it. This was originally written to changeout an old title block for a new one.
The piece below creates the Selection set of block references. I'm using an array of block names as my list. This allows me to handle different blocks in different manners. Once I find a block I'm looking for, the insert point, scale, and rotation angle are stored in variables to use later. If there are attributes these are stored an an array so that the values are not destroyed when the block is deleted.

Code: [Select]
Set objAcadSSet = ThisDrawing.SelectionSets.Add("sSet2")
intTextCodes(0) = 0 'set code for entities
varCodeValues(0) = "INSERT" 'set entity type to filter
objAcadSSet.Select acSelectionSetAll, , , intTextCodes, varCodeValues   'create set

For Each objOldBlk In objAcadSSet
   BName = UCase(objOldBlk.Name)
      Select Case BName
          Case arOldBlkNames(0)     'ctml0011
              InsertPt(0) = objOldBlk.InsertionPoint(0)
              InsertPt(1) = objOldBlk.InsertionPoint(1)
              InsertPt(2) = objOldBlk.InsertionPoint(2)
              xScale = objOldBlk.XScaleFactor
              yScale = objOldBlk.YScaleFactor
              zScale = objOldBlk.ZScaleFactor
              Rot = objOldBlk.Rotation
           If objOldBlk.HasAttributes Then
              varOldAtt = objOldBlk.GetAttributes     'get block attributes
            End If
          For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
            Set objOldAttRef = varOldAtt(intOldCnt)
          Next intOldCnt
            NewBlkName = "CTML0013.dwg"

And this piece is the new block going back in with the attributes fed back in.

Code: [Select]
Case arOldBlkNames(0)         'CTMl0011
   Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot) 'insert new tblock
   varNewAtt = objNewBlk.GetAttributes 'get attributes

   For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
       For intNewCnt = LBound(varNewAtt) To UBound(varNewAtt)
            If varNewAtt(intNewCnt).TagString = varOldAtt(intOldCnt).TagString Then
                varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If


  • Bull Frog
  • Posts: 305
  • CAD Programmer
Re: Block Cleanup and Update Routine
« Reply #2 on: September 26, 2006, 03:26:41 PM »
Hi Swamp Members:

1) Rename blocks on the drawings

Any help would be appreciated.....!


I will cherry-pick the easy one.

Thisdrawing.Blocks("OldBlockName").Name = "NewBlockName"
It's amazing what you can do when you don't know what you can't do.
CAD Programming Solutions


  • Guest
Re: Block Cleanup and Update Routine
« Reply #3 on: September 28, 2006, 06:24:18 AM »
Hi, Vince

Here is my poor attemt to solve your task,
not completed though :(




  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Block Cleanup and Update Routine
« Reply #4 on: September 28, 2006, 06:33:50 AM »
All of those tasks have tools written for them in either ACAD or express tools. Just have a look at your menus ...
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.