Here is a quick example of how I've done it.
There are numerous other examples found by searching this group.
This also attaches some XData to the line.
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Public Class Class1
Dim llength As String
<CommandMethod("LineLengths")> _
Public Sub LineLengths()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Try
Dim filterfor() As TypedValue = {New TypedValue(0, "LINE")}
Dim sf As SelectionFilter = New SelectionFilter(filterfor)
Dim psr As PromptSelectionResult = ed.SelectAll(sf)
If psr.Status <> PromptStatus.OK Then
ed.WriteMessage("Can not find any lines in the drawing.")
Else
Dim ss As Autodesk.AutoCAD.EditorInput.SelectionSet = psr.Value
Dim idArray() As ObjectId
idArray = ss.GetObjectIds()
Dim objId As ObjectId
For Each objId In idArray
Dim l As Line = CType(t.GetObject(objId, OpenMode.ForRead), Line)
Dim p0 As Point3d = l.StartPoint
Dim p1 As Point3d = l.EndPoint
Dim dx As Double = p1.X - p0.X
Dim dy As Double = p1.Y - p0.Y
Dim len As Double = Math.Sqrt((dx * dx) + (dy * dy))
llength = len.ToString
Call TheXdata("Add", objId, llength)
'Call TheXdata("Delete", objId, llength)
Next
End If
t.Commit()
Catch ex As Exception
Finally
t.Dispose()
End Try
End Sub
Public Shared Sub TheXdata(ByVal Which As String, ByVal objId As ObjectId, ByVal theLength As String)
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim myT As Transaction = db.TransactionManager.StartTransaction()
Dim AppName As String = "Line Length XData"
Dim thescale = db.Dimscale
If Which = "Delete" Then
Try
Dim buf As ResultBuffer = New ResultBuffer
buf.Add(New TypedValue(1001, AppName))
Dim tmpEnt As Entity = CType(myT.GetObject(objId, OpenMode.ForWrite), Entity)
If Not tmpEnt Is Nothing Then
tmpEnt.XData = buf
End If
myT.Commit()
Catch ex As Exception
Finally
myT.Dispose()
End Try
Else
Try
Dim linEnt As Entity = CType(myT.GetObject(objId, OpenMode.ForWrite), Entity)
If linEnt.GetType.Name.ToString() = "Line" Then
Dim XdTbl As RegAppTable = CType(myT.GetObject(db.RegAppTableId, OpenMode.ForWrite), RegAppTable)
If Not XdTbl.Has(AppName) Then
Dim xdRec As RegAppTableRecord = New RegAppTableRecord
xdRec.Name = AppName
XdTbl.Add(xdRec)
myT.AddNewlyCreatedDBObject(xdRec, True)
End If
Dim buf As ResultBuffer = New ResultBuffer
buf.Add(New TypedValue(1001, AppName))
buf.Add(New TypedValue(1000, "Your Line Length is " & theLength))
linEnt.XData = buf
End If
myT.Commit()
Catch ex As Exception
Finally
myT.Dispose()
End Try
End If
End Sub
<CommandMethod("LineEdit")> _
Public Shared Sub LineEdit()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Dim var0 As TypedValue
Dim var1 As TypedValue
Dim idArray() As ObjectId = Nothing
Try
Dim res As PromptSelectionResult = ed.GetSelection
If res.Status <> PromptStatus.OK Then
Exit Sub
End If
Dim SS As Autodesk.AutoCAD.EditorInput.SelectionSet = res.Value
idArray = SS.GetObjectIds()
Dim objId As ObjectId
For Each objId In idArray
Dim XDataEnt As Entity = CType(t.GetObject(objId, OpenMode.ForRead), Entity)
If XDataEnt.GetType.Name.ToString() = "Line" Then
Try
Dim lineXdata As Array
lineXdata = XDataEnt.XData.AsArray
var0 = lineXdata.GetValue(0)
Var1 = lineXdata.GetValue(1)
MsgBox(var0.Value.ToString & vbCrLf & var1.Value.ToString)
Catch ex As Exception
MsgBox("Selected entity does not have any xdata attached to it." & vbCrLf & "Try Again!")
Exit Sub
End Try
End If
Next
t.Commit()
Catch ex As Exception
MsgBox(ex.ToString)
Finally
t.Dispose()
End Try
End Sub
End Class
