cycling thru blocks in a selection set..

September 25, 2008

Hi, I hope someone can explain this to me a little. i have (with a lot of help from this forum) wrote some code that allows the selection of a block with attributes, certain attribute values are saved, the code then deletes the block, then the user is allowed to select a point on the drawing to insert the new block. the values from the old block are then transferred over to the new block. the user then goes over to the next block and does the process again. what i would like to do is change the code so that when you run the code makes autocad select every block with a specific name saves the attributes of each block in a array it then inserts the new block into the same insertion point as the old block.

I think the code I have already achieves a lot of these things the only thing I need to add is for the block to select all blocks with a specific name then to set up a array to do a For I = cnt (cnt being the top number of blocks selected) then cycle thru my existing code with the only change being the insertion point changing from allowing the user to select to grabbing the old block insertion point and inserting the name block in the same point.

My code for the code that works by selecting a block at a time is

Public Sub BRPT1_StorAttValues()

   Dim MyBlockRef As AcadBlockReference
   Dim myvaratt As Variant
   Dim i As Double
   Dim MyoEnt As AcadEntity
   Dim MyBlockObj As AcadBlock
   Dim OLD_BLOCK_NAME As String
   Dim NEW_BLOCK_NAME As String
   'Dim MyAttTextStr As String
   
   MyAttTextStr_Old_1 = "ROOM_NUMBER"
   MyAttTextStr_Old_2 = "HEIGHT"
   MyAttTextStr_Old_3 = "COMMENT"
   
NEW_BLOCK_NAME = "LEVEL4_ATTBLOCK"   ''''change 'the text to current 'new block name'


   On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
       Set MyOldBlockObjSS = ThisDrawing.SelectionSets.Add("SelectBlock")

       '' let user select entities interactively
       MyOldBlockObjSS.SelectOnScreen

        'MyObjSS.SelectOnScreen FilterType, FilterData
        'MyObjSS.Select acSelectionSetAll 'FilterType, FilterData
       '' highlight the selected entities
       MyOldBlockObjSS.Highlight True
       
       '' pause for the user
       .prompt vbCr & MyOldBlockObjSS.Count & " entities selected"
       '.GetString False, vbLf & "Enter to continue "

       For Each MyoEnt In MyOldBlockObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
                   If myvaratt(i).TagString = MyAttTextStr_Old_1 Then
                       'myvaratt(i).TextString = "Test"
                       MyAttTextStr1 = myvaratt(i).TextString
                           myvaratt(i).Update
                          
                   End If
               Next
           End If
       Next
'End With

       For Each MyoEnt In MyOldBlockObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
                   If myvaratt(i).TagString = MyAttTextStr_Old_2 Then
                       'myvaratt(i).TextString = "Test"
                       MyAttTextStr2 = myvaratt(i).TextString
                           myvaratt(i).Update
                           
                        
                   End If
               Next
           End If
       Next
'End With

       For Each MyoEnt In MyOldBlockObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
                   If myvaratt(i).TagString = MyAttTextStr_Old_3 Then
                       'myvaratt(i).TextString = "Test"
                       MyAttTextStr3 = myvaratt(i).TextString
                           myvaratt(i).Update
                           
                        
                   End If
               Next
           End If
       Next
End With


MyAttTextStr1 = Right$(MyAttTextStr1, 3)
   MyAttTextStr2 = Right$(MyAttTextStr2, 4)
   
           MyAttTextStr2 = MyAttTextStr2 / 1000#


MyAttTextStr2 = Round(MyAttTextStr2, 2#)


                    ' DO NOT DELETE KEEP FOR CHECKING
                  ' MsgBox (MyAttTextStr1)
                   'MsgBox (MyAttTextStr2)
                  ' MsgBox (MyAttTextStr3)
   

    
                           MyOldBlockObjSS.Erase
                           
      BRPT2_InsertingBlockWithNewValues
      
  End Sub



Sub BRPT2_InsertingBlockWithNewValues()

   ' Define the block
'Dim MyAttTextStr As String
   Dim blockObj As AcadBlock
   Dim insertionPnt(0 To 2) As Double
   insertionPnt(0) = 0
   insertionPnt(1) = 0
   insertionPnt(2) = 0
   'Set blockObj = ThisDrawing.Blocks.Add _
                    '(insertionPnt, "LEVEL4_ATTBLOCK")
                       '(insertionPnt, "APA013")

Dim MyInsertPt As Variant
MyInsertPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick insertion point: ")

   ' Insert the block
   Dim blockrefobj As AcadBlockReference
   
   Myblockrefobj = "LEVEL4_ATTBLOCK"
   'Myblockrefobj = "APA013"
   
                   Set blockrefobj = ThisDrawing.ModelSpace.InsertBlock _
               (MyInsertPt, Myblockrefobj, 1#, 1#, 1#, 0)
   'ZoomAll
  ' MsgBox "Block Has Been Inserted " & blockrefobj.ObjectName
   
   
   BRPT3_InsertStordValueInToNewBlock
   
End Sub



  
  Sub BRPT3_InsertStordValueInToNewBlock()

   
   
   Dim MyBlockRef As AcadBlockReference
   Dim MyObjSS As AcadSelectionSet
   Dim myvaratt As Variant
   Dim i As Double
   Dim MyoEnt As AcadEntity
   Dim MyBlockObj As AcadBlock
   Dim OLD_BLOCK_NAME As String
   Dim NEW_BLOCK_NAME As String

  
      MyAttTextStr_NEW_1 = "ROOM_REF"
   MyAttTextStr_NEW_2 = "ROOM_CEILING_HEIGHT"
   MyAttTextStr_NEW_3 = "ROOM_DESC"


   
NEW_BLOCK_NAME = "LEVEL4_ATTBLOCK"   ''''change 'the text to current 'new block name'

