Yesterday, I posted a sample code which shows you how to attach a property set to a given object. Here is similar, slightly modified version. Here we attach a property set to a given object type; i.e., door in this case.
' Attach a property set to all door objects
'
<CommandMethod("ACANetScheduleLabs",
"AcaAttachPropertySetToAllDoors",
CommandFlags.Modal)> _
Public Sub AttachPropertySetToAllDoors()
' Top most objects
Dim doc As Document =
Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
' (1) Find all the door objects in the model space
Dim ids As ObjectIdCollection = Utils.findObjects(GetType(Door))
' (2) Find the property set definition with the given name.
Dim dictPropSetDef = New DictionaryPropertySetDefinitions(db)
' Find a property set definition called "ACADoorObjects".
' "ACADoorObjects" is what we defined in Lab1 or
' in the command "AcaCreatePropSetDef" or
' the function CreatePropertySetDefinition() we posted earlier.
' You can use any prop set def name that can work with door
' objects here.
Dim idPropSetDef As ObjectId =
Utils.findStyle(dictPropSetDef, "ACADoorObjects")
If idPropSetDef = Nothing Then Return
' (3) Attach the given property set to the given object.
Try
Using tr As Transaction =
db.TransactionManager.StartTransaction
For Each id As ObjectId In ids
Dim obj As AcObject =
tr.GetObject(id, OpenMode.ForWrite, False, False)
' PropertyDataServices provide a convenient method
' to do the actual work.
PropertyDataServices.AddPropertySet(obj, idPropSetDef)
Next
tr.Commit()
End Using
Catch ex As Exception
ed.WriteMessage(
"error in AttachPropertySetToAllDoors: " +
ex.ToString + vbCrLf)
End Try
ed.WriteMessage(
"The property set was attached successfully." + vbCrLf)
End Sub
Here is the code for Utils.Objects(). Utils.findStyle() is the same as the one posted yesterday:
Public Class Utils
' Helper function: findObjects.
'
' Collect ids of objects of the given type in the model space
' of the current drawings.
Public Shared Function findObjects(ByVal targetType As Type) _
As ObjectIdCollection
Dim doc As Document =
Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Dim ids As New ObjectIdCollection ' Return value. save ids here.
' e.g., RXClass = AcDbDoor <--> Type = Door
Dim targetClass As RXClass = RXClass.GetClass(targetType)
Try
Using tr As Transaction =
db.TransactionManager.StartTransaction
' Get the model space
Dim blkTbl As BlockTable =
CType(tr.GetObject(db.BlockTableId, OpenMode.ForRead),
BlockTable)
Dim ms As BlockTableRecord =
CType(tr.GetObject(blkTbl(BlockTableRecord.ModelSpace),
OpenMode.ForRead), BlockTableRecord)
' Iterate over model space and keep ids of indended type.
For Each id As ObjectId In ms
' Chek print if you want to test it.
' ed.WriteMessage("Name = " + id.ObjectClass.Name + vbCrLf)
If id.ObjectClass.IsDerivedFrom(targetClass) Then
ids.Add(id)
End If
Next
End Using
Catch ex As Exception
ed.WriteMessage("error in findObjects: " +
ex.ToString + vbCrLf)
End Try
Return ids
End Function
End Class