How to get object from AutoCAD

[Robert]

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?

[Tommy]

Hi Robert,

Welcome to VBAX!

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.

[fixo]

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

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

[Robert]

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?)

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

[fixo]

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

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

[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

[fixo]

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:

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

Let us know if you need some help again

~'J'~

[taj2501]

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

[Robert]

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!

[burgDD]

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

[Yazzo]

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