'MyAttTextStr = "Test 1"


   On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
       Set MyObjSS = ThisDrawing.SelectionSets.Add("SelectBlock")

       '' let user select entities interactively
       'MyObjSS.SelectOnScreen
       MyObjSS.Select acSelectionSetLast

        'MyObjSS.SelectOnScreen FilterType, FilterData
        'MyObjSS.Select acSelectionSetAll 'FilterType, FilterData
       '' highlight the selected entities
       MyObjSS.Highlight True
       
       '' pause for the user
       .prompt vbCr & MyObjSS.Count & " entities selected"
       '.GetString False, vbLf & "Enter to continue "
'-----------------------------------------------------------------------------
       For Each MyoEnt In MyObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
                   If myvaratt(i).TagString = MyAttTextStr_NEW_1 Then

                       myvaratt(i).TextString = MyAttTextStr1
                       
                               End If
               Next
           End If
       Next
                       
'-----------------------------------------------------------------------------
          For Each MyoEnt In MyObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
               
                   If myvaratt(i).TagString = MyAttTextStr_NEW_2 Then
                   
                   
                       myvaratt(i).TextString = MyAttTextStr2
                       
                   

                   
                                    myvaratt(i).Update
                                    
                           
                               End If
               Next
           End If
       Next


 '-----------------------------------------------------------------------------
                        For Each MyoEnt In MyObjSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
               myvaratt = MyBlockRef.GetAttributes
               For i = 0 To UBound(myvaratt)
               
                 If myvaratt(i).TagString = MyAttTextStr_NEW_3 Then

                       myvaratt(i).TextString = MyAttTextStr3
                       
                 End If
               Next
           End If
       Next
End With

   
  End Sub

Public MyAttTagStr_Old_1 As String
Public MyAttTagStr_Old_2 As String
Public MyAttTagStr_Old_3 As String

Public MyAttTagStr_NEW_1 As String
Public MyAttTagStr_NEW_2 As String
Public MyAttTagStr_NEW_3 As String

Public MyAttTextStr1 As String
Public MyAttTextStr2 As String
Public MyAttTextStr3 As String

Public MyOldBlockObjSS As AcadSelectionSet

September 25, 2008

That was my old code. I have now started trying to modify it with the following, the module below selects all blocks named APA013

Sub selectBlock()

Dim FilterType(0) As Integer
Dim FilterData(0) As Variant

      On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
  Set objSS = ThisDrawing.SelectionSets.Add("SelectBlock")

  FilterType(0) = 2
  FilterData(0) = "APA013"

objSS.Select acSelectionSetAll, , , FilterType, FilterData

       objSS.Highlight True
           blkcnt = objSS.Count
            'objSS.Highlight False
               'objSS.Delete
           
          End With
           
           StorAttValues
           
End Sub

From there i’m not sure how to make the code cycle thru each block before starting the code again?

Thanks for any help,

col

Sign In

cycling thru blocks in a selection set..

Recommended Posts

comcu

comcu

Join the conversation

Tutorials

Forums

Activity