Microstation Vba Seçili elementleri cell oluşturma

Option Explicit

Function xy(x As Double, y As Double) As Point3d
    xy = Point3dFromXY(x, y)
End Function

Sub CreateOrphanCell()
    Dim eleCell As CellElement
    Dim vertices(0 To 3) As Point3d
    Dim ele(0 To 2) As Element
   
    Set ele(0) = CreateLineElement2(Nothing, xy(0, 5), xy(10, 5))
   
    vertices(0) = xy(0, 0)
    vertices(1) = xy(0, 7)
    vertices(2) = xy(10, 7)
    vertices(3) = xy(10, 0)
    Set ele(1) = CreateShapeElement1(Nothing, vertices, msdFillModeUseActive)
   
    Set ele(2) = CreateTextElement1(Nothing, "My Orphan Cell", xy(5, 6), Matrix3dIdentity)
   
    Set eleCell = CreateCellElement1(vbNullString, ele, xy(0, 0), False)
    eleCell.name = "OrphanCell"
    ActiveModelReference.AddElement eleCell
       
    eleCell.Redraw
End Sub

Sub secilileriCellYap()
  Dim ele() As Element
  Dim gElement As Element
  Dim eleCell As CellElement
  Dim oScanCriteria As ElementScanCriteria
  Dim oScanEnumerator As ElementEnumerator
  Dim eSay As Integer
  Dim aTags() As TagElement
  Dim tagIndex As Long
  If ActiveModelReference.AnyElementsSelected Then
     Set oScanEnumerator = ActiveModelReference.GetSelectedElements
  Else
     Dim sFence As Fence
     Set sFence = ActiveDesignFile.Fence
     If sFence.IsDefined Then Set oScanEnumerator = sFence.GetContents
  End If
  '     Set tElement = gElement.AsTextElement
  '     ActiveModelReference.AddElement tElement
  eSay = -1
  Do While oScanEnumerator.MoveNext
     Set gElement = oScanEnumerator.Current
     If gElement.IsGraphical Then
        eSay = eSay + 1
        ReDim Preserve ele(eSay)
        Set ele(eSay) = gElement
        aTags = gElement.GetTags
        For tagIndex = LBound(aTags) To UBound(aTags)
           Dim sourceTag As TagElement
           eSay = eSay + 1
           ReDim Preserve ele(eSay)
           Set sourceTag = aTags(tagIndex)
           Set ele(eSay) = sourceTag
           'ActiveDesignFile.Models(att).CopyElement sourceTag, oCC
        Next tagIndex
     End If
'     ActiveModelReference.RemoveElement gElement
   
  Loop
  Set eleCell = CreateCellElement1(vbNullString, ele, xy(0, 0), False)
  eleCell.name = "OrphanCell"
  ActiveModelReference.AddElement eleCell

End Sub