Hello All, I'm trying to create a primitive gusset plate routine in VBA to run in AECOsim Building Designer (SS6). I want the VBA routine to draw a 4'x4' box at the start and end of each element (line). Lines in ABD for structural members are actually cells, and as a result, I can't figure out how to get coordinates for the start and endpoint of my "lines". I can only use .StartPoint and .EndPoint when using .AsLineElement, but lines in ABD are .IsCellElement, so I can only use .Origin (I think). Is there any way to get a cell element to use the .AsLineElement callout, or maybe somehow trace a temporary line over the cell to use it's start and end points? I have code that works when I draw simple lines, so I know I'm on the right track. I don't have a lot of experience with VBA and I've been reading the forums, help menu, and google searches for two days, but I just can't work past this. Thanks for any help.
Sub GussetPlates() 'Scan For Horizontal Bracing Dim StartPoint As Point3d Dim Point As Point3d, Point2 As Point3d Dim myCounter As Integer Dim myElementEnumerator As ElementEnumerator Dim myScanCriteria As New ElementScanCriteria Dim myElement As Element Dim myGussPL As Level Dim myHB As Level Dim myVB As Level Set myHB = ActiveDesignFile.Levels("S-STL-HB") Set myVB = ActiveDesignFile.Levels("S-STL-VB") Set myGussPL = ActiveDesignFile.Levels("S-STL-PLAT-GUSS") Dim myPoints As Point3d Dim myLine As LineElement Dim myEndPt As Variant Dim myStartPt As Variant Dim myRange As Range3d myScanCriteria.ExcludeNonGraphical myScanCriteria.ExcludeAllLevels myScanCriteria.IncludeLevel myHB Set myElementEnumerator = ActiveModelReference.Scan(myScanCriteria) myElementEnumerator.Reset While myElementEnumerator.MoveNext Set myElement = myElementEnumerator.Current If myElement.IsCellElement Then ActiveSettings.Level = myGussPL '''THIS IS WHERE I'M STUCK''' myStartPt = myElement.AsLineElement.StartPoint myEndPt = myElement.AsLineElement.EndPoint CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units StartPoint.X = myStartPt.X StartPoint.Y = myStartPt.Y StartPoint.Z = myStartPt.Z 'Send a data point to the current command Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 CommandState.StartDefaultCommand CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units StartPoint.X = myEndPt.X StartPoint.Y = myEndPt.Y StartPoint.Z = myEndPt.Z 'Send a data point to the current command Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 CommandState.StartDefaultCommand End If Wend End Sub
Amador Ontiveros said: Is there any way to get a cell element to use the .AsLineElement callout
No: a cell is not a line. It may contain one or more lines, but .AsLineElement can't auto-magically work out which line.
.AsLineElement
Amador Ontiveros said: If myElement.IsCellElement Then
If myElement.IsCellElement Then
After that statement, you need to analyse the cell and look for lines. Use myElement.AsCellElement.GetSubElements to get an enumeration of the cell's components. Iterate that object to find your line(s)...
myElement.AsCellElement.GetSubElements
Dim oComponents As ElementEnumerator Set oComponents = myElement.AsCellElement.GetSubElements () ' Search oComponents for interesting elements
Regards, Jon Summers LA Solutions
Thanks Jon, that makes perfect sense. It wouldn't know which line in the cell I want. I appreciate the direction!
Amador Ontiveros said:It wouldn't know which line in the cell I want
If there are multiple lines there's clearly a problem in finding the right one. Is the line you want distinguished in any way; for example, does it have unique symbology?
Yes, the lines ABD uses for steel placement has different symbology and is on a different level than the steel shape graphics generated by the catalog.
Amador Ontiveros said:the lines ABD uses for steel placement has different symbology and is on a different level
In that case...
Dim oComponents As ElementEnumerator Set oComponents = myElement.AsCellElement.GetSubElements () ' Search oComponents for interesting elements Do While oComponents.MoveNext If oComponents.Current.IsLineElement Then If MatchSymbology (oComponents.Current.AsLineElement) Then With oComponents.Current.AsLineElement Dim points(0 To 1) As Point3d points(0) = .StartPoint points(1) = .EndPoint End With EndIf Endif Loop
Here's your MatchSymbology function …
Function MatchSymbology (ByVal oLine As LineElement) As Boolean MatchSymbology = False If oLine.Level.Name = "YourLevel" Then MatchSymbology = True ' more symbology tests here EndIf End Function
Thanks Jon! Very helpful. I will test later today.
So I think I have my code set up properly, it doesn't return any errors. I don't know if AECOsim handles sub-elements differently than straight Microstation or if it's my inexperience with VBA, but as it loops through, it does not return sub-elements. myEndPoints(0) and myEndPoints(1) hold value 0,0,0 through the loop, and after the initial cell is found, it doesn't appear to recognize any additional elements. All my gusset plates get places at 0,0,0 instead of on the ABD lines. I'll include my code one more time just in case something obvious sticks out. Thanks again for all your help!
Option Explicit Function MyMatchSymbology(ByVal myLine As LineElement) As Boolean MyMatchSymbology = False If myLine.Level.Name = "S-PHYS-MEMB" Then MyMatchSymbology = True End If End Function Sub GussetPlates() 'Scan For Horizontal Bracing Dim StartPoint As Point3d Dim Point As Point3d, Point2 As Point3d Dim myLine As LineElement Dim myCounter As Integer Dim myElementEnumerator As ElementEnumerator Dim myScanCriteria As New ElementScanCriteria Dim myElement As Element Dim myGussPL As Level Dim myHB As Level Dim myVB As Level Set myHB = ActiveDesignFile.Levels("S-STL-HB") Set myVB = ActiveDesignFile.Levels("S-STL-VB") Set myGussPL = ActiveDesignFile.Levels("S-STL-PLAT-GUSS") Dim myPoints As Point3d Dim myEndPt As Variant Dim myStartPt As Variant Dim myRange As Range3d myScanCriteria.ExcludeNonGraphical myScanCriteria.ExcludeAllLevels myScanCriteria.IncludeLevel myHB Set myElementEnumerator = ActiveModelReference.Scan(myScanCriteria) myElementEnumerator.Reset While myElementEnumerator.MoveNext Set myElement = myElementEnumerator.Current If myElement.IsCellElement Then Dim myComponents As ElementEnumerator Set myComponents = myElement.AsCellElement.GetSubElements() Do While myComponents.MoveNext If myComponents.Current.IsLineElement Then If MyMatchSymbology(myComponents.Current.AsLineElement) Then With myComponents.Current.AsLineElement Dim myEndPoints(0 To 1) As Point3d myEndPoints(0) = .StartPoint myEndPoints(1) = .EndPoint End With End If End If Loop ActiveSettings.Level = myGussPL CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units StartPoint.X = myEndPoints(0).X StartPoint.Y = myEndPoints(0).Y StartPoint.Z = myEndPoints(0).Z 'Send a data point to the current command Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 CommandState.StartDefaultCommand CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units StartPoint.X = myEndPoints(1).X StartPoint.Y = myEndPoints(1).Y StartPoint.Z = myEndPoints(1).Z 'Send a data point to the current command Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'CommandState.StartDefaultCommand End If Wend End Sub
I think I see what's wrong... "myLine" in the fuction is not tied to anything. I will work on fixing it.
If that doesn't fix it, post a test .dgn file. I don't know anything about AECOsim, but I have some time today and could have a go at it.
Code... We're the good guys now.
Amador Ontiveros said: I think I have my code set up properly, it doesn't return any errors
Divide and conquer! Break your code into smaller procedures. Each procedure has a specific task. This organisation makes subsequent understanding and maintenance much simpler …
Sub GussetPlates() 'Scan For Horizontal Bracing Dim myLine As LineElement Dim myCounter As Integer Dim oElements As ElementEnumerator Dim myScanCriteria As New ElementScanCriteria Dim myElement As Element Dim myGussPL As Level Dim myHB As Level Dim myVB As Level Set myHB = ActiveDesignFile.Levels("S-STL-HB") Set myVB = ActiveDesignFile.Levels("S-STL-VB") Set myGussPL = ActiveDesignFile.Levels("S-STL-PLAT-GUSS") myScanCriteria.ExcludeNonGraphical myScanCriteria.ExcludeAllLevels myScanCriteria.IncludeLevel myHB Set oElements = ActiveModelReference.Scan(myScanCriteria) oElements.Reset While oElements.MoveNext Set myElement = oElements.Current If myElement.IsCellElement Then Dim myComponents As ElementEnumerator Set myComponents = myElement.AsCellElement.GetSubElements() Do While myComponents.MoveNext If myComponents.Current.IsLineElement Then If MyMatchSymbology(myComponents.Current.AsLineElement) Then Dim points (0 To 1) As Point3d ProcessLineElement points myComponents.Current.AsLineElement CreateGusset points End If End If Loop End If Wend End Sub
MyMatchSymbology can do whatever you want to test the element's symbology …
Function MyMatchSymbology(ByVal myLine As LineElement) As Boolean MyMatchSymbology = False If myLine.Level.Name = "S-PHYS-MEMB" Then MyMatchSymbology = True End If End Function
Do whatever you need to do with the component line …
Sub ProcessLineElement (ByRef points() As Point3d, ByVal oLine As LineElement) points(0) = oLine.StartPoint points(1) = oLine.EndPoint End Sub
Use extracted data to create something …
Sub CreateGusset (ByRef points() As Point3d) ActiveSettings.Level = myGussPL CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units Dim StartPoint As Point3d StartPoint.X = points(0).X StartPoint.Y = points(0).Y StartPoint.Z = points(0).Z 'Send a data point to the current command Dim Point As Point3d Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 CommandState.StartDefaultCommand CadInputQueue.SendCommand "PLACE SMARTLINE" 'Coordinates are in master units StartPoint.X = points(1).X StartPoint.Y = points(1).Y StartPoint.Z = points(1).Z 'Send a data point to the current command Point.X = StartPoint.X Point.Y = StartPoint.Y Point.Z = StartPoint.Z CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 4 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 4 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'Send a data point to the current command Point.X = StartPoint.X + 0 Point.Y = StartPoint.Y + 0 Point.Z = StartPoint.Z + 0 CadInputQueue.SendDataPoint Point, 1 'CommandState.StartDefaultCommandEnd Sub