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
Solved! Go to Solution.
Solved by norman.yuan. Go to Solution.
Solved by ed57gmc2. Go to Solution.
Solved by norman.yuan. Go to 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
Norman Yuan
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
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?
Norman Yuan
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
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.
Norman Yuan
Can you please show your code again since you edited it?
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):
Norman Yuan
Can't find what you're looking for? Ask the community or share your knowledge.