[V8i SS3 VBA] Get Fillcolor and Patterninfo from Polygon Collection feature

Hello,

I've got a feature of type PolygonCollection in my map dgn.

In the schema the fature has a fillcolor and a pattern set.

Now I want to retrieve that Information by code from the feature in the designfile?

The feature geometry is a microstation typ 106.

Fillcolor an GetPattern function only work on closed element.

How can I get this Info?

Best regards

Martin

Parents
  • Martin,

    The shape elements are stored as sub-features in the XFM type 106 polygon collection. The following bold Bentley Map VBA code should give you an idea of how you can traverse the polygon collection and obtain information from each sub-feature shape elements.

    Private Sub processPolygons()

     
        Dim oLocateOp As New locateOp
       
        oLocateOp.ClearHilited = True
        oLocateOp.IncludeOnlyFeatures = True
        oLocateOp.IncludeFeatureName "MyPolygonFeature1"
       
        If ActiveDesignFile.Fence.IsDefined = True Then
           
            oLocateOp.Mode = LocateOpMode.locateOpModeFence
            oLocateOp.AutoAcceptFence = True
       
        ElseIf ActiveModelReference.AnyElementsSelected Then
           
            Dim selectionSetValue As New InputValue
           
            selectionSetValue.SetTypeAndValue ValueType_VALUE, "1"
            oLocateOp.UseSelectionSet = selectionSetValue
            oLocateOp.AutoAcceptSelectionSet = True
            oLocateOp.Mode = LocateOpMode.locateOpModeIdentify
       
        Else
           
            oLocateOp.Mode = LocateOpMode.locateOpModeScan
            oLocateOp.AutoAcceptScanFile = True
       
        End If
              
        CmdMgr.StartLocateOperation oLocateOp, New clsLocateFeatureOp
     
    End Sub
     
    Implements ILocateOpEvents
     
    Private Sub ILocateOpEvents_OnCleanup()
     
    End Sub
     
    Private Sub ILocateOpEvents_OnFinished(ByVal oLocateOp As xft.ILocateOp)
     
        If oLocateOp.LocatedFeaturesCount > 0 Then
       
            Debug.Print "=========================="
           
            Dim fe As FeatureEnumerator
            Set fe = oLocateOp.GetLocatedFeatures
           
            Do While fe.MoveNext
                With fe.Current
                    If .GetFeatureDefinition.IsCollection Then
                        Dim index As Long
                        For index = 0 To (.SubFeatureCount - 1)
                            Dim oSubFeature As feature
                           
                            Set oSubFeature = .GetSubFeature(index)
                           
                            With oSubFeature
                                If .GeometryType = GEOMETRYTYPE_Polygon Then
                                    Dim vertexArray() As Point3d
                                    Dim vertex As Long
                                    Dim oPolygonPoint As Point3d
                                   
                                    vertexArray = .Geometry.AsShapeElement.GetVertices
                                   
                                    For vertex = 0 To (.Geometry.AsVertexList.VerticesCount - 1)
                                        oPolygonPoint = vertexArray(vertex)
                                        Debug.Print "Polygon(" + Str(index + 1) + ")" + _
                                            Str(vertex + 1) + ". " + Str(oPolygonPoint.X) + _
                                            "," + Str(oPolygonPoint.Y)
                                    Next
                                End If
                            End With
                        Next
                    End If
                End With
            Loop
           
        Else
           
            MsgBox "no matching feature instances found"
       
        End If
     
    End Sub
           
    Private Sub ILocateOpEvents_OnRejected(ByVal RejectedReasonType As xft.LocateOpRejectedReasonType, RejectedReason As String)
     
    End Sub
     
    Private Sub ILocateOpEvents_OnTerminate()
     
    End Sub
     
    Private Sub ILocateOpEvents_OnValidate(ByVal RootFeature As xft.IFeature, ByVal element As element, point As Point3d, ByVal View As View, Accepted As Boolean, RejectReason As String)
     
    End Sub

    Regards,

    Jeff Bielefeld [Bentley]



  • Jeff,

    Thanks for your answer. I'am attaching an example DGN und my Code to get the FillColor and the Pattern Info from the feature.

    My Code:

    Class SelectFeatures:
    Implements ILocateOpEvents
    
    Public ee As ElementEnumerator
    Public eeCount As Long
    Public fe As FeatureEnumerator
    Public feCount As Long
    
    Private Sub ILocateOpEvents_OnCleanup()
    
    End Sub
    
    Private Sub ILocateOpEvents_OnFinished(ByVal locateOp As xft.ILocateOp)
        
        eeCount = locateOp.LocatedElementsCount
        Set ee = locateOp.GetLocatedElements()
        feCount = locateOp.LocatedFeaturesCount
        Set fe = locateOp.GetLocatedFeatures()
        
    End Sub
    
    Private Sub ILocateOpEvents_OnRejected(ByVal RejectedReasonType As xft.LocateOpRejectedReasonType, RejectedReason As String)
    
    End Sub
    
    Private Sub ILocateOpEvents_OnTerminate()
    
    End Sub
    
    Private Sub ILocateOpEvents_OnValidate(ByVal RootFeature As xft.IFeature, ByVal Element As Element, Point As Point3d, ByVal View As View, Accepted As Boolean, RejectReason As String)
    
    End Sub
    
    Private Sub CheckPatternInfo(ele As ClosedElement)
    
        Dim pat As Pattern
        
        On Error GoTo errHandler
        
        Debug.Print "HasPattern=" = ele.HasPattern()
        If ele.HasPattern Then
            Set pat = ele.GetPattern()
            Debug.Print pat.Angle1
        End If
        
        Exit Sub
    errHandler:
        Debug.Print "HasPattern=False"
    End Sub
          
    
    Modul:                          
    
    Public Sub CopyFeatureToNewFile()
    
        Dim fea As feature
        Dim feaNumer As Integer
        
        Dim selFeatures As SelectFeatures
    
        Dim oLocateOp As New locateOp
        oLocateOp.IncludeOnlyFeatures = True
        oLocateOp.Mode = LocateOpMode.locateOpModeScan
        oLocateOp.IncludeFeatureName "Fl_Nutzung_Collection"
        oLocateOp.AutoAcceptScanFile = True
        
        Set selFeatures = New SelectFeatures
        CmdMgr.StartLocateOperation oLocateOp, selFeatures
        
        feaNumer = 1
        Do While (selFeatures.fe.MoveNext)
            
            'On Error Resume Next
            Set fea = selFeatures.fe.Current
            If Not fea Is Nothing Then
                If fea.GetFeatureDefinition.IsCollection Then
                    
                    Dim index As Long
                    For index = 0 To (fea.SubFeatureCount - 1)
                        Dim oSubFeature As feature
                        Set oSubFeature = fea.GetSubFeature(index)
                        
                         With oSubFeature
                            Debug.Print "Number:" & CStr(feaNumer) & " Geometry Type=" & .Geometry.Type
                            If .GeometryType = GEOMETRYTYPE_Polygon Then
                                With .Geometry.AsClosedElement
                                    If .FillMode = msdFillModeNotFilled Then
                                        Debug.Print "FillMode=NotFilled"
                                    Else
                                        Debug.Print "FillMode=Filled"
                                    End If
                                    Debug.Print "FillColor=" & .FillColor
                                    CheckPatternInfo oSubFeature.Geometry.AsClosedElement
                                End With
                            End If
                         End With
                    Next index
                End If
            End If
            feaNumer = feaNumer + 1
        Loop
        
        MsgBox "Complete"
    End Sub

    The output at my cumputer is:

    Number:1 Geometry Type=14
    FillMode=NotFilled
    FillColor=74
    HasPattern=False
    Number:2 Geometry Type=14
    FillMode=NotFilled
    FillColor=74
    HasPattern=False
    Number:3 Geometry Type=14
    FillMode=NotFilled
    FillColor=74
    HasPattern=False
    Number:3 Geometry Type=6
    FillMode=NotFilled
    FillColor=74
    HasPattern=False
    Number:4 Geometry Type=6
    FillMode=NotFilled
    FillColor=74
    HasPattern=False
    Number:4 Geometry Type=14
    FillMode=NotFilled
    FillColor=74
    HasPattern=False

    I'am not able to get the correct fill and pattern informations.

    Is there anything wrong in my code?

    Best Regardstest_iplot.dgn

    Martin

  • Martin,

    Using your data and code have been able to replicate what you are reporting. I'm working now to determine if this is a previously unreported defect. I will update you my findings once complete.

    I would be interested to know more about what you are attempting to do in case this turns out to be a confirmed defect. I could then possibly help you find a temporary workaround.

    Regards,

    Jeff Bielefeld [Bentley]



Reply
  • Martin,

    Using your data and code have been able to replicate what you are reporting. I'm working now to determine if this is a previously unreported defect. I will update you my findings once complete.

    I would be interested to know more about what you are attempting to do in case this turns out to be a confirmed defect. I could then possibly help you find a temporary workaround.

    Regards,

    Jeff Bielefeld [Bentley]



Children