I need some help on this. I have a grid of lines/arcs that I need to be able to select and run the VBA and have it place a data point at the all the intersections of the selected elements. I have done some reading online, but I dont know enough about VBA in Microstation to get started. I have attached a screen shot of the grid I am working with. Actually I am trying to locate these points and using the tracking tool in InRoads I need to find surface elevations at all the intersection points. I think I can select the lines and then activate the tracking tool in InRoads and then run the VBA to place a data point at all the intersections. Any help will be greatly appreciated.
Unknown said: I have attached a screen shot ...
A screen-shot is good, but a DGN file is better. We all use MicroStation, so a DGN file illustrates better the data you have.
In this case, it's important to know about your dimensionality. Presumably this is a 3D model, but what about your grid? Are all those lines (a) planar and (b) do they lie on the same plane? We can't deduce answers to those questions from a screen-shot.
Follow Stefan's suggestion: use the ModelReference.Scan method to get an ElementEnumerator of lines. Here's an example of a VBA project to collect lines.
Regards, Jon Summers LA Solutions
Example.dgnJon, I have attached a DGN that is similar to what I am working with. I have deleted everything except the lines I am working with in this VBA. I actually don't want to scan the entire file because the file will likely contain elements that I don't need to find the intersection of. I want to be able to make a selection of lines and arcs and run the VBA to find all the intersections between the selected elements then have the VBA do the equivalent of left clicking (placing a data point) at the coordinate of the intersection. The file I am working with is actually 2D because I need to get the surface elevations from InRoads tracking tool.
Ok. Here is my code so far. It is working ok and it is finding the intersections but I have a couple of problems. The first is that when I select the lines and run the VBA it will usually find two intersection points at each intersection each with apparently different rotations so it will put two data points at each intersection which is not ideal. I think this has something to do with the Matrix3dIsIdentity when finding the intersection but I don't know how to make it ignore the rotation and only find one intersection point. The other thing is that I need it to process the selected elements against all visible levels in View 1 not the level that I have defined in the VBA code. Basically I need the end users to be able to select the elements and turn the level on that they want to process the selected elements against and run the VBA. I need to assign all visible levels to the ScanEnumerator variable.
LabelIntersections.mvba
Unknown said: I think this has something to do with the Matrix3dIsIdentity p = el1.AsIntersectableElement.GetIntersectionPoints(el2, Application.Matrix3dIsIdentity)
p = el1.AsIntersectableElement.GetIntersectionPoints(el2, Application.Matrix3dIsIdentity)
It's a good job you mentioned that! CAD apps, including MicroStation, use 3D transforms and matrices in their geometric computations. In MicroStation VBA, a rotation is defined by a Matrix3D user defined type (UDT).
That method takes a Matrix3D to inform it of any required rotation to consider when calculating intersections. You often provide a zero rotation (the identity matrix), given by function Matrix3dIdentity. You've written Matrix3dIsIdentity, which answers the question "Is this a zero-rotation matrix?" with a Boolean answer, not a Matrix3D.
I'm surprised that you didn't see a compilation error. Try this instead...
p = el1.AsIntersectableElement.GetIntersectionPoints(el2, Application.Matrix3dIdentity)
Hi Philip,
good job so far.
I think Jons suggestion should do the job.
And you might find this function useful, which includes all visible level of a certain view into a scancriteria.
(Untested.)
Function AddVisibleLevelsToScanCriteria(sc As ElementScanCriteria, viewindex As Integer)
Dim vw As View
Dim lv As Level
Set vw = ActiveDesignFile.Views(viewindex)
For i = 1 To ActiveDesignFile.Levels.Count
Set lv = ActiveDesignFile.Levels(i)
If lv.IsDisplayedInView(vw) Then
sc.IncludeLevel lv
End If
Next i
End Function
Regards, Stefan.
Jon,
Sorry I mistyped before. I am using Matrix3dIdentity.
Sub LabelIntersectionsofLines()
Dim ScanCriteria As New ElementScanCriteria
Dim ScanEnumerator As ElementEnumerator
Dim ScanEnumerator2 As ElementEnumerator
Dim MyElement As Element
Dim MyElement2 As Element
Dim t As Integer
Dim i As Integer
Dim points() As Point3d
Dim point As Point3d
i = -1
ScanCriteria.ExcludeAllLevels
ScanCriteria.IncludeLevel ActiveDesignFile.Levels("1Left_Coping")
Set ScanEnumerator = ActiveModelReference.Scan(ScanCriteria)
Set ScanEnumerator2 = ActiveModelReference.GetSelectedElements
Do While ScanEnumerator.MoveNext
Set MyElement = ScanEnumerator.Current
Do While ScanEnumerator2.MoveNext
Set MyElement2 = ScanEnumerator2.Current
If MyElement.IsIntersectableElement Then
points = MyElement.AsIntersectableElement.GetIntersectionPoints(MyElement2, Matrix3dIdentity)
For t = 0 To UBound(points)
MsgBox ("x:" & points(t).X & " " & "y:" & points(t).Y & " " & "z:" & points(t).Z)
CadInputQueue.SendDataPoint points(t), 1
Next
Loop
End Sub
Stefan. I cant figure out where this goes in my code. Can you look at the code I pasted above and show me how this would work in my code
Stefan,
I changed it to compare the current selection as both ElementEnumerators so it is effectively comparing against itself so I don't have to worry about the levels. I can have the user select all the elements and then it will give them all the intersection points.
I have figured out when it gives me the duplicate intersection points. When a line has been extended to intersection of the other element then it will give me two intersection points but if I extend the line to where they are crossing each other not one element extended to the intersection then it will only give me one intersection point. I don't know what is causing this but this is when the issues occurs. Thanks for all your help.
Comment out your Line and put mine instead:
'ScanCriteria.IncludeLevel ActiveDesignFile.Levels("1Left_Coping")
AddVisibleLevelsToScanCriteria ScanCriteria, 0
And you have to paste my function into your module of course.
OK guys. I am still having issues with this VBA. Here is the current code. Now the problem I am having is when a level has more than 1 element on it then it will only process the first element. Now I am comparing my selection set vs. the active level and it works fine as long as the active level has only one element. If the active level has 2 or more elements then it will only find the intersection of my selection set vs the first element on the level. PLEASE HELP!!! THANKS!
Sub LabelIntersections()
ScanCriteria.IncludeLevel ActiveSettings.Level
'MsgBox ("x:" & points(t).X & " " & "y:" & points(t).Y & " " & "z:" & points(t).Z)
CadInputQueue.SendCommand "MDL SILENTLOAD CLEANUP"
lngTemp = Not 15
lngTemp = GetCExpressionValue("sdG.duplicatesAction", "CLEANUP") And lngTemp
SetCExpressionValue "sdG.duplicatesAction", lngTemp Or 2, "CLEANUP"
CadInputQueue.SendCommand "CLEANUP DO"
CadInputQueue.SendCommand "DMSG UPDATEDIALOG -400"
CadInputQueue.SendCommand "MDL UNLOAD CLEANUP"
Set ScanEnumerator = Nothing
Set ScanEnumerator2 = Nothing
Phillip:
You should not process points if MyElement.IsIntersectableElement returns False.
It should be like this:
If MyElement.IsIntersectableElement Then points = MyElement.AsIntersectableElement.GetIntersectionPoints(MyElement2, Matrix3dIdentity)
For t = 0 To UBound(points) CadInputQueue.SendDataPoint points(t), 1 Next End If
Calls:
Set ScanEnumerator = NothingSet ScanEnumerator2 = Nothing
are in your case redundant.
You've mixing program code with queued commands, which is not a good idea. Use either key-ins or program code, but not both.
In this case, you queue a command to send a data point in the middle of your loop. A queued command won't bubble to the top of MicroStation's input queue until nothing else is going on. But there is something going on: the code in your loop.
Write a procedure to add a marker at each data point. I've provided PlaceMarker, but you can call it what you want.
' --------------------------------------------------------------------- Sub PlaceMarker(ByRef point As Point3d) Dim oCircle As EllipseElement Set oCircle = CreateEllipseElement2(Nothing, point, 1#, 1#, Matrix3dIdentity) ActiveModelReference.AddElement oCircle End Sub ' --------------------------------------------------------------------- Sub LabelIntersections() Dim oScanCriteria As New ElementScanCriteria Dim oScannedLines As ElementEnumerator Dim oSelectedLines As ElementEnumerator Dim oScannedElement As Element Dim oSelectedElement As Element Dim points() As Point3d oScanCriteria.ExcludeAllLevels oScanCriteria.IncludeLevel ActiveSettings.Level Set oScannedLines = ActiveModelReference.Scan(oScanCriteria) Set oSelectedLines = ActiveModelReference.GetSelectedElements Do While oScannedLines.MoveNext Set oScannedElement = oScannedLines.Current Do While oSelectedLines.MoveNext Set oSelectedElement = oSelectedLines.Current ' Make sure that we're not comparing an element with itself If 0 <> DLongComp(oScannedElement.ID, oSelectedElement.ID) Then If oScannedElement.IsIntersectableElement Then points = oScannedElement.AsIntersectableElement.GetIntersectionPoints(oSelectedElement, Matrix3dIdentity) End If Dim t As Integer For t = 0 To UBound(points) 'MsgBox ("x:" & points(t).X & " " & "y:" & points(t).Y & " " & "z:" & points(t).Z) Debug.Print "x:" & points(t).X & " " & "y:" & points(t).Y & " " & "z:" & points(t).Z 'CadInputQueue.SendDataPoint points(t), 1 PlaceMarker points(t) Next End If Loop Loop CadInputQueue.SendCommand "MDL SILENTLOAD CLEANUP" Dim lngTemp As Long lngTemp = Not 15 lngTemp = GetCExpressionValue("sdG.duplicatesAction", "CLEANUP") And lngTemp SetCExpressionValue "sdG.duplicatesAction", lngTemp Or 2, "CLEANUP" CadInputQueue.SendCommand "CLEANUP DO" CadInputQueue.SendCommand "DMSG UPDATEDIALOG -400" CadInputQueue.SendCommand "MDL UNLOAD CLEANUP" Set oScannedLines = Nothing Set oSelectedLines = Nothing End Sub
Those lines after the loop look fishy. That's write-only code. I have no idea what it does, and neither will you in six months time. Wrap it in a procedure and give it a meaningful name 8-)
+1 Jon.
Maybe we want to pretty up the nested loops...?
The "fishy" code at the bottom looks like a check for duplicate lineworks or elements.
You could implement such checks in your code to. Simply create a collection of points a check against that list before placing the mark.
' ---------------------------------------------------------------------
Sub PlaceMarker(ByRef point As Point3d)
Dim oCircle As EllipseElement
Set oCircle = CreateEllipseElement2(Nothing, point, 1#, 1#, Matrix3dIdentity)
ActiveModelReference.AddElement oCircle
Sub LabelIntersections_HandleOneElement(oSelectedElement as Element)
Dim oScanCriteria As New ElementScanCriteria
Dim oScannedLines As ElementEnumerator
Dim oScannedElement As Element
oScanCriteria.ExcludeAllLevels
oScanCriteria.IncludeLevel ActiveSettings.Level
Set oScannedLines = ActiveModelReference.Scan(oScanCriteria)
Do While oScannedLines .MoveNext
Set oScannedElement = oScannedLines .Current
If oScannedElement.IsIntersectableElement Then
points = oScannedElement.AsIntersectableElement.GetIntersectionPoints(oSelectedElement, Matrix3dIdentity)
PlaceMarker points(t)
Dim oSelectedLines As ElementEnumerator
Dim oSelectedElement As Element
Set oSelectedLines = ActiveModelReference.GetSelectedElements
Do While oSelectedLines.MoveNext
Set oSelectedElement = oSelectedLines.Current
LabelIntersections_HandleOneElement oSelectedElement
....