AnsweredAssumed Answered

TRANSLATE CODE FROM VB TO VBA

Question asked by Korbi Anis on Jun 5, 2017

I have a code that I translated from C# to VB. I Have not an experience with VB CODE.and I would like to translate my code from VB to VBA;. someone can help me plzzzzz. I need the code to do my homowork plz.thanks

 

 

CODE :

Imports System.Collections.Generic

Imports System.Text

Imports Autodesk.Revit.Attributes

Imports Autodesk.Revit.DB

Imports Autodesk.Revit.UI

 

 

Namespace Revit.SDK.Samples.HelloRevit.CS

 

 

<Transaction(TransactionMode.Manual)> _

Public Class Command

Implements IExternalCommand

Public Function Execute(commandData As ExternalCommandData, ByRef message As String, elements As ElementSet) As Result

Dim uiDoc As UIDocument = commandData.Application.ActiveUIDocument

 

 

Using trans As New Transaction(uiDoc.Document, "Point")

trans.Start()

' Ensure you select a DividedSurface Element from the model

For Each ele As Element In uiDoc.Selection.Elements

Dim surface As DividedSurface = TryCast(ele, DividedSurface)

If surface IsNot Nothing Then

Dim opts As Options = uiDoc.Document.Application.Create.NewGeometryOptions()

Dim geoEle As GeometryElement = surface.get_Geometry(opts)

Dim geoElems As IEnumerator(Of GeometryObject) = geoEle.GetEnumerator()

While geoElems.MoveNext()

Dim geoObj As GeometryObject = TryCast(geoElems.Current, GeometryObject)

 

 

Dim line As Line = TryCast(geoObj, Line)

If line IsNot Nothing Then

Dim geoNestedElems As IEnumerator(Of GeometryObject) = geoEle.GetEnumerator()

While geoNestedElems.MoveNext()

Dim geoObjNested As GeometryObject = TryCast(geoNestedElems.Current, GeometryObject)

Dim nestedLine As Line = TryCast(geoObjNested, Line)

If nestedLine IsNot Nothing Then

' Ensure that this line is not the same as

' main line

If Not nestedLine.Equals(line) Then

' Create container for the

' intersection results array

Dim resArray As New IntersectionResultArray()' Get the intersection result array using Intersect()

line.Intersect(nestedLine, resArray)

If resArray IsNot Nothing Then

For Each res As IntersectionResult In resArray' Create a new reference point' for each intersection point

Dim rp As ReferencePoint = uiDoc.Document.FamilyCreate.NewReferencePoint(res.XYZPoint)

NextEnd IfEnd If

End If

End WhileEnd If

End While

End If

Next

trans.Commit()

End Using

Return Result.Succeeded

End Function

End Class

End Namespace

'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------'

This code give fot all user the opportunity to cretate a reference points of lines intersections. its too useful !!! you can see the results given with C# code in the picture enclosed.Capture.JPG

Outcomes