Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Public Class Class1
<CommandMethod("ReplaceItems")> _
Public Sub ReplaceItems()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim peo1 As New PromptEntityOptions(vbLf & "Select an Associative Array: ")
Dim per1 As PromptEntityResult = ed.GetEntity(peo1)
If per1.Status <> PromptStatus.OK Then
Return
End If
If Not AssocArray.IsAssociativeArray(per1.ObjectId) Then
ed.WriteMessage(vbLf & "Not an Associative Array, please try again...")
Return
End If
Dim mypaths As New List(Of FullSubentityPath)
If AcHelper.SelectNestedEntities(vbLf & "Select array items: ", mypaths) <> PromptStatus.OK Then
Return
End If
'MsgBox(mypaths.Length.ToString)
Dim peo2 As New PromptEntityOptions(vbLf & "Select entity for substitution: ")
Dim per2 As PromptEntityResult = ed.GetEntity(peo2)
If per2.Status <> PromptStatus.OK Then
Return
End If
Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select base point: ")
If ppr.Status <> PromptStatus.OK Then
Return
End If
Try
Using Tx As Transaction = db.TransactionManager.StartTransaction()
Dim array As AssocArray = AssocArray.GetAssociativeArray(per1.ObjectId)
Dim ItemLocators As ItemLocator() = AssocArray.getItemLocators(mypaths.ToArray)
Dim substEntities As New ObjectIdCollection()
substEntities.Add(per2.ObjectId)
Dim basePoint As New VertexRef(ppr.Value)
array.ReplaceItems(ItemLocators, substEntities, basePoint)
AssocManager.EvaluateTopLevelNetwork(db, Nothing, 0)
Tx.Commit()
End Using
Catch ex As System.Exception
MsgBox(ex.Message & ex.StackTrace)
End Try
End Sub
Public Class AcHelper
Public Shared Function SelectNestedEntities(ByVal prompt As String, ByRef ids As ObjectIdCollection, ByRef mypaths As List(Of FullSubentityPath)) As PromptStatus
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using Tx As Transaction = db.TransactionManager.StartTransaction()
ids = New ObjectIdCollection()
Dim pathsList As New List(Of FullSubentityPath)()
Dim pneo As New PromptNestedEntityOptions(prompt)
pneo.AllowNone = True
' Loop until cancelled or completed
While True
Dim rs As PromptNestedEntityResult = ed.GetNestedEntity(pneo)
' Return whether the function was cancelled
If rs.Status <> PromptStatus.OK Then
mypaths = pathsList ''.ToArray()
UnhighlightSubEntities(mypaths.ToArray())
Return (If(rs.Status <> PromptStatus.None, rs.Status, PromptStatus.OK))
End If
ids.Add(rs.ObjectId)
Dim path As FullSubentityPath = HighlightSubEntity(rs)
If path <> FullSubentityPath.Null Then
pathsList.Add(path)
End If
End While
End Using
End Function
Public Shared Function SelectNestedEntities(ByVal prompt As String, ByRef mypaths As List(Of FullSubentityPath)) As PromptStatus
Dim ids As New ObjectIdCollection()
Return SelectNestedEntities(prompt, ids, mypaths)
End Function
Private Shared Function HighlightSubEntity(ByVal rs As PromptNestedEntityResult) As FullSubentityPath
' Extract relevant information from the prompt object
Dim selId As ObjectId = rs.ObjectId
Dim objIds As New List(Of ObjectId)(rs.GetContainers())
' Reverse the "containers" list
objIds.Reverse()
' Now append the selected entity
objIds.Add(selId)
' Retrieve the sub-entity path for this entity
Dim subEnt As New SubentityId(SubentityType.Null, System.IntPtr.Zero)
Dim path As New FullSubentityPath(objIds.ToArray(), subEnt)
' Open the outermost container, relying on the open transaction...
Dim ent As Entity = TryCast(objIds(0).GetObject(OpenMode.ForRead), Entity)
' ... and highlight the nested entity
If ent Is Nothing Then
Return FullSubentityPath.Null
End If
ent.Highlight(path, False)
' Return the sub-entity path for later unhighlighting
Return path
End Function
Private Shared Sub UnhighlightSubEntities(ByVal mypaths As FullSubentityPath())
For Each path As FullSubentityPath In mypaths
If path = FullSubentityPath.Null Then
Continue For
End If
Dim ids As ObjectId() = path.GetObjectIds()
Dim ent As Entity = TryCast(ids(0).GetObject(OpenMode.ForRead), Entity)
If ent IsNot Nothing Then
ent.Unhighlight(path, False)
End If
Next
End Sub
End Class
End Class