• State Suggested Answer
  • Replies 17 replies
  • Answers 2 answers
  • Subscribers 33 subscribers
  • Views 1932 views
  • Users 0 members are here

microstation sdk v8.11 - navigating programmatically through surface type 18

Roberto Cardosi
Offline

Dear all, good day.

I have a cell containing an element of type Surface(18).

I cannot understand how to navigate through its subelements.

Here it is visual basic code:

Public Sub NavigateThroughSurface(
   ByVal oApplication As Bentley.Interop.MicroStationDGN.Application
)
      Dim oEnumerator As Bentley.Interop.MicroStationDGN.ElementEnumerator = oApplication.ActiveModelReference.Scan      

      While oEnumerator.MoveNext
            Dim oElement = oEnumerator.Current
            If Not oElement.IsCellElement Then Continue While

            Dim oCellElement As Bentley.Interop.MicroStationDGN.CellElement = oElement.AsCellElement
            Dim lSubElementEnumerator As Bentley.Interop.MicroStationDGN.ElementEnumerator = oCellElement.GetSubElements
            While lSubElementEnumerator.MoveNext
                  Dim oSubElement = lSubElementEnumerator.Current
                  If oSubElement.Type = Bentley.Interop.MicroStationDGN.MsdElementType.Surface Then
                        'I do not find any "oSubElement.AsSurface" function...
                        'I have already done several tries, but without success:

                        '!!!!following statement throws exception:
                        Dim oBsplineSurfaceElement As Bentley.Interop.MicroStationDGN.BsplineSurfaceElement = oSubElement.AsBsplineSurfaceElement

                        '!!!!following statement throws exception too:
                        Dim lSolids As Bentley.Interop.MicroStationDGN.ElementEnumerator = oApplication.SmartSolid.ConvertToSmartSolidElement(oSubElement)

                        '?????????So how I can point to the surface itself and navigate through its subelements?????????
                  End If
            End While
      End While
End Sub

Thanks in advance.

Roberto

Italy

Parents
  • 0 Offline

    Hello Roberto,

    Do you want to extract the parameters of this surface element? If so, please refer to below test code. It depends Jon's revised DGN file.

    Declare Function mdlSurface_extractRevolution2 Lib "stdmdlbltin.dll" (ByRef boundaryEdPP As Long, ByRef centerP As Point3d, ByRef axisP As Point3d, ByRef sweepAngleP As Double, ByVal surfaceEdP As Long) As Long
Sub GetParametersFromSurface()
    Dim mySurface As Element, myBoundary As Element
    Set mySurface = ActiveModelReference.GetElementByID(DLongFromLong(4090))
    
    Dim surfaceEdP As Long, boundaryEdP As Long
    Dim center As Point3d, axis As Point3d
    Dim sweepAngle As Double
    surfaceEdP = mySurface.MdlElementDescrP
    mdlSurface_extractRevolution2 boundaryEdP, center, axis, sweepAngle, surfaceEdP
    MsgBox "center=(" & center.X & "," & center.Y & "," & center.Z & "), sweepAngle=" & sweepAngle
    
    Set myBoundary = MdlCreateElementFromElementDescrP(boundaryEdP)
    If myBoundary.Type = msdElementTypeArc Then
        Dim myArc As ArcElement
        Set myArc = myBoundary.AsArcElement
        MsgBox "boundary center=(" & myArc.CenterPoint.X & "," & myArc.CenterPoint.Y & "," & myArc.CenterPoint.Z & "), boundary sweepAngle=" _
               & myArc.sweepAngle & ", boundary radius=(" & myArc.PrimaryRadius & "," & myArc.SecondaryRadius & ")"
    End If
End Sub
    It can popup below two dialog boxes to show the parameters of surface and its boundary.



  • 0 Offline in reply to Yongan.Fu

    Dear all, good day.

    The above VBA code works perflectly in 32-bit, but it does not work in Connect (64-bit).

    This is the VBA code "translated" into 64-bit environment:

    Option Explicit

