Excel VBA - run overkill command on selection set
You can't pass SendCommand a handle. You can only send command text and lisp. You need to use the (handent) function to convert the handle to an ename. Also, its a bad idea to combine operations into one function. You should handle setting the acadapp object in a different function in order to compartentalize error handling. Give me a few minutes and I will refactor the code for you.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Here is the previous sample refactored, with the help of some of my utility functions.
Sub RunOverkillOnSelectionSet(acadApp As AcadApplication)
' Ensure AutoCAD is the active window
acadApp.Activate
' Define the selection set
Dim ss As AcadSelectionSet
Set ss = AddSelectionSet("okill")
ss.SelectOnScreen
' Check if the selection set is not empty
If ss.Count > 0 Then
' Run the Overkill command on the selection set
acadApp.ActiveDocument.SendCommand "_.overkill " & vbCrLf
' Loop through each item in the selection set and select it for the Overkill command
Dim item As AcadEntity
For Each item In ss
acadApp.ActiveDocument.SendCommand Ent2lspEnt(item) & vbCrLf
Next item
' Press Enter to execute the command
acadApp.ActiveDocument.SendCommand vbCrLf
Else
MsgBox "The selection set is empty."
End If
End Sub
Public Function Ent2lspEnt(entObj As AcadEntity) As String
'Designed to work with SendCommand, which can't pass objects.
'This gets an objects handle and converts it to a string
'of lisp commands that returns an entity name when run in SendCommand.
Dim entHandle As String
entHandle = entObj.Handle
Ent2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for when you want to create a
' selectin set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
On Error Resume Next
Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
If Err.Number <> 0 Then
Set AddSelectionSet = ThisDrawing.SelectionSets.item(SetName)
AddSelectionSet.Clear
End If
End Function
Public Function GetAcad(Optional ver As String) As AcadApplication
' support multiple acad versions.
'Sample ver for AutoCAD 2023 ' ".24.2"
On Error Resume Next
Dim acApp As AcadApplication
Dim clsid As String
clsid = "AutoCAD.Application"
If Not ver = "" Then
clsid = clsid & ver
End If
Set acApp = GetObject(, clsid)
If acApp Is Nothing Then
Set acApp = CreateObject(clsid)
End If
Set GetAcad = acApp
End Function
A couple notes on your original code. "p" in front of a variable indicates the data type is a pointer. The data type is a string. You are inconsistent in your naming too. The system I use, if I want to indicate the data type of a variable, I use "o" for objects, e.g. oLine, oDb. For types, I use "str, d, i, etc.", e.g strFileName, dPrice, iCount. There is some flexibility in this system, e.g. if the name fully indicates the content type, I don't use 'o' or 'str', e.g. "entHandle" is sufficient.
Using SendCommand or scripts requires the [Enter] key. Going back to typewriter days, that is equal to a carriage return (the cursor comes back to the start of the line) and a LineFeed (the cursor goes to the next line). In vba, this is the vbCrLf command. You just used vbCr. In most cases, you could also use vbLf, but vbCrLf is safer. I mention this because if you venture into creating text files, the same applies.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
You probably don't need to activate the app. All that does is bring it to the foreground. I'll have to check on the execution. I assumed that @wispoxy had done that.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
@wispoxy wrote:
I just tested both of ours. Your script runs error free but isn't triggering overkill. My script runs a '438' - not supported error for the acadApp.Activate.
I don't know what error 438 represents of the top of my head, but your code doesn't allow for the case that AutoCAD isn't running. In that case, you need to use the CreateObject function.
Looking at mine, I see that I only created a SelectionSet. I need to execute a selection method. So ss.Count is always 0 and the code drops out of the if statement. @cool.stuff , if you want this to run without user interaction, then create a selectionset filter that gives you the results you want and use it with the Select(acSelectionSetAll,,,,) method. I updated the code in post 7.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
In your version of RunOverkillOnSelectionset, you're not using the ss to select anything. Make the following changes to your code.
'select all objects of layer "GapPoints"
Dim tSelSet As AcadSelectionSet
Set tSelSet = AddSelectionSet("mySelSetGapPoints") 'Add line
Dim FromLayer As String
FromLayer = "GapPoints"
'Dim pSelSetName As String
'pSelSetName = "mySelSetGapPoints"
''create SelectionSet
'On Error Resume Next
'Set tSelSet = acadDoc.SelectionSets.item(pSelSetName)
'If (Not (tSelSet Is Nothing)) Then
' tSelSet.Clear
'Else
' Err.Clear
' Set tSelSet = acadDoc.SelectionSets.Add(pSelSetName)
'End If
'create selection filter
'Filtering SelectionSet
Dim tDxfCodes(0) As Integer
Dim tDxfValues(0) As Variant
tDxfCodes(0) = 8
tDxfValues(0) = FromLayer
'create selection
'Call 'not needed
tSelSet.Select(acSelectionSetAll, , , tDxfCodes, tDxfValues)
'Call VBAProject.Module1.RunOverkillOnSelectionSet(acadApp, pSelSetName)
RunOverkillOnSelectionSet(acadApp, tSelSet)
----------------------------
'Sub RunOverkillOnSelectionSet(acadApp As AcadApplication, ssName As String)
Sub RunOverkillOnSelectionSet(acadApp As AcadApplication, ss As AcadSelectionSet)
' Ensure AutoCAD is the active window
'acadApp.Activate
' Define the selection set
'Dim ss As AcadSelectionSet
'Set ss = AddSelectionSet(ssName)
'ss.SelectOnScreen
'Set ss = acadApp.ActiveDocument.Select
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Are you talking about the code you posted or my code?
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
