how to place a circle on a line AutoCAD & VBA w/code

[fixo]

On the GetMidPt function, to be honest it was because it was quickest for me at the time. but on the rest it is normally because acad wants to use them. Sometimes it is doubles so you have to watch it.

Use the watch window, and object browser, both of these can show you what is available and then you can pick help.

On the NET, I believe that is the one I have I'll have to check. But thanks I will go check it out.

Hi Tommy
Try this quick example

#Region "Imports"
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
#End Region
 
<Assembly: CommandClass(GetType(Sample_VBExpress.TestClass))> 
 
Namespace Sample_VBExpress
 
Public Class TestClass
 
<CommandMethod("CircOnLine")> _
Public Shared Sub doit()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Using docklock As DocumentLock = doc.LockDocument()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Try
Dim filList() As TypedValue = {New TypedValue(DxfCode.Start, "LINE")}
Dim filter As SelectionFilter = New SelectionFilter(filList)
Dim pso As PromptSelectionOptions = New PromptSelectionOptions()
pso.MessageForAdding = vbCr & "Select Lines >>"
Dim psr As PromptSelectionResult = ed.GetSelection(pso, filter)
If psr.Status <> PromptStatus.OK Then
ed.WriteMessage(vbCr & "Selection Failed")
Return
End If
Dim selSet As SelectionSet = psr.Value
For Each lineObj As SelectedObject In selSet
Dim acLine As Line = CType(tr.GetObject(lineObj.ObjectId, OpenMode.ForRead), Line)
Dim midp As Point3d = acLine.GetClosestPointTo(acLine.GetPointAtParameter(acLine.EndParam / 2), False)
Dim vec As Vector3d = ed.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis
'set radius to .25
Dim circ As Circle = New Circle(midp, vec, 0.25)
'drop some properties
circ.Layer = "0"
circ.ColorIndex = 1
circ.LineWeight = LineWeight.LineWeight050
btr.AppendEntity(circ)
tr.AddNewlyCreatedDBObject(circ, True)
Next
tr.Commit()
Catch ex As System.Exception
ed.WriteMessage(vbCr & ex.Message & vbCr & ex.StackTrace)
Finally
End Try
End Using
End Using
End Sub
 
End Class
 
End Namespace

~'J'~