Exploding wipeout entity in VBA

Exploding wipeout entity in VBA

Anonymous
Not applicable
726 Views
1 Reply
Message 1 of 2

Exploding wipeout entity in VBA

Anonymous
Not applicable
Hi,
I am trying to explode a 'wipeout' object from a VBA program so that I can work with the resulting line entities. If I try to use the .explode method an AcadEntity it fails. If I do it from inside Autocad or from some VLISP code it works. Is there some other way besides how I'm attempting to do it below?
TIA,
Jim

Sub ExplodeWipeout ()
'This routine is to convert a polygon as defined by a Wipeout into a closed polyline


' ss1 is the collection of all wipeout objects on the 'zone' layer
Dim ss1 As AcadSelectionSet
Set ss1 = ssAdd("ssName")


Dim codes(1) As Integer
Dim values(1)


codes(0) = 0: values(0) = "wipeout"
codes(1) = 8: values(1) = "zones"
ss1.Select acSelectionSetAll, , , codes, values


Dim Pt As Variant


PICKWIPEOUT:
On Error Resume Next
Dim wipeObj As AcadEntity
ThisDrawing.Utility.GetEntity wipeObj, Pt, "Select a wipeout
object"
If Err Then GoTo BAIL
' RemoveItems method requires an array for its argument, so we
' must encapsulate tubeSeed in an array
Dim thisWipeout(0) As AcadEntity
Set thisWipeout(0) = wipeObj


On Error Resume Next
' wipeout item selected by user must exist in ss1 or it is invalid
ss1.RemoveItems thisWipeout
If Err Then
MsgBox "That Entity is not a valid wipeout object", , "Wipeout
Conversion"
GoTo PICKWIPEOUT
End If


'Determine how many mspace entities to start with
Dim stEntCnt As Integer
stEntCnt = ThisDrawing.ModelSpace.Count


'Now explode the selected wipeout
wipeObj.Explode

MsgBox "The wipeout had " & ThisDrawing.ModelSpace.Count - stEntCnt
+ 1 & "vertices"

BAIL:
End Sub

Public Function ssAdd(strName As String) _
As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(strName).Delete
Set ssAdd = ThisDrawing.SelectionSets.Add(strName)
End Function
0 Likes
727 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
there is no Wipeout object although it is possible to select a wipeout
object using a selection set. since the acadobject and acadentity objects do
not support the Explode method i think you're out of luck. i checked the
object model and found nothing.

perhaps someone else has found a way that is not documented.


wrote in message news:5436263@discussion.autodesk.com...
Hi,
I am trying to explode a 'wipeout' object from a VBA program so that I can
work with the resulting line entities. If I try to use the .explode method
an AcadEntity it fails. If I do it from inside Autocad or from some VLISP
code it works. Is there some other way besides how I'm attempting to do it
below?
TIA,
Jim

Sub ExplodeWipeout ()
'This routine is to convert a polygon as defined by a Wipeout into a closed
polyline


' ss1 is the collection of all wipeout objects on the 'zone' layer
Dim ss1 As AcadSelectionSet
Set ss1 = ssAdd("ssName")


Dim codes(1) As Integer
Dim values(1)


codes(0) = 0: values(0) = "wipeout"
codes(1) = 8: values(1) = "zones"
ss1.Select acSelectionSetAll, , , codes, values


Dim Pt As Variant


PICKWIPEOUT:
On Error Resume Next
Dim wipeObj As AcadEntity
ThisDrawing.Utility.GetEntity wipeObj, Pt, "Select a wipeout
object"
If Err Then GoTo BAIL
' RemoveItems method requires an array for its argument, so we
' must encapsulate tubeSeed in an array
Dim thisWipeout(0) As AcadEntity
Set thisWipeout(0) = wipeObj


On Error Resume Next
' wipeout item selected by user must exist in ss1 or it is invalid
ss1.RemoveItems thisWipeout
If Err Then
MsgBox "That Entity is not a valid wipeout object", , "Wipeout
Conversion"
GoTo PICKWIPEOUT
End If


'Determine how many mspace entities to start with
Dim stEntCnt As Integer
stEntCnt = ThisDrawing.ModelSpace.Count


'Now explode the selected wipeout
wipeObj.Explode

MsgBox "The wipeout had " & ThisDrawing.ModelSpace.Count - stEntCnt
+ 1 & "vertices"

BAIL:
End Sub

Public Function ssAdd(strName As String) _
As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(strName).Delete
Set ssAdd = ThisDrawing.SelectionSets.Add(strName)
End Function
0 Likes