How to get center points of existing circles.

[Anonymous]

I have many tiny circles in a layer "Sources". I just want to store x and y coordinates of all circles present in "Sources"
I will appreciate your help.

Thanks
Mniaz

[Anonymous]

1- Make a selection set of all circles on the Sources layer
2- Step thrugh the selection set collecting the X and Y and store them on an array

Public Sub GetCircles()
Dim SSet As AcadSelectionSet
Dim Fil(0 To 1) As Integer
Dim Data(0 To 1) As Variant
Dim Obj As AcadCircle
Dim Arr() As Variant
Dim I As Integer

Fil(0) = 0
Fil(1) = 8

Data(0) = "CIRCLE"
Data(1) = "SOURCE"

Set SSet = ThisDrawing.SelectionSets.Add("$CIRCLES")
SSet.Select acSelectionSetAll, , , Fil, Data

ReDim Arr(0 To SSet.Count - 1, 1)
For I = 0 To SSet.Count - 1
Set Obj = SSet.Item(I)
Arr(I, 0) = Obj.Center(0)
Arr(I, 1) = Obj.Center(1)
Next I
ThisDrawing.SelectionSets.Item("$CIRCLES").Delete
End Sub

[Anonymous]

Hi,
Can you tell me how to modify the code provided so that I may extract x,y and z values, plus the circles diameter value?
Please let me know if this is possible.

[Anonymous]

Read the developer help file in ACAD!!!!!!!!!!!!!!!!!!!!!!! Help, develper help. From the top menu.
This is an excellent source of information. This is why ACAD is so much more than ACAD LT. Take a look, it will help you quite a bit.


Sub Example_Diameter()
' This example creates a Circle object in model space and
' returns the diameter of the new Circle

Dim circleObj As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius As Double

' Define the new Circle object
centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
radius = 5#

' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)

ThisDrawing.Application.ZoomAll

MsgBox "The diameter of the new Circle is: " & circleObj.Diameter
End Sub


Sub Example_Center()

Dim circObj As AcadCircle
Dim currCenterPt(0 To 2) As Double
Dim newCenterPt(0 To 2) As Double
Dim radius As Double

' Define the initial center point and radius for the circle
currCenterPt(0) = 20: currCenterPt(1) = 30: currCenterPt(2) = 0
radius = 3

' Create the circle in modelspace
Set circObj = ThisDrawing.ModelSpace.AddCircle(currCenterPt, radius)
ZoomAll
MsgBox "The center point of the circle is " & currCenterPt(0) & ", " & currCenterPt(1) & ", " & currCenterPt(2), vbInformation, "Center Example"

' Change the center point of the circle
newCenterPt(0) = 25: newCenterPt(1) = 25: newCenterPt(2) = 0
circObj.center = newCenterPt
circObj.Update

' Query the results of the new center position
' Notice the output from the center property is a variant
Dim centerPoint As Variant
centerPoint = circObj.center
MsgBox "The center point of the circle is " & centerPoint(0) & ", " & centerPoint(1) & ", " & centerPoint(2), vbInformation, "Center Example"
End Sub

[Anonymous]

Hi Dave,
Sorry this is my first day looking at VBA in Civil 3D [I`m more familiar with VB Express] and only have a 30 day trial so trying to make the most of it. Again my apologies for not examining the Developer Help file first, but again I am still finding my way around ;o)
My aim is to send to a file or a text box the Easting, Northing, Level and diameter of all the circles on a given layer called Boreholes.
If you can provide any further guidance I would much appreciate it.
Best Regards,
Jason

[Anonymous]

Code so far...
'GetCircles
Public Sub GetCircles()

Dim SSet As AcadSelectionSet
Dim Fil(0 To 4) As Integer
Dim Data(0 To 1) As Variant
Dim Obj As AcadCircle
Dim Arr() As Variant
Dim I As Integer

Fil(0) = 0
Fil(1) = 8
Fil(2) = 0
Fil(3) = 2
Data(0) = "CIRCLE"
Data(1) = "Boreholes"

Set SSet = ThisDrawing.SelectionSets.Add("$CIRCLES")
SSet.Select acSelectionSetAll, , , Fil, Data

ReDim Arr(0 To SSet.Count - 1, 1)
For I = 0 To SSet.Count - 1
Set Obj = SSet.Item(I)
Arr(I, 0) = Obj.Center(0)
Arr(I, 1) = Obj.Center(1)
Arr(I, 2) = Obj.Center(2)
Arr(I, 3) = Obj.Diameter(3)
Next I

'Send array data to textbox
txtB1.Text = Arr(I, 2)
'Clears the Selection Set called Circles
ThisDrawing.SelectionSets.Item("$CIRCLES").Delete
End Sub