region object to pollyline

dose anyone know of a way to convert a region object into a polyline object.

i need the coordinates of the region object to define a selection polygon
window.

 

The object region don't have coordinates property, one way though would be
to make a temporary copy of the region to an empty layer, then explode it,
and get the end coordinates of the resulting lines.

Hope this helps.

 

ok heres my code
the poroble is that when i runs it dosnt select anything (very eritating)

Sub trimdelete(fence As AcadRegion)
Dim explosion As Variant
Dim boxpointsarray As Variant
Dim dwgobjendpoint As Variant
Dim dwgobjstartpoint As Variant
Dim pickpoint As Variant
Dim layers As AcadLayers
Dim layer As AcadLayer
Dim tdselset As AcadSelectionSet
j = 0
explosion = fence.Explode
pickpoint = explosion(0).StartPoint
ThisDrawing.layers.Add "polyfence"
Set layers = ThisDrawing.layers

For i = LBound(explosion) To UBound(explosion)
explosion(i).layer = "polyfence"
Next
For Each layer In layers
If layer.Name <> "polyfence" Then
layer.Lock = True
End If
Next
ThisDrawing.SendCommand "pedit " & "l " & "y " & "j " & "all " & " " & "
"
Call ssetTEST("polypick")
Set tdselset = Mselset
tdselset.SelectAtPoint pickpoint
For Each layer In layers
layer.Lock = False
Next

For i = 0 To tdselset.COUNT - 1
'If tdselset.Item(i).ObjectName = "AcDbLWPolyline" Then
coordsarray = tdselset.Item(i).Coordinates
'End If
Next

j = (((UBound(coordsarray) - 1) / 2) + (UBound(coordsarray) - 1) + 2)
ReDim boxpointsarray(0 To j) As Double
For i = LBound(coordsarray) To UBound(coordsarray) Step 2
boxpointsarray((i / 2) * 3) = coordsarray(i)
boxpointsarray(((i / 2) * 3) + 1) = coordsarray(i + 1)
boxpointsarray(((i / 2) * 3) + 2) = 0
Next

'debuging code to see what is being drawn
Dim tendpoint(0 To 2) As Double
Dim tstartpoint(0 To 2) As Double
Call ssetTEST("tdselset")
Set tdselset = Mselset
For i = LBound(boxpointsarray) To UBound(boxpointsarray) Step 3
tstartpoint(0) = boxpointsarray(i): tstartpoint(1) =
boxpointsarray(i + 1): tstartpoint(2) = boxpointsarray(i + 2)
If i + 3 < UBound(boxpointsarray) Then
tendpoint(0) = boxpointsarray(i + 3): tendpoint(1) =
boxpointsarray(i + 4): tendpoint(2) = boxpointsarray(i + 5)
Set tline = ThisDrawing.ModelSpace.AddLine(tstartpoint,
tendpoint)
ThisDrawing.Regen acAllViewports
End If
Next
'end debuging code

tdselset.Clear
tdselset.SelectByPolygon acSelectionSetWindowPolygon, boxpointsarray
For Each ent In tdselset
If ent.ObjectName <> "AcDbRegion" Then
If ent.layer <> "Scaler" Then
ent.Delete
End If
End If
Next
tdselset.Delete
End Sub

 

Yves

There is no need to make a temporary copy. The 'Explode' methode keeps the
original object and returns an array with the 'exploded' objects. The only
thing you've to do is to step through the array and get the coordinates of
the objects. 'Explode' returns lines and arcs you've to remove duplicate
coordinates.

Cheers

 

navi800


Without testing your code I've seen following things:
- There is no need to create an extra Layer
- To select the newly created pline use Obj.Select acSelectionSetLast
- Some fragments to give you an idea:
explosion = fence.Explode
ThisDrawing.SendCommand "pedit " & "l " & "y " & "j " & "all " & " " & " "
Set objSelSet = ThisDrawing.SelectionSets.Add("MySelSet")
objSelSet.Select acSelectionSetLast
coordsarray = objSelSet.Item(0).Coordinates
...

