Create new Block from Existing Selection Set of Region objects or Region objects

[jalal.mousa]

Hi ,

please note code below is partial code and not showing the entire thing hope you still can understand intent 

I am trying to convert all AcadRegion objects in selection set to new block

but i am getting nothing not sure what i am missing

for selectedObjects i am getting Count value see screen shot = 20 items

but once i get to line 61 in code "set Blockobj" i am getting error 

any idea how to convert/add Region objects to Block

Sub Add_Floor_Pattern_ID_Group()



On Error GoTo ErrorHandler
Set MyApp = GetObject(, "Autocad.Application")

ErrorHandler:
If Err.Description <> "" Then
Err.Clear
Set MyApp = CreateObject("Autocad.Application")
End If
MyApp.Visible = True
Set MyDWG = MyApp.ActiveDocument

Dim selectedObjects As Variant

dim AktIDPt as variant

aktpt = MyDWG.Utility.GetPoint(, "Place the Room Nr")

Set ID_Text = MyDWG.ModelSpace.AddText("ID_" & MyDWG.ModelSpace.Count, AktIDPt, UserForm_DrawToCalc.TBox_TextHight.Text)



On Error Resume Next
Set selectionSet1 = MyDWG.SelectionSets.Add("MySelectionSet1")


If Err Then
Err.Clear
Else
' selectionSet1.Delete
End If

Set selectionSet1 = MyDWG.SelectionSets.Item("MySelectionSet1")

Dim mode As Integer
Dim j As Integer

mode = acSelectionSetCrossingPolygon

selectionSet1.SelectByPolygon mode, pointsArray1



Dim i As Integer
For i = 0 To MyDWG.ActiveSelectionSet.Count - 1
If TypeOf selectedObjects(i) Is AcadRegion Then
Set appendObjs(4 + i) = MyDWG.ObjectIdToObject(selectedObjects(i).ObjectID)
selectedObjects(i).Layer = "RoomFloorPatternID"
End If
Next i



Dim blockObj As AcadBlock

Dim BID_Text As AcadBlock
Set BID_Text = MyDWG.Blocks.Add(aktpt, ID_Text.TextString)
Set blockObj = BID_Text.AddRegion(selectedObjects)



end sub

[Ed__Jobe]

1. It's the AddRegion method, not the AddSelectionSet method. You need to iterate the selectionset and add the regions one at a time.
2. You don't need to reference ActiveSelectionSet, just use selectionset1
3. Your use of error handling needs working on. You need better control of how you use On Error Resume Next. As it is now, it will be masking other possible errors. Read the VBA help topic for the On Error statement
4. It will help with your error handling if you don't try to put all tasks into one sub. Try to organize your code so that you only do one task in each sub. It will also make troubleshooting easier. If you debug a sub once, you don't need to do it again. For example, put your selectionset creation into a new sub. You can search this forum for my AddSelectionSet function.
5. Create the new block def first. Then as you iterate the selectionset, you can append it to the block.

[jalal.mousa · Accepted solution]

Hi Ed,

thanks for all notes but i still can't figure a way how append it to the block

are you able to comment on this partial code how to fix it ? mainly line Set objrr = BID_Text.AddRegion(obj)

Dim BID_Text As AcadBlock
Dim blockObj As AcadBlock
Dim objrr As AcadRegion
Set BID_Text = MyDWG.Blocks.Add(aktpt, ID_Text.TextString)

For Each obj In selectionSet1
  
       
        If TypeOf obj Is AcadRegion Then
           
           
            Set objrr = BID_Text.AddRegion(obj)
            
        End If
    
    Next

[Ed__Jobe]

That's close, but the AddRegion method requires a Region object, not Object type, so you have to cast it first. See below.

Dim BID_Text As AcadBlock
Dim blockObj As AcadBlock
Dim objrr As AcadRegion
Set BID_Text = MyDWG.Blocks.Add(aktpt, ID_Text.TextString)

For Each obj In selectionSet1       
        If TypeOf obj Is AcadRegion Then
           Set objrr = obj
           With objrr
             'You may need to adjust properties
             'such as insertion point, to be relative
             'to the block's insertion point
           End With
           BID_Text.AddRegion(objrr)            
        End If    
Next

[jalal.mousa]

Thanks ED

I tried it but got error with line" BID_Text.AddRegion (objrr)" in your proposed code, something is missing ?

I am getting Run Time Error 438 object does not support this property

also i added insertion point as you proposed  to use as reference to insert Block also i added Block reference but not sure if correct

kindly take another look

   Dim BID_Text As AcadBlock
 
 Dim blockObj As AcadBlock
 Dim objrr As AcadRegion
 Dim insertionPnt(0 To 2) As Double
Set BID_Text = MyDWG.Blocks.Add(aktpt, ID_Text.TextString)

For Each obj In selectionSet1
        If TypeOf obj Is AcadRegion Then
           
            Set objrr = obj
                 With objrr
                
   
                  'You may need to adjust properties
                  'such as insertion point, to be relative
                  'to the block's insertion point
             
                insertionPnt(0) = RoomMinPointX
                insertionPnt(1) = RoomMinPointY
                insertionPnt(2) = 0
                End With
           ' BID_Text.AddRegion(objrr)
           End If
    
    Next
' Insert the block
 Dim blockRefObj As AcadBlockReference
 Set blockRefObj = MyDWG.ModelSpace.InsertBlock(insertionPnt, BID_Text.ObjectName, 1#, 1#, 1#, 0)

[norman.yuan · Accepted solution]

@Ed__Jobe ,

The code would not work: the AddRegion() method requires an array of AcadObject/Entity, not a individual AcadObject/Entity.

@jalal.mousa ,

With AutoCAD VBA/COM API, one cannot add an existing AcadEntity into a block definition (or Model/PaperSpace) via the AcadBlock.AddXXXXX() methods, for example, if you want to add a Line to a block definition, you do not create a Line first and then add it to the block definition via AddLine(). Rather, you pass the information required for creating a line, such as Start/EndPoint, and let the block definition create the entity behind the scene (via AddLine() method). The same applies to AddReagion() method: you DO NOT supply an array of Regions; instead, you pass an array of existing entities (line, polyline, arc... They must all on the same plane, of course) and the AddRegion() method will do the calculation behind the scene to determine how many closed areas these entities would form and then create an array of Regions accordingly.

So, no, your code logic of selecting existing regions and adding them to a block definition does not work. You need find all existing regions' boundary as entities (closed polylines) and then add the array of these polylines with AddRegion() method, and let AutoCAD figures out how many regions could be formed from these closed polylines. However, since there is no way to get the Region's boundary, the logic of adding region(s) to a block definition will not work in VBA/Acad API.

However, if you do AutoCAD .NET API/ObjectARX API, then yes, you can add create an Entity, including Region, first and then add it into a block definition.

[Ed__Jobe]

@norman.yuan  Thanks. I hadn't tried it. I appreciate the correction.