Consulting

Results 1 to 11 of 11

Thread: How to get object from AutoCAD

  1. #1
    VBAX Regular
    Joined
    Mar 2007
    Location
    Taipei
    Posts
    15
    Location

    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?

  2. #2
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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.

  3. #3
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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'~
    Last edited by Aussiebear; 04-09-2023 at 04:20 PM. Reason: Adjusted the code tags

  4. #4
    VBAX Regular
    Joined
    Mar 2007
    Location
    Taipei
    Posts
    15
    Location

    Post

    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
    Last edited by Aussiebear; 04-09-2023 at 04:21 PM. Reason: Adjusted the code tags

  5. #5
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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'~
    Last edited by Aussiebear; 04-09-2023 at 04:26 PM. Reason: Adjusted the code tags

  6. #6
    VBAX Regular
    Joined
    Mar 2007
    Location
    Taipei
    Posts
    15
    Location

    Smile

    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

  7. #7
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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:

    fcode(0) = 0 
    fData(0) = "CIRCLE,ELLIPSE,ARC,LINE" '<--entity types separated by comma
    Let us know if you need some help again

    ~'J'~
    Last edited by Aussiebear; 04-09-2023 at 04:26 PM. Reason: Adjusted the code tags

  8. #8
    VBAX Newbie
    Joined
    Sep 2016
    Posts
    1
    Location

    how to learn vba for auotcad

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

  9. #9
    VBAX Regular
    Joined
    Mar 2007
    Location
    Taipei
    Posts
    15
    Location
    Quote Originally Posted by taj2501 View Post
    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!

  10. #10
    VBAX Regular burgDD's Avatar
    Joined
    Jan 2017
    Location
    Atlanta
    Posts
    6
    Location
    Ungroup everything in the drawing (i.e., select all and then UNGROUP). Zoom to extents and then delete miscellaneous arcs throughout the drawing.
    Last edited by Aussiebear; 04-09-2023 at 04:28 PM. Reason: Deciphered the font issue

  11. #11
    VBAX Newbie
    Joined
    Sep 2017
    Posts
    4
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •