PDA

View Full Version : Need Help with Excel Macro



Bylloo
03-07-2024, 01:34 PM
I am creating a macro to import attributes from Autocad entities. The one in partiicular is a feature line.
I managed to get everything working, but I am trying to get the minimum elevation from the feature line but I don't know what is the correct command for it.
The section where I have this issue follows below (note that the length and the maximum elevation are working fine, just the minimum elevation that does not work)


Thisdrawing.Utility.GetEntity returnObj, basePnt, "Select Feature Line: "
Err.Clear
returnObj.Update
ValorLength = Round(returnObj.Length2D, 4)
MaxElev = Round(returnObj.MaxElevation, 4)
MinElev = Round(returnObj.MinElevation, 4)

Can someone help me?

ps: I use autocad 2021 version

Aussiebear
03-07-2024, 05:16 PM
Welcome to VBAX Bylloo. Its been a while since we've had an Autocad request. Hopefully someone comes along shortly.

arnelgp
03-07-2024, 06:05 PM
chatGPT has some answer:

Sub FindMinimumElevation()
Dim acadApp As Object 'AutoCAD Application
Dim acadDoc As Object 'AutoCAD Document
Dim selectionSet As Object 'Selection Set
Dim entity As Object 'Selected Entity
Dim minElevation As Double
Dim elevation As Double

' Create a new instance of AutoCAD
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True ' Optionally make AutoCAD visible

' Get the active document in AutoCAD
Set acadDoc = acadApp.ActiveDocument

' Create a selection set to hold the entities
Set selectionSet = acadDoc.SelectionSets.Add("MySelectionSet")

' Prompt the user to select the entities
selectionSet.SelectOnScreen

' Initialize the minimum elevation to a large value
minElevation = 999999

' Loop through each selected entity
For Each entity In selectionSet
' Check if the entity has elevation property (for example, polylines have)
If entity.HasElevation Then
' Get the elevation of the entity
elevation = entity.Elevation

' Update the minimum elevation if necessary
If elevation < minElevation Then
minElevation = elevation
End If
End If
Next entity

' Display the minimum elevation found
MsgBox "Minimum Elevation: " & minElevation

' Delete the selection set
acadDoc.SelectionSets.Item("MySelectionSet").Delete
End Sub

Bylloo
03-07-2024, 07:02 PM
Tried but it did not work :crying:

arnelgp
03-07-2024, 09:15 PM
can you upload your .acad drawing?

Bylloo
03-10-2024, 02:03 PM
It points an error when I try to upload the CAD file, sorry. But what I am creating is a template spreadsheet, the macro isn't specific to a file. So, when I am testing, I just open a blank CAD file and create the feature line randomly and see if the macro works


can you upload your .acad drawing?