pick two points get distance and angle of twopoints the send to the value in excel its on error in macro

[MUTHUKUMAR1983]

pick two points get distance and angle of twopoints the send to the value in excel its on error on attached image

 

Sub PickMultiplePointsAndTransferDataToExcel()
    Dim acadApp As Object
    Dim acadDoc As Object
    Dim startPoint As Variant
    Dim endPoint As Variant
    Dim length As Double
    Dim angle As Double
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    Dim currentRow As Long
    
    ' Get the AutoCAD Application object
    Set acadApp = GetObject(, "AutoCAD.Application")
    
    ' Check if AutoCAD is running
    If acadApp Is Nothing Then
        MsgBox "AutoCAD is not running."
        Exit Sub
    End If
    
    ' Get the active AutoCAD document
    Set acadDoc = acadApp.ActiveDocument
    
    ' Check if there is an active document
    If acadDoc Is Nothing Then
        MsgBox "No active AutoCAD document."
        Exit Sub
    End If
    
    ' Get the Excel Application object
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    
    ' Check if Excel is running
    If excelApp Is Nothing Then
        MsgBox "Excel is not running."
        Exit Sub
    End If
    
    ' Get the active Excel workbook and worksheet
    Set excelWorkbook = excelApp.ActiveWorkbook
    Set excelWorksheet = excelWorkbook.ActiveSheet
    
    ' Find the first empty row in the worksheet
    currentRow = excelWorksheet.Cells(excelWorksheet.Rows.Count, 1).End(-4162).Row + 1
    
    ' Loop to pick multiple points
    Do
        ' Prompt the user to pick a point
        acadDoc.Utility.GetPoint startPoint, "Pick a point: "
        
        ' Check if a point was picked
        If VarType(startPoint) = vbBoolean Then
            MsgBox "No point selected."
            Exit Do
        End If
        
        ' Check if it is the first point
        If IsEmpty(endPoint) Then
            endPoint = startPoint
        Else
            ' Calculate the length and angle between the points
            length = startPoint.DistanceTo(endPoint)
            angle = startPoint.AngleTo(endPoint)
            
            ' Write the length and angle values to Excel
            excelWorksheet.Cells(currentRow, 1).Value = length
            excelWorksheet.Cells(currentRow, 2).Value = angle
            
            ' Move to the next row
            currentRow = currentRow + 1
            
            ' Set the current point as the endpoint for the next iteration
            endPoint = startPoint
        End If
    Loop While True
    
    ' Save and close the Excel workbook
    excelWorkbook.Save
    
    ' Release the objects
    Set excelWorksheet = Nothing
    Set excelWorkbook = Nothing
    Set excelApp = Nothing
    
    ' Inform the user
    MsgBox "Length and angle values transferred to Excel successfully."
End Sub

 

[PeterPan9720]

Hi,

please let us know where you are developing the macro ??

Are you wrinting inside Autcad VBA ? or Excel VBA ? 

Looking at code

' Get the AutoCAD Application object

Set acadApp = GetObject(, "AutoCAD.Application")

 

seems you are wrinting in Excel, but later we can found

' Get the Excel Application object

On Error Resume Next

Set excelApp = GetObject(, "Excel.Application")

Where seems the opposite.

 

Let us know

thank you

[MUTHUKUMAR1983]

5 hours ago, PeterPan9720 said:

Hi,

please let us know where you are developing the macro ??

Are you wrinting inside Autcad VBA ? or Excel VBA ? 

Looking at code

' Get the AutoCAD Application object

Set acadApp = GetObject(, "AutoCAD.Application")

 

seems you are wrinting in Excel, but later we can found

' Get the Excel Application object

On Error Resume Next

Set excelApp = GetObject(, "Excel.Application")

Where seems the opposite.

 

Let us know

thank you

i writing inside in autocad

 

[BIGAL]

Do you have to use VBA lots of VL code out there that does same thing. 

 

I dabble like others with VBA but what is not working ? You need to debug it. Check values, use msgbox if necessary.