AssocDimDependencyBodyBase.IsReferenceOnly needs to be set True for this. Below is an
example which creates aligned dimensional constraint and sets its Reference property to true.
Public Class MyCommands
'Add an aligned dimensional constraint to a Line.
<CommandMethod("TESTALIGNEDDIM")>
Public Shared Sub testAlignedDimCommand()
Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
Using myT As Transaction = tm.StartTransaction()
' Point entities
Dim bt As BlockTable = DirectCast(myT.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = DirectCast(myT.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)
Dim point3d1 As New Point3d(10, 10, 0)
Dim point3d2 As New Point3d(20, 20, 0)
Dim dimPt As New Point3d(36, 20, 0)
Dim line1 As New Line(point3d1, point3d2)
btr.AppendEntity(line1)
myT.AddNewlyCreatedDBObject(line1, True)
' Aligned Dimension entity
Dim dimAligned As New AlignedDimension(point3d1, point3d2, dimPt, "ALIGNED DIMENSION", db.Dimstyle)
btr.AppendEntity(dimAligned)
myT.AddNewlyCreatedDBObject(dimAligned, True)
Dim idConstrGroup As ObjectId = ObjectId.Null
'To query the subentities of the line, we create and use a protocol extension (PE) provided by the associativity API
Dim subentityIdPE As AssocPersSubentityIdPE
Dim peCls As RXClass = AssocPersSubentityIdPE.GetClass(GetType(AssocPersSubentityIdPE))
Dim pSubentityIdPE As IntPtr = line1.QueryX(peCls)
If pSubentityIdPE = IntPtr.Zero Then
System.Windows.MessageBox.Show("cannot get pSubentityIdPE")
Return
End If
subentityIdPE = TryCast(AssocPersSubentityIdPE.Create(pSubentityIdPE, False), AssocPersSubentityIdPE)
If subentityIdPE Is Nothing Then
System.Windows.MessageBox.Show("cannot get subentityIdPE")
Return
End If
'Now we have the PE, we query the subentities
Dim edgeSubentityIds As SubentityId() = Nothing
'First we retrieve a list of all edges (a line has one edge)
edgeSubentityIds = subentityIdPE.GetAllSubentities(line1, SubentityType.Edge)
Dim startSID As SubentityId = SubentityId.Null, endSID As SubentityId = SubentityId.Null
Dim other As SubentityId() = Nothing
'Now we retrieve the vertices associated with that edge.
subentityIdPE.GetEdgeVertexSubentities(line1, edgeSubentityIds(0), startSID, endSID, other)
'The PE returns a SubEntId. We want a Full SubentityPath
Dim subentPathEdge As New FullSubentityPath(New ObjectId(0) {line1.ObjectId}, edgeSubentityIds(0))
Dim subentPath1 As New FullSubentityPath(New ObjectId(0) {line1.ObjectId}, startSID)
Dim subentPath2 As New FullSubentityPath(New ObjectId(0) {line1.ObjectId}, endSID)
'add dimconstraint to the entities
'create value dependency
Dim varId As ObjectId, valDepId As ObjectId
varId = AddOrModifyVariable("Aligned", "10.0")
Using valDep As New AssocValueDependency()
valDepId = db.AddDBObject(valDep)
Dim compoundId As New CompoundObjectId(varId, db)
valDep.AttachToObject(compoundId)
End Using
'create dim dependency
Dim dimDepId As ObjectId = ObjectId.Null
Dim dimDepBodyId As ObjectId = ObjectId.Null
AssocDimDependencyBody.CreateAndPostToDatabase(dimAligned.ObjectId, dimDepId, dimDepBodyId)
Dim bPreviousValue As Boolean = AssocDimDependencyBodyBase.SetEraseDimensionIfDependencyIsErased(False)
Dim consGrpId As ObjectId = GetConstraintGroup(True)
Dim consGeom0 As ConstrainedGeometry = Nothing
Dim consLine As ConstrainedLine = Nothing
Using constGrp As Assoc2dConstraintGroup = DirectCast(myT.GetObject(consGrpId, OpenMode.ForWrite, False), Assoc2dConstraintGroup)
consGeom0 = constGrp.AddConstrainedGeometry(subentPathEdge)
'Sometimes you have to access implicit constrained geometry.
'In this case, we're constraining the lines by its endpoints, so we have to query the constrained line edge for its ConstrainedImplicitPoints.
'If we try to pass the line's end point subentity directly via a call to AddConstrainedGeometry, we'll get an error.
consLine = DirectCast(consGeom0, ConstrainedLine)
Dim consPts As ConstrainedImplicitPoint() = consLine.ConstrainedImplicitPoints
Dim consStartPt As ConstrainedGeometry = Nothing
Dim consEndPt As ConstrainedGeometry = Nothing
'We don't know which is start or end point, so we test. (And we could have a midpoint in there too).
For Each pt As ConstrainedImplicitPoint In consPts
If pt.PointType = ImplicitPointType.StartImplicit Then
consStartPt = pt
End If
If pt.PointType = ImplicitPointType.EndImplicit Then
consEndPt = pt
End If
Next
'If something went wrong ...
If (consStartPt Is Nothing) OrElse (consEndPt Is Nothing) Then
Return
End If
'Now we add our constraint
constGrp.AddDistanceConstraint(consStartPt, consEndPt, DistanceConstraint.DistanceDirectionType.NotDirected, valDepId, dimDepId, New Vector3d(1, 0, 0),
Nothing)
AssocDimDependencyBodyBase.SetEraseDimensionIfDependencyIsErased(bPreviousValue)
Using assocDimBody As AssocDimDependencyBody = myT.GetObject(dimDepBodyId, OpenMode.ForWrite, False)
assocDimBody.IsReferenceOnly = True
End Using
End Using
myT.Commit()
End Using
End Sub
' Helper function to return FullSubEntPath for subent of provided entity
Private Shared Function GetFullSubentityPath(ByVal entity As Entity, ByVal subentityType As SubentityType) As FullSubentityPath
If entity Is Nothing Then
System.Windows.MessageBox.Show("cannot get entity")
Return New FullSubentityPath()
End If
Dim subentityIdPE As AssocPersSubentityIdPE
Dim peCls As RXClass = AssocPersSubentityIdPE.GetClass(GetType(AssocPersSubentityIdPE))
Dim pSubentityIdPE As IntPtr = entity.QueryX(peCls)
If pSubentityIdPE = IntPtr.Zero Then
System.Windows.MessageBox.Show("cannot get pSubentityIdPE")
Return New FullSubentityPath()
End If
subentityIdPE = TryCast(AssocPersSubentityIdPE.Create(pSubentityIdPE, False), AssocPersSubentityIdPE)
If subentityIdPE Is Nothing Then
System.Windows.MessageBox.Show("cannot get subentityIdPE")
Return New FullSubentityPath()
End If
Dim edgeSubentityIds As SubentityId() = Nothing
edgeSubentityIds = subentityIdPE.GetAllSubentities(entity, subentityType)
Return New FullSubentityPath(New ObjectId(0) {entity.ObjectId}, edgeSubentityIds(0))
End Function
' Helper function to retrieve (or create) constraint group
Private Shared Function GetConstraintGroup(ByVal createIfDoesNotExist As Boolean) As ObjectId
' Calculate the current plane on which new entities are added by the editor
' (A combination of UCS and ELEVATION sysvar).
Dim ed As Autodesk.AutoCAD.EditorInput.Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim ucsMatrix As Matrix3d = ed.CurrentUserCoordinateSystem
Dim origin As Point3d = ucsMatrix.CoordinateSystem3d.Origin
Dim xAxis As Vector3d = ucsMatrix.CoordinateSystem3d.Xaxis
Dim yAxis As Vector3d = ucsMatrix.CoordinateSystem3d.Yaxis
Dim zAxis As Vector3d = ucsMatrix.CoordinateSystem3d.Zaxis
origin = origin + CDbl(Application.GetSystemVariable("ELEVATION")) * zAxis
Dim currentPlane As New Plane(origin, xAxis, yAxis)
' get the constraint group from block table record
Dim idConstrGroup As ObjectId = ObjectId.Null
Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim networkId As ObjectId = AssocNetwork.GetInstanceFromObject(SymbolUtilityServices.GetBlockModelSpaceId(db), createIfDoesNotExist, True, "")
If networkId.IsNull Then
System.Windows.MessageBox.Show("network id is null")
Return idConstrGroup
End If
' Try to find the constraint group in the associative network
Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
Using myT As Transaction = tm.StartTransaction()
Using network As AssocNetwork = DirectCast(myT.GetObject(networkId, OpenMode.ForRead, False), AssocNetwork)
If network Is Nothing Then
Return idConstrGroup
End If
' Iterate all actions in network to find Assoc2dConstraintGroups
Dim actionsInNetwork As ObjectIdCollection = network.GetActions
For nCount As Integer = 0 To actionsInNetwork.Count - 1
Dim idAction As ObjectId = actionsInNetwork(nCount)
If idAction = ObjectId.Null Then
Continue For
End If
' Is this action a type of Assoc2dConstraintGroup?
If idAction.ObjectClass.IsDerivedFrom(RXObject.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Assoc2dConstraintGroup))) Then
Using action As AssocAction = DirectCast(myT.GetObject(idAction, OpenMode.ForRead, False), AssocAction)
If action Is Nothing Then
Continue For
End If
Dim constGrp As Assoc2dConstraintGroup = DirectCast(action, Assoc2dConstraintGroup)
' Is this the Assoc2dConstraintGroup for our plane of interest?
If constGrp.WorkPlane.IsCoplanarTo(currentPlane) Then
' If it is then we've found an existing constraint group we can use.
Return idAction
End If
End Using
End If
Next
End Using
' If we get to here, a suitable contraint group doesn't exist, create a new one if that's what calling fn wanted.
If idConstrGroup.IsNull AndAlso createIfDoesNotExist Then
Using network As AssocNetwork = DirectCast(myT.GetObject(networkId, OpenMode.ForWrite, False), AssocNetwork)
' Create construction plane
Dim constraintPlane As New Plane(currentPlane)
' If model extent is far far away from origin then we need to shift
' construction plane origin within the model extent.
' (Use Pextmin, PExtmax in paper space)
Dim extmin As Point3d = db.Extmin
Dim extmax As Point3d = db.Extmax
If extmin.GetAsVector().Length > 100000000.0 Then
Dim originL As Point3d = extmin + (extmax - extmin) / 2.0
Dim result As PointOnSurface = currentPlane.GetClosestPointTo(originL)
constraintPlane.[Set](result.GetPoint(), currentPlane.Normal)
End If
' Create the new constraint group and add it to the associative network.
Using constGrp As New Assoc2dConstraintGroup(constraintPlane)
idConstrGroup = db.AddDBObject(constGrp)
End Using
network.AddAction(idConstrGroup, True)
End Using
End If
myT.Commit()
End Using
Return idConstrGroup
End Function
' Helper function to add a new variable to the associative network or modify expression of the existing one
Private Shared Function AddOrModifyVariable(ByVal varName As String, ByVal varExpression As String) As ObjectId
Dim varId As ObjectId = ObjectId.Null
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Using myT As Transaction = db.TransactionManager.StartTransaction()
' Open the AssocNetwork
Dim networkId As ObjectId = AssocNetwork.GetInstanceFromObject(SymbolUtilityServices.GetBlockModelSpaceId(db), True, True, "")
Dim network As AssocNetwork = DirectCast(myT.GetObject(networkId, OpenMode.ForWrite), AssocNetwork)
Dim var As AssocVariable = Nothing
' Iterate through all actions in the network
Dim actionIds As ObjectIdCollection = network.GetActions
For Each actionId As ObjectId In network.GetActions
' Is this action an AssocVariable?
If actionId.ObjectClass.IsDerivedFrom(RXObject.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.AssocVariable))) Then
' If so, we check if it has the name we're looking for.
var = DirectCast(myT.GetObject(actionId, OpenMode.ForWrite), AssocVariable)
If var IsNot Nothing Then
' If name matches, then we exit loop and set its expression
If var.Name = varName Then
Exit For
Else
var = Nothing
End If
End If
End If
Next
' If variable with correct name wasn't found, we create it.
If var Is Nothing Then
var = New AssocVariable()
varId = network.Database.AddDBObject(var)
network.AddAction(varId, True)
myT.AddNewlyCreatedDBObject(var, True)
var.SetName(varName, True)
End If
' Finally we set its expression to the new value.
Dim errMsg As String = ""
var.SetExpression(varExpression, "", True, True, errMsg, False)
Dim rb As New ResultBuffer()
errMsg = var.EvaluateExpression(rb)
var.Value = rb
myT.Commit()
End Using
Return varId
End Function
' Helper function to handle exceptions being thrown if you try to add the same constrained geometry twice.
' You could work out what constrained geometry to add up front. That would be more efficient as no exceptions would be thrown,
' but isn't always possible (e.g. if running a command multiple times to constrain existing geometry in a drawing.
' (This helper function isn't used by any functions in this sample project).
Private Shared Function AddConstrainedGeometry(ByVal constGrp As Assoc2dConstraintGroup, ByVal path As FullSubentityPath) As ConstrainedGeometry
Dim consGeom As ConstrainedGeometry = Nothing
Try
consGeom = constGrp.AddConstrainedGeometry(path)
Catch ex As Autodesk.AutoCAD.Runtime.Exception
' This error isn't really an an error
If ex.ErrorStatus <> ErrorStatus.AlreadyInGroup Then
Throw ex
End If
' If we get to here, then 'path' was already in the group so we can retrieve it.
consGeom = constGrp.GetConstrainedGeometry(path, False)
End Try
Return consGeom
End Function
End Class