Can someone please tell me why the following lines in my code are not working? I am simply trying to dimension a line and write text above it.
Sub DimensionLine(obj As AcadObject, distFromObj As Double, dimText As String)
ThisDrawing.SetVariable "DIMTAD", 1 'Not Working
ThisDrawing.SetVariable "DIMJUST", 0 'Not Working
ThisDrawing.SetVariable "DIMGAP", 0.08 'Not Working
If obj.ObjectName = "AcDbLine" Then
Dim dimObj As AcadDimAligned
Dim dimPnt1 As Variant
Dim dimPnt2 As Variant
Dim location(0 To 2) As Double
dimPnt1 = obj.StartPoint
dimPnt2 = obj.EndPoint
location(0) = dimPnt1(0) + distFromObj
location(1) = dimPnt1(1) + distFromObj
Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(dimPnt1, dimPnt2, location)
dimObj.TextInsideAlign = False
dimObj.Color = 252
dimObj.TextColor = acYellow
dimObj.AltSuppressTrailingZeros = True 'Not Working
dimObj.Update
Dim mTextObj As AcadMText
Dim width As Double
Dim txtInsPnt(0 To 2) As Double
txtInsPnt(0) = (dimObj.ExtLine1Point(0) + dimObj.ExtLine2Point(0)) / 2
txtInsPnt(1) = (dimObj.ExtLine1Point(1) + dimObj.ExtLine2Point(1)) / 2
txtInsPnt(2) = 0
width = 1
' Creates the mtext Object
Set mTextObj = ThisDrawing.ModelSpace.AddMText(txtInsPnt, width, dimText)
mTextObj.AttachmentPoint = acAttachmentPointTopCenter 'Not Working
mTextObj.Color = acYellow
ZoomAll
Else
MsgBox " Wrong object passed to DimensionLine. Object passed is " & obj.ObjectName
End If
End Sub