Declare PtrSafe Function mdlSurface_extractRevolution2 Lib "stdmdlbltin.dll" ( _
    ByRef boundaryEdPP As LongLong, _
    ByRef centerP As Point3d, _
    ByRef axisP As Point3d, _
    ByRef sweepAngleP As Double, _
    ByVal surfaceEdP As LongLong _
) As DLong
Sub GetParametersFromSurface()
    Dim mySurface As Element, myBoundary As Element
    Set mySurface = ActiveModelReference.GetElementByID(DLongFromLong(4090))
    
    Dim surfaceEdP As LongLong, boundaryEdP As LongLong
    Dim center As Point3d, axis As Point3d
    Dim sweepAngle As Double
    surfaceEdP = mySurface.MdlElementDescrP
    mdlSurface_extractRevolution2 boundaryEdP, center, axis, sweepAngle, surfaceEdP
    MsgBox "center=(" & center.X & "," & center.Y & "," & center.Z & "), sweepAngle=" & sweepAngle
    
    Set myBoundary = Application.MdlCreateElementFromElementDescrP(boundaryEdP)
    If myBoundary.Type = msdElementTypeArc Then
        Dim myArc As ArcElement
        Set myArc = myBoundary.AsArcElement
        MsgBox "boundary center=(" & myArc.CenterPoint.X & "," & myArc.CenterPoint.Y & "," & myArc.CenterPoint.Z & "), boundary sweepAngle=" _
               & myArc.sweepAngle & ", boundary radius=(" & myArc.PrimaryRadius & "," & myArc.SecondaryRadius & ")"
    End If
End Sub

    When I run the above code in PlantWise (Microstation Connect 64 bit) I get this msgbox:

    And this is not the right answer, because the expected one (the right one obtained when the same modeled is opened in Microstation 32) is the following one:

    Moreover, when I click on OK button to proceed, I get the following error and PlantWise aborts and close:

    This is the link from where you can download the detailed log error generated: https://app.box.com/s/6v0ksnpohoskaypskc7s4lmfa89cfe7j

    This is the PlantWise version we are using:

    Please may you help us?

    What are we doing wrong?

    Thanks in advance.

    Roberto

  • 0 Offline in reply to Roberto Cardosi
    Roberto Cardosi said:
    This is the VBA code "translated" into 64-bit environment 
    Declare PtrSafe Function mdlSurface_extractRevolution2 Lib "stdmdlbltin.dll" ( _
    ByRef boundaryEdPP As LongLong, _
    ByRef centerP As Point3d, _
    ByRef axisP As Point3d, _
    ByRef sweepAngleP As Double, _
    ByVal surfaceEdP As LongLong _
) As DLong

    That's incorrect.  Use something like this...

    #If VBA7 Then
Declare PtrSafe Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As LongPtr, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As LongPtr) _
       As Long 
#Else
Declare Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As Long, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As Long) _
       As Long 
 #EndIf

    Where an MDL function uses pointers, the Long type is used for 32-bit VBA.  Microsoft introduced the LongPtr type with 64-bit VBA.  So change this...

    Dim surfaceEdP As LongLong, boundaryEdP As LongLong

    to this...

    Dim surfaceEdP As LongPtr, boundaryEdP As LongPtr

     
    Regards, Jon Summers
    LA Solutions

  • 0 Offline in reply to Jon Summers

    Thanks Jon, but nothing is changed, same behaviour.

    This is the new edited code:

    Option Explicit

#If VBA7 Then
Declare PtrSafe Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As LongPtr, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As LongPtr) _
       As Long
#Else
Declare Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As Long, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As Long) _
       As Long
#End If
Sub GetParametersFromSurface()
    Dim mySurface As Element, myBoundary As Element
    Set mySurface = ActiveModelReference.GetElementByID(DLongFromLong(4090))
    
    Dim surfaceEdP As LongPtr, boundaryEdP As LongPtr
    Dim center As Point3d, axis As Point3d
    Dim sweepAngle As Double
    surfaceEdP = mySurface.MdlElementDescrP
    mdlSurface_extractRevolution2 boundaryEdP, center, axis, sweepAngle, surfaceEdP
    MsgBox "center=(" & center.X & "," & center.Y & "," & center.Z & "), sweepAngle=" & sweepAngle
    
    Set myBoundary = Application.MdlCreateElementFromElementDescrP(boundaryEdP)
    If myBoundary.Type = msdElementTypeArc Then
        Dim myArc As ArcElement
        Set myArc = myBoundary.AsArcElement
        MsgBox "boundary center=(" & myArc.CenterPoint.X & "," & myArc.CenterPoint.Y & "," & myArc.CenterPoint.Z & "), boundary sweepAngle=" _
               & myArc.sweepAngle & ", boundary radius=(" & myArc.PrimaryRadius & "," & myArc.SecondaryRadius & ")"
    End If
