VBA macro that calculates slope based on two elevation points and a distance.

Hello,

I'm trying to write something in VBA that calculates slope based on two elevation points and a distance. All the information is given. I just want to click on the two elevation text values and then the dimension value to produce a percent value in text that I can place on the sheet. Can the value of a dimension be pulled into a variable?

Thanks in advance for your help.

Parents
  • Why not,  just take the origin point of your text to get your x, y and then the text contains the elevation. It is just math after that.

    LARRY WILSON | Senior Designer


    Crawford, Murphy & Tilly | Engineers & Consultants
    84 Remick Blvd. | Springboro, OH  45066
     lwilson@cmtengr.com

  • Thank you for your response Larry,

    The information on the sheet is not to scale. But its all math. Everything is given. All I want to do is click on the highest elevation text then the lowest elevation text and divide by length by clicking on the given dimension (thats not to scale). Three clicks and then a slope is given and hanging on my cursor for me to place.

  • use an ILocateCommand Event and then just pick the texts and dimension

    below is what is need to get dimension text.

    Dim DimText As String

    Dim oDim As DimensionElement

    DimText = oDim.PrimaryText

    LARRY WILSON | Senior Designer


    Crawford, Murphy & Tilly | Engineers & Consultants
    84 Remick Blvd. | Springboro, OH  45066
     lwilson@cmtengr.com

  • DimText = oDim.PrimaryText

    In my opinion this is not correct.

    From MicroStation VBA documenation: Gets this object's segment-specific primary overridden text. If the text is not overridden, this will return an asterisk '*'. So for normal dimensions it will return * only. I suppose ActualValue property I mentioned in my first replay is better solution (but have had no time to do any hands-on test).

    Regards,

      Jan

  • Actually you are half right, ActualValue property return the Actual length or angle.

    ActualValue Property

                           

    Read-only Double.

    Gets this object's segment-specific actual value of the dimension. This returns the actual length or angle value of the dimension.

    So the best solution would be read the .PrimaryText  result, then if it returns and * or null, then read the .ActualValue. 

    LARRY WILSON | Senior Designer


    Crawford, Murphy & Tilly | Engineers & Consultants
    84 Remick Blvd. | Springboro, OH  45066
     lwilson@cmtengr.com

  • So the best solution would be read the .PrimaryText  result, then if it returns and * or null, then read the .ActualValue. 

    I am not sure whether it's the best solution. It seems to be the right solution logically, but it dependes on local conditions (if possibly wrong results are still valid, because overriden dimensions are accepted or not).

    I have to say I don't even think as possible to do any calculation based on manually entered values that override the original values. It leads to zero data quality. But maybe it's just personal habit because all my customers use the rule such design files are evaluated as invalid and returned back to be reworked.

    With regards,

      Jan

  • Hi,

    here is an example of ILocate command that does not work with textual data (text, dimension) and always use text element origins regardles they are in active design file or in an attachment, scaled or not.

    Not extensively tested, but I am quite sure it's correct.

    Option Explicit
    Option Base 1
    
    Dim pointIndex As Integer
    Dim textElems(2) As TextElement
    
    Implements ILocateCommandEvents
    
    Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, Point As Point3d, ByVal View As View)
        ProcessAcceptedText Element.AsTextElement
    End Sub
    
    Private Sub ILocateCommandEvents_Cleanup()
    
    End Sub
    
    Private Sub ILocateCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateFailed()
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateFilter(ByVal Element As Element, Point As Point3d, Accepted As Boolean)
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateReset()
    
    End Sub
    
    Private Sub ILocateCommandEvents_Start()
        InitializeCommand
    End Sub
    
    Private Sub InitializeCommand()
    
        Dim loc As LocateCriteria
        Set loc = CommandState.CreateLocateCriteria(False)
        loc.ExcludeAllTypes
        loc.IncludeType msdElementTypeText
        CommandState.SetLocateCriteria loc
    
        ShowCommand "Slope calculation"
        ShowPrompt "Identify first text element"
        
        pointIndex = 1
    
    End Sub
    
    Private Sub ProcessAcceptedText(text As TextElement)
        Set textElems(pointIndex) = text
        
        If pointIndex = 1 Then
            pointIndex = 2
            ShowPrompt "Identify second text element"
        Else
            CalculateSlope
        End If
    End Sub
    
    Private Sub CalculateSlope()
        TransformCoordinates textElems(1)
        TransformCoordinates textElems(2)
          
        ' Do slope calculations here like
        ' distance = textElems(2).Origin.X - ....
        ' angle =
    End Sub
    
    Private Sub TransformCoordinates(text As TextElement)
        If text.ModelReference.IsAttachment Then
            Dim transformMasterToReference As Transform3d
            transformMasterToReference = text.ModelReference.AsAttachment.GetMasterToReferenceTransform
            text.Transform transformMasterToReference
        End If
    End Sub
    
    

    With regards,

      Jan

Reply
  • Hi,

    here is an example of ILocate command that does not work with textual data (text, dimension) and always use text element origins regardles they are in active design file or in an attachment, scaled or not.

    Not extensively tested, but I am quite sure it's correct.

    Option Explicit
    Option Base 1
    
    Dim pointIndex As Integer
    Dim textElems(2) As TextElement
    
    Implements ILocateCommandEvents
    
    Private Sub ILocateCommandEvents_Accept(ByVal Element As Element, Point As Point3d, ByVal View As View)
        ProcessAcceptedText Element.AsTextElement
    End Sub
    
    Private Sub ILocateCommandEvents_Cleanup()
    
    End Sub
    
    Private Sub ILocateCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateFailed()
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateFilter(ByVal Element As Element, Point As Point3d, Accepted As Boolean)
    
    End Sub
    
    Private Sub ILocateCommandEvents_LocateReset()
    
    End Sub
    
    Private Sub ILocateCommandEvents_Start()
        InitializeCommand
    End Sub
    
    Private Sub InitializeCommand()
    
        Dim loc As LocateCriteria
        Set loc = CommandState.CreateLocateCriteria(False)
        loc.ExcludeAllTypes
        loc.IncludeType msdElementTypeText
        CommandState.SetLocateCriteria loc
    
        ShowCommand "Slope calculation"
        ShowPrompt "Identify first text element"
        
        pointIndex = 1
    
    End Sub
    
    Private Sub ProcessAcceptedText(text As TextElement)
        Set textElems(pointIndex) = text
        
        If pointIndex = 1 Then
            pointIndex = 2
            ShowPrompt "Identify second text element"
        Else
            CalculateSlope
        End If
    End Sub
    
    Private Sub CalculateSlope()
        TransformCoordinates textElems(1)
        TransformCoordinates textElems(2)
          
        ' Do slope calculations here like
        ' distance = textElems(2).Origin.X - ....
        ' angle =
    End Sub
    
    Private Sub TransformCoordinates(text As TextElement)
        If text.ModelReference.IsAttachment Then
            Dim transformMasterToReference As Transform3d
            transformMasterToReference = text.ModelReference.AsAttachment.GetMasterToReferenceTransform
            text.Transform transformMasterToReference
        End If
    End Sub
    
    

    With regards,

      Jan

Children
No Data