Message 1 of 2
Exploding wipeout entity in VBA

Not applicable
12-27-2006
08:21 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
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