Cheers

 

ok that works a lot better and more reliable
but the problem is when the program attempts to select using the crossing
plolyline it selects nothing

any ideas?

 

navi800

I've written this one (works):

<snip>
Public Function MeSelectInRegion(RegObj As AcadRegion)

Dim ExpArr As Variant
Dim TmpSet As AcadSelectionSet
Dim CorArr() As Double
Dim PntArr() As Double
Dim ArrCnt As Long

ExpArr = RegObj.Explode
ThisDrawing.SendCommand "_.PEDIT " & "_LAS " & "_YES " & _
"_JOI " & "_ALL " & " " & " "
Set TmpSet = MeSelectionSet("TmpSet")
TmpSet.Select acSelectionSetLast
CorArr = TmpSet.Item(0).Coordinates
TmpSet.Item(0).Delete

ReDim PntArr(0 To ((((UBound(CorArr) + 1) / 2) * 3) - 1))

For ArrCnt = 0 To UBound(CorArr) Step 2
PntArr((ArrCnt / 2) * 3) = CorArr(ArrCnt)
PntArr(((ArrCnt / 2) * 3) + 1) = CorArr(ArrCnt + 1)
PntArr(((ArrCnt / 2) * 3) + 2) = 0
Next ArrCnt

TmpSet.Clear
TmpSet.SelectByPolygon acSelectionSetWindowPolygon, PntArr

Debug.Print TmpSet.Count

End Function

' -----
Public Function MeSelectionSet(SetNme As String) As AcadSelectionSet

Dim SelSet As AcadSelectionSet
Dim SelCol As AcadSelectionSets

With ThisDrawing
Set SelCol = .SelectionSets
For Each SelSet In SelCol
If SelSet.Name = SetNme Then
.SelectionSets.Item(SetNme).Delete
Exit For
End If
Next
Set MeSelectionSet = .SelectionSets.Add(SetNme)
End With

End Function
<snip>

Cheers

 

Hi,

This simple code should do it!

Sub explodeRegion()
Dim Fence As AcadRegion, ent As AcadEntity, test, Exploded As Variant
Dim objline As AcadLine
ThisDrawing.Utility.GetEntity ent, pt, "Choisit un objet : "
Set Fence = ent
Exploded = Fence.Explode
'to delete the region unquote the following line
ent.Delete
Dim ft(0) As Integer, fd As Variant
ft(0) = 8
fd = "exploded"

Dim plinePTS, j As Integer
ReDim plinePTS((UBound(Exploded) + 1) * 3 - 1) As Double
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.PickfirstSelectionSet
sset.Clear
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 8
dataValue(0) = "exploded"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue

sset.Select acSelectionSetAll, , , groupCode, dataCode

ThisDrawing.SendCommand "pedit " & "l " & "y " & "j " & "all " & " " & "
"

End Sub

 

Thanks,

It's just that I was taking a looong way

Good information.

 

Yves

Welcome...

Cheers

 

You do realize that not any region can be converted to
a polyline, right? For example, a region can have edges
that explode to splines or elliptical arc segments, and
they can't be added to a polyline.

A region can also have inner loops, and they may end up
being used instead of the outer loop, using the method
you are using.

If you can make assumptions about the regions you're
working with, then this shouldn't matter.

 

With a little modification it works perfectly
You actualy solved another issue i was having in that selection set
function.

Thank you

Navi

 

Navi

Glad to help you...

Cheers

 

Good points Tony...

Possible solutions WmfOut -> WmfIn or DxfOutR12Bin -> DxfIn...

Possible solution checking for biggest area...

Cheers

 

Navi

There is also a more elegant solution for SelectionSet:

<snip>
Public Function MeSelectionSet(AssNme As String) As AcadSelectionSet

On Error Resume Next

With ThisDrawing.SelectionSets
Set MeSelectionSet = .Add(AssNme)
If Err.Number <> 0 Then
Err.Clear
.Item(AssNme).Delete
Set MeSelectionSet = .Add(AssNme)
End If
End With

End Function
<snip>

Cheers