End Sub

    And again it pops up wrong data and then it aborts PlantWise...

  • 0 Offline in reply to Roberto Cardosi
    Roberto Cardosi said:
    it pops up wrong data

    With VBA and other APIs, angles are always in radians.  You need to convert to degrees for human consumption...

    MsgBox "boundary center=(" & CStr (myArc.CenterPoint.X) & "," & CStr (myArc.CenterPoint.Y) & "," & CStr (myArc.CenterPoint.Z) & _
    "), boundary sweepAngle=" & _
    CStr (Degrees (myArc.sweepAngle)) & _
    ", boundary radius=(" & CStr (myArc.PrimaryRadius) & "," & _
    CStr (.SecondaryRadius) & ")"
    Roberto Cardosi said:
    I get the following error

    You've run into a memory leak when using C function calls from VBA.  That MDL function passes you a element descriptor,  which is the profile of revolution.  It points to allocated memory.  You must free that memory before you exit your subroutine...

        ...
    mdlElmdscr_freeAll boundaryEdPP
End Sub

    You'll need to add these MDL declarations at the beginning of the VBA module...

    #If VBA7 Then
Declare PtrSafe Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As LongPtr, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As LongPtr) _
       As Long
Declare PtrSafe Sub mdlElmdscr_freeAll _
       Lib "stdmdlbltin.dll" _
       (ByRef elemDescrPP As LongPtr)
#Else
Declare Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As Long, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As Long) _
       As Long
Declare Sub mdlElmdscr_freeAll _
       Lib "stdmdlbltin.dll" _
       (ByRef elemDescrPP As Long)       
#End If

     
    Regards, Jon Summers
    LA Solutions

  • 0 Offline in reply to Jon Summers

    Jon, thanks again for your support, but it still does not work...

    It seems not to be a problem regarding memory leaking and/or formatting output data...

    In the following VBA code I added comments that better explain (I hope) the problems I encountered:

    Option Explicit

#If VBA7 Then
Declare PtrSafe Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As LongPtr, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As LongPtr) _
       As Long
Declare PtrSafe Sub mdlElmdscr_freeAll _
       Lib "stdmdlbltin.dll" _
       (ByRef elemDescrPP As LongPtr)
#Else
Declare Function mdlSurface_extractRevolution2 _
       Lib "stdmdlbltin.dll" ( _
       ByRef boundaryEdPP As Long, _
       ByRef centerP As Point3d, _
       ByRef axisP As Point3d, _
       ByRef sweepAngleP As Double, _
       ByVal surfaceEdP As Long) _
       As Long
Declare Sub mdlElmdscr_freeAll _
       Lib "stdmdlbltin.dll" _
       (ByRef elemDescrPP As Long)
#End If
Sub GetParametersFromSurface()
    Dim mySurface As Element, myBoundary As Element
    Set mySurface = ActiveModelReference.GetElementByID(DLongFromLong(4090))
    
    Dim surfaceEdP As LongPtr, boundaryEdP As LongPtr
    Dim center As Point3d, axis As Point3d
    Dim sweepAngle As Double
    surfaceEdP = mySurface.MdlElementDescrP
    mdlSurface_extractRevolution2 boundaryEdP, center, axis, sweepAngle, surfaceEdP
    MsgBox "center=(" & center.X & "," & center.Y & "," & center.Z & "), sweepAngle=" & sweepAngle
    'the above msgbox should pop up following correct result: center={0,0,30} and sweepangle=3.14 (180 degree)
    'instead it popped up the following wrong result: center={0,0,0} and sweepangle=0
        
    'the following statement throws the exception log I previously linked
    'and aborts PlantWise
    Set myBoundary = Application.MdlCreateElementFromElementDescrP(boundaryEdP)
    If myBoundary.Type = msdElementTypeArc Then
        Dim myArc As ArcElement
        Set myArc = myBoundary.AsArcElement
        MsgBox "boundary center=(" & CStr(myArc.CenterPoint.X) & "," & CStr(myArc.CenterPoint.Y) & "," & CStr(myArc.CenterPoint.Z) & _
            "), boundary sweepAngle=" & _
            CStr(Degrees(myArc.sweepAngle)) & _
            ", boundary radius=(" & CStr(myArc.PrimaryRadius) & "," & _
            CStr(myArc.SecondaryRadius) & ")"
    End If
    
    mdlElmdscr_freeAll boundaryEdP
