Topic: (C3D '08) Add Multiple Boundaries (VBA)

[Guest]

I'm trying to write a simple (should be) program to add multiple boundaries to a surface.  It bombs out here on this line (x.Add obj...) with an Object Variable or With Block Variable Not Set error message.

Maybe it's because it's Friday....maybe it's too much caffeine, but I can't get this thing worked out and I KNOW it's something stupid-simple.

Code: [Select]

Option Explicit


Public Sub AddMultipleBoundaries()
    Dim x As AeccSurfaceBoundaries
    Dim ssSet As AcadSelectionSet
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Dim obj As AcadEntity
    Dim i As Integer
   
    Set ssSet = vbdPowerSet("Boundaries")
       
    FilterType(0) = 0
    FilterData(0) = "lwpolyline"
   
    ssSet.SelectOnScreen FilterType, FilterData
   
    i = 1
    For Each obj In ssSet
        x.Add obj, "Boundary " & i, aeccBoundaryHide, True, 1#
        i = i + 1
    Next obj
End Sub


Public Function vbdPowerSet(strName As String) As AcadSelectionSet
    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = strName Then
            objSelSet.Delete
            Exit For
        End If
    Next
    Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
    Set vbdPowerSet = objSelSet
End Function

[mjfarrell]

is it possible, that you need an entry in there to name those bounds?

[Guest]

This would be the boundary names: Boundary " & i

[Jeff_M]

Hint: The Add method expects an array of objects......oh, and they can't be featurelines....

Edit: Found my sample code to do this... {Edit - This has absolutely nothing to do with the question being asked...use it for future reference when you want to add breaklines, though.  thanks for catching that, sinc.}

Code: [Select]

    'assumes you have a valid Surface object at this point, oSurface
     Create the selection set
    Dim SSet As AcadSelectionSet
    Dim SSEnt As AcadEntity
    On Error Resume Next
    Set SSet = ThisDrawing.SelectionSets.Add("myset")
    If Err Then Set SSet = ThisDrawing.SelectionSets.Item("myset")
    Err.Clear
    On Error GoTo 0
    Dim gpCode(1) As Integer
    Dim gpValue(1) As Variant
    gpCode(0) = 0
    gpValue(0) = "*POLYLINE"
    gpCode(1) = 8
    gpValue(1) = "WORK-3D-BRKLINES"
    SSet.Select acSelectionSetAll, , , gpCode, gpValue
    MsgBox SSet.Count & " objects on the layer."

    ' Add the entities in the selection set
    Dim entDesc As String
    Dim midOrd As Double
    entDesc = "Breaklines added by VBA"
    midOrd = 0.1
    If SSet.Count > 0 Then
        Dim oBrkObjs() As Object
        ReDim oBrkObjs(0 To SSet.Count - 1)
        Dim I As Integer
        For Each SSEnt In SSet
            If SSEnt.ObjectName Like "*Feature*" Then
                Set SSEnt = SSEnt.Explode
            End If
            Set oBrkObjs(I) = SSEnt
            I = I + 1
        Next SSEnt
        oSurface.Breaklines.AddStandardBreakline oBrkObjs, entDesc, midOrd
    End If


[Jeff_M]

In addition to the method I showed, you could add each one individually by slightly modifying the code I posted.

[sinc]

Jeff's code is adding breaklines instead of boundaries, but the crux is similar for boundaries.

There's a routine in the SincpacC3D that does exactly this (add multiple hide boundaries to a surface), if you can translate the C#.NET to VBA...

http://www.ejsurveying.com/sincpacc3d.htm

The surface won't let you add a boundary if it already has one with the given name, so I put an exception handler around that part that skips to the next higher-number and tries again.

[Jeff_M]

All I can say is it's a good thing it's Friday. Hey, at least they both start with a B, so I was close.

[Jeff_M]

Sorry Matt,
After looking at your code for what you are really trying to do, all I can see wrong is that you are not assigning X to a surface Boundaries collection. Converting your code to a Function that accepts a valid surface as an argument, this works:

Code: [Select]

Function AddMultipleBoundaries(oSurface As AeccTinSurface)
    Dim x As AeccSurfaceBoundaries
    Dim ssSet As AcadSelectionSet
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Dim obj As AcadEntity
    Dim i As Integer
   
    Set x = oSurface.Boundaries
    Set ssSet = vbdPowerSet("Boundaries")
       
    FilterType(0) = 0
    FilterData(0) = "lwpolyline"
   
    ssSet.SelectOnScreen FilterType, FilterData
   
    i = 1
    For Each obj In ssSet
        x.Add obj, "Boundary " & i, aeccBoundaryHide, True, 1#
        i = i + 1
    Next obj
End Function
HTH,
Have a good weekend

[Guest]

Jeff:
Thanks for the heads up with the surface.

However, when I add this to a sub AddMultipleBoundaries "EG" <-- EG being the surface name, I get a Type Mismatch error.  Should I NOT be passing it the name of the surface?

[Jeff_M]

Hi Matt,
The function expects the surface object, not the surface's name.....we could change that if you want, though.