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

Hey all long time no see!

This is some generic code that was on the net, if I wanted to place a circle at a line selected how would I do that; see comment in code at entLine: My idea was to place a circle at the selected lines mid point with a .25" rad

Thanks for any help with this.


[VBA]
Sub GetLengths()
Dim SOS As AcadSelectionSet
Dim objSS As AcadSelectionSet
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim objEnt As AcadEntity
Dim entLine As AcadLine
Dim entPoly As AcadPolyline
Dim entLWPoly As AcadLWPolyline
For Each SOS In ThisDrawing.SelectionSets
If SOS.Name = "MySS" Then
ThisDrawing.SelectionSets("MySS").Delete
Exit For
End If
Next
intCode(0) = 0: varData(0) = "LINE,POLYLINE,LWPOLYLINE"
ThisDrawing.SelectionSets.Add ("MySS")
Set objSS = ThisDrawing.SelectionSets("MySS")
objSS.SelectOnScreen intCode, varData


If objSS.Count < 1 Then
MsgBox "No lines and polylines selected!"
Exit Sub
End If

For Each objEnt In objSS
Select Case objEnt.ObjectName
Case "AcDbLine"
Set entLine = objEnt

'** Place circle around this line **

MsgBox "Line is " & entLine.Length & " units long."
Case "AcDb2dPolyline"
Set entPoly = objEnt
MsgBox "Polyline is " & entPoly.Length & " units long."
Case "AcDbPolyline"
Set entLWPoly = objEnt
MsgBox "LightWeight Polyline is " & entLWPoly.Length & " units long."
End Select
Next

End Sub
[/VBA]

I didn't check if the numbers were < 0, but this will work as long as both numbers are positive. After all we need to keep a positive attitude. :)
[VBA]
Sub GetLengths()
Dim SOS As AcadSelectionSet
Dim objSS As AcadSelectionSet
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim objEnt As AcadEntity
Dim entLine As AcadLine
Dim entPoly As AcadPolyline
Dim entLWPoly As AcadLWPolyline
Dim Pts As Variant, Pt(2) As Double
For Each SOS In ThisDrawing.SelectionSets
If SOS.Name = "MySS" Then
ThisDrawing.SelectionSets("MySS").Delete
Exit For
End If
Next
intCode(0) = 0: varData(0) = "LINE,POLYLINE,LWPOLYLINE"
ThisDrawing.SelectionSets.Add ("MySS")
Set objSS = ThisDrawing.SelectionSets("MySS")
objSS.SelectOnScreen intCode, varData


If objSS.Count < 1 Then
MsgBox "No lines and polylines selected!"
Exit Sub
End If

For Each objEnt In objSS
Select Case objEnt.ObjectName
Case "AcDbLine"
Set entLine = objEnt

'** Place circle around this line **

MsgBox "Line is " & entLine.Length & " units long."
Pts = GetMidPt(entLine)
Pt(0) = Pts(0)
Pt(1) = Pts(1)
Pt(2) = Pts(2)
ThisDrawing.ModelSpace.AddCircle Pt, 0.25
Case "AcDb2dPolyline"
Set entPoly = objEnt
MsgBox "Polyline is " & entPoly.Length & " units long."
Case "AcDbPolyline"
Set entLWPoly = objEnt
MsgBox "LightWeight Polyline is " & entLWPoly.Length & " units long."
End Select
Next

End Sub
Function GetMidPt(iLen As AcadLine) As Variant
Dim mMid(2) As Double, St As Variant, En As Variant
En = iLen.endPoint
St = iLen.startPoint
mMid(0) = St(0) + ((En(0) - St(0)) / 2)
mMid(1) = St(1) + ((En(1) - St(1)) / 2)
mMid(2) = St(2) + ((En(2) - St(2)) / 2)
GetMidPt = mMid
End Function

[/VBA]

Thanks Tommy!

I placed my part on the neg. side of the ucs and on the pos. side and it work in both cases.

Have you done any .Net stuff yet in AutoCAD?


Rob

No not yet, but I am writing a version 12 and 2007 dxf file, and acad thinks it did it. :)

I have downloaded a object map for accessing acad and the drawing in .NET. I got to getting acad up and that was as far as I got. I haven't quite got the time to learn as much .NET yet. I need to see if I can develope arx apps for acadlt, I don't think I can but I am hoping.

And you?

Yes, I did my first VB.Net "tutorial" the other day. For a stable platform you need Autocad 2008 but I think in 2006 .net was supported. You need the command "netload" then you grab a your code project that is a .dll file. I use VS 2005 or 2008 and start with a library project. I only have Acad 2000 at home right now :(

Here is a good place to start:
http://download.autodesk.com/media/a...T_Programming/


Just wondering, why did you use the variant type? I am not good programming in CAD, but I have to get better at it some how.

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.

Quote:

---

Originally Posted by Tommy

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

Code:

---

#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'~

hmmm I see you have been learning a new language there Fixo! Good job!

Quote:

---

Originally Posted by Tommy

hmmm I see you have been learning a new language there Fixo! Good job!

---

Thanks,
But it's just very basic
For your interest take a look at this nice bloq
http://through-the-interface.typepad.com/
I was learning from Kean Walmsley too

~'J'~

Well that just got bookmarked. :)

Quote:

---

Originally Posted by fixo

Thanks,
But it's just very basic
For your interest take a look at this nice bloq
http://through-the-interface.typepad.com/
I was learning from Kean Walmsley too

~'J'~

---

Hey Fixo,

Cool glad to see some VB.net code! What version of acad will that run in? I just saw your post and I am going to try and run it. I am now running acad 2009 and VS 2008

I need a VB.net command to do a simple ZoomAll but for some reason all my google search's come up empty. Do you have any code to do that off hand?

It worked for me, and I added a condition to check for any under sized lines. I work with some old CNC machines and parts will bomb if you have small line segments. So this can be used to check parts first.

Thanks,
Rob

Code:

---


    'check for under sized lines
    If acLine.Length < 0.125 Then

          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)

      End If

---

Quote:

---

Originally Posted by Zrob

Hey Fixo,

Cool glad to see some VB.net code! What version of acad will that run in? I just saw your post and I am going to try and run it. I am now running acad 2009 and VS 2008

I need a VB.net command to do a simple ZoomAll but for some reason all my google search's come up empty. Do you have any code to do that off hand?

---

Hi, Zrob

Take a look at AutoCAD.NET Developer's guide:

http://docs.autodesk.com/ACD/2010/ENU/AutoCAD%20.NET%20Developer's%20Guide/index.html


There are a lot of code either on C# and VB.NET
Enjoy!

~'J'~

Quote:

---

Originally Posted by fixo

Hi, Zrob

Take a look at AutoCAD.NET Developer's guide:

http://docs.autodesk.com/ACD/2010/ENU/AutoCAD%20.NET%20Developer's%20Guide/index.html


There are a lot of code either on C# and VB.NET
Enjoy!

~'J'~

---

One problem with that is some functions/API's don't work on the version I am using at work acad 2008. I was searching the web like a mad man tying to find a developers guide for the older version I am working with now, but with no luck.

But yeah, thats a big help none the less!

Thanks.