End Sub

    I hope I was clear...

  • 0 Offline in reply to Roberto Cardosi

    Taking things one step at a time, the following code successfully extracts the metrics of your cap element...

    ' ---------------------------------------------------------------------
Public Function FormatPoint3d(ByRef pt As Point3d) As String
    Dim s                                   As String
    Const Pattern                           As String = "#,##0.00"
    s = Format(pt.X, Pattern) & ", " & Format(pt.Y, Pattern) & ", " & Format(pt.Z, Pattern)
    FormatPoint3d = s
End Function
' ---------------------------------------------------------------------
Public Sub AnalyseType18(ByVal oHead As Element)
    Dim msg                                 As String
    msg = "Analyse element type " & CStr(oHead.Type)
    ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
    Debug.Print "Analyse element type " & CStr(oHead.Type)
    If (oHead.Type = msdElementTypeSolid Or oHead.Type = msdElementTypeSurface) Then
        Dim axis                            As Point3d
        Dim centre                          As Point3d
        Dim sweep                           As Double
        Const SUCCESS                       As Long = 0
        Const NULL_PTR                      As LongPtr = 0
        If (SUCCESS = mdlSurface_extractRevolution2(NULL_PTR, centre, axis, sweep, oHead.MdlElementDescrP)) Then
            msg = "Centre XYZ=" & FormatPoint3d(centre) & _
                    " Axis XYZ=" & FormatPoint3d(axis) & _
                    " Sweep Angle=" & CStr(Degrees(sweep))
            ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
            Debug.Print msg
        Else
            msg = "Unable to extract revolution parameters"
            ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
        End If
    
    Else
        msg = "Invalid element for Type 18/19 analysis"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
    End If
End Sub

    The result, shown in the Message Center, is...

    Centre XYZ=0.00, 0.00, 30.00 Axis XYZ=0.00, 0.00, 1.00 Sweep Angle=180

    This procedure successfully extracts the boundary arc...

    Sub AnalyseType18Boundary(ByVal oHead As Element)
    Dim msg                                 As String
    msg = "Analyse element type " & CStr(oHead.Type)
    ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
    Debug.Print "Analyse element type " & CStr(oHead.Type)
    If (oHead.Type = msdElementTypeSolid Or oHead.Type = msdElementTypeSurface) Then
        Dim axis                            As Point3d
        Dim centre                          As Point3d
        Dim sweep                           As Double
        Dim oBoundary                       As Element
        Dim elementAddress                  As LongPtr
        Const SUCCESS                       As Long = 0
        
        If (SUCCESS = mdlSurface_extractRevolution2(elementAddress, centre, axis, sweep, oHead.MdlElementDescrP)) Then
            Set oBoundary = Application.MdlCreateElementFromElementDescrP(elementAddress)
            msg = "Boundary element type " & CStr(oBoundary.Type)
            ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
            Debug.Print msg
            If oBoundary.IsArcElement Then
                Dim oArc                    As ArcElement
                Set oArc = oBoundary.AsArcElement
                msg = "Analyse arc element"
                ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
                Debug.Print msg
                msg = "Centre XYZ=" & FormatPoint3d(oArc.CenterPoint) & _
                        " Sweep angle=" & CStr(Radians(oArc.SweepAngle)) & _
                        " Radius=" & CStr(oArc.PrimaryRadius)
                ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
                Debug.Print msg
            Else
                msg = "Boundary is not an arc element"
                ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
            End If
        Else
            msg = "Unable to extract revolution boundary"
            ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
        End If
    
    Else
        msg = "Invalid element for Type 18/19 analysis"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
    End If
