Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

RE: [V8i VBA] Attempting to automate placement of multiple points along element using VBA

$
0
0

Hi Martin, thanks for replying.

Well noticed! I did have it there previously but for some reason must have deleted it when switching the function code.

Hi Jon,

I appreciate your points and understand if you don't wish to contribute further on this topic. Your help to date has been invaluable and I certainly don't expect maintenance or a fully coded solution, just suggestive points on things to look out for but I think I'm close to completion. I'm trying to learn as much as I can myself and your advice is always welcome. If I ever have the need for a professional coded solution then I would of course be in touch.

For those that do wish to contribute suggestions, following Martin's suggestion the previous error is gone and I am now getting this error near the end of the project:

Private Function PlacePoints(ByVal cellName As String) As Long
    PlacePoints = 0
'    On Error GoTo err_PlacePoints
    Dim nPoints                             As Long
    nPoints = ArraySize(m_strData)
    Dim graphicGroup                        As Long
    graphicGroup = Application.UpdateGraphicGroupNumber
    Dim origin                              As Point3d
    Dim cellScale                           As Point3d
    cellScale = ActiveSettings.Scale
    Dim valid                               As Boolean
    valid = False
    Dim nPlaced                             As Long
    nPlaced = 0
    Dim N                                   As Long
    For N = 0 To nPoints - 1
        Select Case m_oLine.Type
        Case msdElementTypeComplexString
            origin = m_oLine.AsComplexStringElement.PointAtDistance(m_strData(N, 0))
            valid = m_strData(N, 0) < m_oLine.AsComplexStringElement.length
        Case msdElementTypeLine, msdElementTypeLineString
            origin = m_oLine.AsLineElement.PointAtDistance(m_strData(N, 0))
            valid = m_strData(N, 0) < m_oLine.AsLineElement.length
        Case msdElementTypeArc
            origin = m_oLine.AsArcElement.PointAtDistance(m_strData(N, 0))
            valid = m_strData(N, 0) < m_oLine.AsArcElement.length
        Case msdElementTypeBsplineCurve
            origin = m_oLine.AsBsplineCurveElement.PointAtDistance(m_strData(N, 0))
            valid = m_strData(N, 0) < m_oLine.AsBsplineCurveElement.length
        End Select
        If valid Then
            Dim oMark                       As CellElement
            Set oMark = CreateCellElement2(cellName, origin, cellScale, True, Matrix3dIdentity)'   Each point on the current line has the same graphic group
            oMark.graphicGroup = graphicGroup
            ChainageValues oMark, m_strData, N
            ActiveModelReference.AddElement oMark
            nPlaced = 1 + nPlaced
        End If
    Next N
    PlacePoints = nPlaced
    Exit Function
    
'err_PlacePoints:
'    ReportError MODULE_NAME, "PlacePoints"
End Function



The debug highlights the red line above but the error doesn't provide much information for what I need to fix. That line of code was previously working fine when I was just using a 1d array however since I have switched to a 2D array its now erroring yet no part of that line utilises the array so I am at a loss. 


Viewing all articles
Browse latest Browse all 7260

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>