I have a VBA macro the reads each attachment, copies the graphical elements into an array, and writes the array of elements into the active model as a cell. (See code.) I now need to go a step further and address any elements that are clipped from the attachment. As currently written, the macro copies every graphical element, visible and clipped. Is it possible to exclude the clipped elements? In essence I am looking for a way to mimic "merge into master" but keep the attachment elements grouped.
Option Explicit Option Base 1 Sub MergeReferences() Dim nAttachments As Integer nAttachments = ActiveModelReference.Attachments.Count Dim i As Integer For i = nAttachments To 1 Step -1 If LCase(ActiveModelReference.Attachments.Item(i).AttachName) <> "sig.dgn" Then If ActiveModelReference.Attachments.Item(i).DisplayFlag = True Then Dim NewCellName As String If ActiveModelReference.Attachments.Item(i).LogicalName <> "" Then NewCellName = ActiveModelReference.Attachments.Item(i).LogicalName Else NewCellName = ActiveModelReference.Attachments.Item(i).AttachName End If Dim sc As New ElementScanCriteria sc.ExcludeNonGraphical Dim cc As New CopyContext cc.LevelHandling = msdCopyContextLevelCopyIfNotFound Dim ee As ElementEnumerator Set ee = ActiveModelReference.Attachments.Item(i).Scan(sc) Dim eleArray() As Element Dim m As Integer m = 0 While ee.MoveNext If ee.Current.Type = msdElementTypeText Then If ee.Current.AsTextElement.Text = "$DOCSET_CURRENTSETDOC$" Then ActiveModelReference.CopyElement ee.Current, cc ElseIf ee.Current.AsTextElement.Text = "$DOCSET_NUMSETDOCS$" Then ActiveModelReference.CopyElement ee.Current, cc ElseIf ee.Current.AsTextElement.Text = "INSERT$CO" Then ActiveModelReference.CopyElement ee.Current, cc Else m = m + 1 ReDim Preserve eleArray(m) Set eleArray(m) = ee.Current.Clone End If Else m = m + 1 ReDim Preserve eleArray(m) Set eleArray(m) = ee.Current.Clone End If Wend Dim eleCell As CellElement Set eleCell = CreateCellElement1(NewCellName, eleArray, Point3dFromXY(0, 0)) ActiveModelReference.AddElement eleCell ActiveModelReference.Attachments.Remove i End If End If Next i ActiveDesignFile.Views.Item(1).DisplaysTags = True End Sub