End Sub

    Note that I don't free memory — my previous advice was incorrect. Memory management is handled by the Element created by MdlCreateElementFromElementDescrP.

     
    Regards, Jon Summers
    LA Solutions

Reply
  • 0 Offline in reply to Roberto Cardosi

    Taking things one step at a time, the following code successfully extracts the metrics of your cap element...

    ' ---------------------------------------------------------------------
Public Function FormatPoint3d(ByRef pt As Point3d) As String
    Dim s                                   As String
    Const Pattern                           As String = "#,##0.00"
    s = Format(pt.X, Pattern) & ", " & Format(pt.Y, Pattern) & ", " & Format(pt.Z, Pattern)
    FormatPoint3d = s
End Function
' ---------------------------------------------------------------------
Public Sub AnalyseType18(ByVal oHead As Element)
    Dim msg                                 As String
    msg = "Analyse element type " & CStr(oHead.Type)
    ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
    Debug.Print "Analyse element type " & CStr(oHead.Type)
    If (oHead.Type = msdElementTypeSolid Or oHead.Type = msdElementTypeSurface) Then
        Dim axis                            As Point3d
        Dim centre                          As Point3d
        Dim sweep                           As Double
        Const SUCCESS                       As Long = 0
        Const NULL_PTR                      As LongPtr = 0
        If (SUCCESS = mdlSurface_extractRevolution2(NULL_PTR, centre, axis, sweep, oHead.MdlElementDescrP)) Then
            msg = "Centre XYZ=" & FormatPoint3d(centre) & _
                    " Axis XYZ=" & FormatPoint3d(axis) & _
                    " Sweep Angle=" & CStr(Degrees(sweep))
            ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
            Debug.Print msg
        Else
            msg = "Unable to extract revolution parameters"
            ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
        End If
    
    Else
        msg = "Invalid element for Type 18/19 analysis"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
    End If
End Sub

    The result, shown in the Message Center, is...

    Centre XYZ=0.00, 0.00, 30.00 Axis XYZ=0.00, 0.00, 1.00 Sweep Angle=180

    This procedure successfully extracts the boundary arc...

    Sub AnalyseType18Boundary(ByVal oHead As Element)
    Dim msg                                 As String
    msg = "Analyse element type " & CStr(oHead.Type)
    ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
    Debug.Print "Analyse element type " & CStr(oHead.Type)
    If (oHead.Type = msdElementTypeSolid Or oHead.Type = msdElementTypeSurface) Then
        Dim axis                            As Point3d
        Dim centre                          As Point3d
        Dim sweep                           As Double
        Dim oBoundary                       As Element
        Dim elementAddress                  As LongPtr
        Const SUCCESS                       As Long = 0
        
        If (SUCCESS = mdlSurface_extractRevolution2(elementAddress, centre, axis, sweep, oHead.MdlElementDescrP)) Then
            Set oBoundary = Application.MdlCreateElementFromElementDescrP(elementAddress)
            msg = "Boundary element type " & CStr(oBoundary.Type)
            ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
            Debug.Print msg
            If oBoundary.IsArcElement Then
                Dim oArc                    As ArcElement
                Set oArc = oBoundary.AsArcElement
                msg = "Analyse arc element"
                ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
                Debug.Print msg
                msg = "Centre XYZ=" & FormatPoint3d(oArc.CenterPoint) & _
                        " Sweep angle=" & CStr(Radians(oArc.SweepAngle)) & _
                        " Radius=" & CStr(oArc.PrimaryRadius)
                ShowMessage msg, msg, msdMessageCenterPriorityDebug, False
                Debug.Print msg
            Else
                msg = "Boundary is not an arc element"
                ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
            End If
        Else
            msg = "Unable to extract revolution boundary"
            ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
        End If
    
    Else
        msg = "Invalid element for Type 18/19 analysis"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
    End If
End Sub

    Note that I don't free memory — my previous advice was incorrect. Memory management is handled by the Element created by MdlCreateElementFromElementDescrP.

     
    Regards, Jon Summers
    LA Solutions

Children
No Data
Communities
Support and Services
Training and Learning
Social Media