Can you create a region from a selection set ?

[aiden_biondi]

Hi,

I have a 2D arrangement drawing in AutoCAD and I am trying to make it 3D by extruding the polylines. I have done this manually but as a research task I am trying to repeat this using VBA code. 

My plan is to select the polylines by creating a selection set, then create a region object from this selection set. To then extrude using 'AddExtrudedSolid', which requires a profile as a region.

I cannot find anywhere how to create a region from my selection set and I am wondering if this is even possible?

If anyone has a better way of extruding all the polylines using VBA code this would be much appreciated as I am new to VBA and visual basic editor.  

Aiden

[norman.yuan · Accepted solution]

Have you look at AcadModelSpace[PaperSpace].AddRegion([objectArray]) method? Almost all AutoCAD entities are created by calling AcadModel[Paper]Space.AddXxxx() methods, AcadRegion is no exception here.

Since you obtain the polylines as AcadSelectionSet, obviously, you need place the selected entities into an Array, something like:

Dim ss As AcadSelectionSet

'' Code here to create/select entities that are eligible to form AcadRegion (Arc, Line, LWPolyline,...)

Dim items() As AcadEntity

ReDim item(ss.Count-1)

Dim ent As AcadEntity

Dim region As AcadRegion

Dim i As Integer

For Each ent in ss

  Set items[i]=ent

  i=i+1

Next

Set region=ThisDrawing.ModelSpace.AddRegion(items)

'' Set the region's properties (layer, color...), if necessary.

region.Update

[ed57gmc2 · Accepted solution]

I made a function for these types of AddXXX methods.

Public Function SStoArray(ss As AcadSelectionSet, ary() As AcadEntity)

    Dim cnt As Integer
    cnt = ss.Count() - 1
    Dim i As Integer
    ReDim ary(cnt)
    For i = 0 To cnt
        Set ary(i) = ss(i)
    Next
    
End Function

[aiden_biondi]

The above conversion function worked but when it comes to creating the region,

regionObj = ThisDrawing.ModelSpace.AddRegion(linesArray)

I get the error message 'invalid object' ?
linesArray is my array of selected entities. All of which are of linetype 'line'

[norman.yuan]

Maybe you omitted it: do you have "Set" keyword like this:

Dim regionObj As AcadRegion

Set regionObj = ThisDrawing.ModelSpace.AddRegion(linesArray)

If you do, then, have you tried to run the command "Region" manually with the same lines?

[aiden_biondi]

I had indeed missed out 'Set' but once added in I get the same error message.

I tried manually creating this region with the 'Region' command and this creates 18 regions?
*Moderator edit* Please post your code in a code window.
my code looks like:

Sub SelectObjectsByCrossingWindow()
' Create a new selection set
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("SS17")

' Define the points for the crossing window
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double

pt1(0) = 100000#: pt1(1) = 0#: pt1(2) = 0#:
pt2(0) = 0#: pt2(1) = 100000#: pt2(2) = 0#:

' Create a crossing window from (100000,0,0) to (0,100000,0)
sset.Select acSelectionSetCrossing, pt1, pt2

MsgBox "Number of objects selected: " & sset.Count

Dim linesArray() As AcadLine
Call SStoArrayLines(sset, linesArray)

sset.Delete

Call CreateRegion(linesArray)

End Sub

'Creating a region to prepare for extrude
Sub CreateRegion(linesArray() As AcadLine)

Dim regionObj As AcadRegion
'Dim i As Integer

Set regionObj = ThisDrawing.ModelSpace.AddRegion(linesArray)

End Sub


'Selection set into array for addregion command
Sub SStoArrayLines(sset As AcadSelectionSet, linesArray() As AcadLine)

Dim cnt As Integer
cnt = sset.Count() - 1
Dim i As Integer
ReDim linesArray(cnt)

For i = 0 To cnt
Set linesArray(i) = sset(i)
Next
End Sub

[norman.yuan]

Sorry, it was my mistake: the AddRegion() method returns an array of AcadRegions (Variant). So the code for the CreateRegion() should have been:

Sub CreateRegion(lineArray As Variant)

  Dim regions as Variant

  regions=ThisDrawing.AddRegions(lineArray)

  If Ubound(region)>=0 Then

    MsgBox Ubound(regions) + 1 & "regions created."

  Else

    MsgBox "Input entities cannot form regions."

  End If

End Sub

Depending on the input entities (line/arc/lwpolyline...), 0 or multiple regions will be created.

However, your other code is still problematic:

When you select by window, you MUST make sure the 2 corner points are WITHIN the current view, otherwise the selecting may not be done correctly. Usually, you would zoom to the selecting window, before call AcadSelectSet.Select(), if selecting by window/crossing/fence..., except for selecting all.

[aiden_biondi]

I tried the code you suggested for creating a region and reduced my crossing window to a reduced area, but I now get the error message 'Invalid Object Array' when it comes to the .addRegion line

I added a watch to my 'linesArray' array and the lines selected are all listed and of type: 'Variant/Object/IAcadLine

[ed57gmc2]

Can you please show your code again since  you edited it?

[norman.yuan · Accepted solution]

Not seeing your entire code and your drawing, it is difficult to say more. This code works for me:

Option Explicit

Public Sub CreateRegion()

    Dim ss As AcadSelectionSet
    Set ss = ThisDrawing.SelectionSets.Add("regionSet")
    
    On Error Resume Next
    ss.SelectOnScreen
    
    If ss.count > 0 Then
        CreateRegionFromSelectionSet ss
    End If
    
    ss.Delete
    
End Sub

Private Sub CreateRegionFromSelectionSet(ss As AcadSelectionSet)
    
    Dim entityArray As Variant
    entityArray = CreateEntityArray(ss)
    
    Dim regions As Variant
    regions = ThisDrawing.ModelSpace.AddRegion(entityArray)
    
End Sub

Private Function CreateEntityArray(ss As AcadSelectionSet) As Variant
    
    Dim ents() As AcadEntity
    ReDim ents(ss.count - 1)
    Dim i As Integer
    Dim ent As AcadEntity
    For Each ent In ss
        Set ents(i) = ent
        i = i + 1
    Next
    CreateEntityArray = ents
    
End Function

this video clip shows how it works (note: the selected lines must be able to form closed area by connecting end to end):

[aiden_biondi]

Gave this a try and it worked !

Appreciate the help Norman 🙂