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