How to get object from AutoCAD

I use VBA to create many objects, but now comes a problem.

Because CAD operater draw some points by hand and random, and if I want to know these coordination, it will take me long time to pick one by one. So I wonder if there's a method to read these exist points and show the coordination directly by VBA?

Hi Robert,:hi:

Welcome to VBAX!

Quote:

---

draw some points by hand and random

---

I don't understand this. If you are keeping track of the entities you create you should be able to pull out the ones the CAD person has created.

As to showing the cordinates of an object? That can be done.

I will not be able to post back until Sunday pm.

I don't understand you exactly too
Do you mean that you have some point
objects?
If so you can use something like this:

Code:

---

Option Explicit
Sub ShowPointCoords()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim acPoint As AcadPoint
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
' build the filter to select points
fcode(0) = 0
fData(0) = "POINT"
dxfcode = fcode
dxfdata = fData
setName = "$Points$"
' make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
  If ThisDrawing.SelectionSets.Item(i).Name = setName Then
      ThisDrawing.SelectionSets.Item(i).Delete
      Exit For
  End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen dxfcode, dxfdata
' process each point
For Each oEnt In oSset
  Set acPoint = oEnt
  Dim dblCoor As Variant
  dblCoor = acPoint.Coordinates
  MsgBox "X = " & Replace(CStr(dblCoor(0)), ",", ".") & vbNewLine & _
  "Y = " & Replace(CStr(dblCoor(1)), ",", ".") & vbNewLine & _
  "Z = " & Replace(CStr(dblCoor(2)), ",", ".")
Next
ThisDrawing.Regen acActiveViewport
End Sub

---

Hope that helps

~'J'~

I desrcibe wrong, I means Circle.
Assume I put some circel on the drawing, and now I want to know these circle's radius and coordinations on Excel file, how could I do?
I try a program, but it have to pick up circel one by one, can't select whole at one time. It takes time and sometimes miss some circles...
And I have to open an Excel file because I want to put these informations on that.(or I don't need that?)

Code:

---

Sub ShowCirclePoint()
Dim MyXL As Object     
Set MyXL = GetObject("D:\My Documents\AutoCAD testing.xls")
Set xlsheet = MyXL.Worksheets("AutoCAD")
xlsheet.cells(1, 1) = "No."
xlsheet.cells(1, 2) = "Easting"
xlsheet.cells(1, 3) = "Northing"
xlsheet.cells(1, 4) = "Elevation"
xlsheet.cells(1, 5) = "Radius"
Dim objAcadEntity As AcadEntity   
Dim centerPoint(0 To 2) As Double
Dim circleObj As AcadCircle
Dim radius As Double
Dim cPoint As Variant
Dim mCir As Double
For mCir = 1 To 65000
    ThisDrawing.Utility.GetEntity objAcadEntity, varPickedPoint, "Please select Circle"
    If TypeOf objAcadEntity Is AcadCircle Then
      Set circleObj = objAcadEntity
      radius = circleObj.radius
      cPoint = circleObj.center
  End If
  xlsheet.cells(mCir + 1, 1) = mCir
  xlsheet.cells(mCir + 1, 2) = cPoint(0)
  xlsheet.cells(mCir + 1, 3) = cPoint(1)
  xlsheet.cells(mCir + 1, 4) = cPoint(2)
  xlsheet.cells(mCir + 1, 5) = radius
Next
End Sub

---

Hi Robert
In this case try another routine
Attn: Both Acad and Excel must be open,
just minimize an Excel window

Code:

---

Option Explicit
Sub ShowCirclePoint()
Dim MyXL As Object
Dim xlsheet As Object
Dim xlFileName As String
xlFileName = "D:\My Documents\AutoCAD testing.xls"
Set MyXL = GetObject(xlFileName)
Set xlsheet = MyXL.Worksheets("AutoCAD")
Dim oSset As AcadSelectionSet
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
Dim objAcadEntity As AcadEntity
Dim centerPoint(0 To 2) As Double
Dim circleObj As AcadCircle
Dim radius As Double
Dim cPoint As Variant
Dim mCir As Long
'Build filter to select circles
fcode(0) = 0
fData(0) = "CIRCLE" '<--entity type
dxfcode = fcode
dxfdata = fData
setName = "$Circle$"
On Error GoTo Err_Control
ZoomAll
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
  If ThisDrawing.SelectionSets.Item(i).Name = setName Then
      ThisDrawing.SelectionSets.Item(i).Delete
      Exit For
  End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
MsgBox "Wait... "
xlsheet.Cells(1, 1) = "No."
xlsheet.Cells(1, 2) = "Easting"
xlsheet.Cells(1, 3) = "Northing"
xlsheet.Cells(1, 4) = "Elevation"
xlsheet.Cells(1, 5) = "Radius"
mCir = 1
'Process each citrcle
For Each objAcadEntity In oSset
  Set circleObj = objAcadEntity
  radius = circleObj.radius
  cPoint = circleObj.Center
  xlsheet.Cells(mCir + 1, 1) = mCir
  xlsheet.Cells(mCir + 1, 2) = cPoint(0)
  xlsheet.Cells(mCir + 1, 3) = cPoint(1)
  xlsheet.Cells(mCir + 1, 4) = cPoint(2)
  xlsheet.Cells(mCir + 1, 5) = radius
  mCir = mCir + 1
Next
xlsheet.UsedRange.Columns.AutoFit
MyXL.SaveAs xlFileName, , , , False
Err_Control:
If Err.Number <> 0 Then
  MsgBox Err.Description
End If
End Sub

---

Hth

~'J'~

Thank you, it really works!

Now I think further more, if I want to know the other type object, I just change the "obj" type and put the right elements, is that right?

Regards,
Robert

Quote:

---

Originally Posted by Robert

Thank you, it really works!

Now I think further more, if I want to know the other type object, I just change the "obj" type and put the right elements, is that right?

Regards,
Robert

---

Yes, of course, you are right
Btw, you can to build filter to select several types
something like this:

Code:

---

fcode(0) = 0
fData(0) = "CIRCLE,ELLIPSE,ARC,LINE" '<--entity types separated by comma

---

Let us know if you need some help again

~'J'~

can you tell me basic of vba , suggest any doucument.i am waiting for your good reply

Quote:

---

Originally Posted by taj2501

can you tell me basic of vba , suggest any doucument.i am waiting for your good reply

---

Suggest you open MicroSoft Office Excel, then press ALT+F11, you will see the VBA windows.

You can use "Help"(F1), copy few code and then test.

Good luck!

Ungroup everything in the drawing (i.e., select all and then UNGROUP). Zoom to extents and then delete miscellaneous arcs throughout the drawing.

HI EXPERT VBA CAD

I have one drawing files, VBA code need to export text into excel worksheet, here with some condition. Text on drawing can have specified layer, text should be selected by mouse in order.. one selection text or group (two, three,etc mouse selection as group) text selection with some guide( some enter or what ever step break identification their, to going next selection of one or group text) Those should be put in different specified cells in excel.
ex: one selection text as title (First Column-"A")
four group selection as any remarks (Range "B","C","D","E") - the group of selected text within the cell tab or comma delimiter
i am also trying to do this task, but i am newly in vba cad.. due to time problem, So i expecting from user .. if its possible please give good answer..
and also expecting further related cad vba guide..

Thanks..
Yazzo