SelectOnScreen creates error

[jquade]

The code below will prompt user to select objects if ran from this sub, but when I call it from the main program it creates an error and does not prompt to select objects (basically skips over it). The main program opens several drawings, activates one at a time and calls this sub routine. I've searched for an error similar to this one and have not found one in the forum. Any suggestions or solutions would be much appreciated. Using AutoCAD Electrical 2019 and have also tried in AutoCAD 2019.

Private Sub GetSelections()
Dim objDevices As AcadSelectionSet
Dim intCodes(0 To 0) As Integer
Dim varCodeValues(0 To 0) As Variant
intCodes(0) = 8 'set the code for layer
varCodeValues(0) = "DEVICE*" 'set the code value
On Error Resume Next
ThisDrawing.SelectionSets("DEVICES").Delete
On Error GoTo 0
AppActivate ThisDrawing.Application.Caption
Set objDevices = ThisDrawing.SelectionSets.Add("DEVICES")
'select only objects on device* layers
objDevices.SelectOnScreen intCodes, varCodeValues
Set objDevices = Nothing
End Sub

Thanks in advance,

Jack

[Ed__Jobe]

Do you get an error message? Have you tried debugging by setting a breakpoint and stepping through execution until you hit the error? You might share your other code that calls this sub.

Looking at your code, creating a selection set within this sub is bad practice because of the way you use On Error. It should be handled in a separate sub. Search this forum for my AddSelectionSet sub. This way you don't run into the problem where On Error Resume Next masks any other errors. The errors still occur, you just don't know about them.

[jquade]

Thanks for the reply Ed. I do not get an error message. When I step through the execution, it steps through the line for SelectOnScreen and goes to the next line. I created a new code file and added the GetSelections sub and create a new main sub to open a couple files and then call GetSelections. It is working as it should. So I have a problem in my original code, not the SelectOnScreen function. I'll dive more into each line of the original code and try to find what could be causing the issue.

Note: This code was working at one time. I wrote it back around 2005, then left the company in 2007. Returned this year in April and was told it wasn't working. Debugging found the issue at SelectOnScreen. It's driving me NUTS!!! (Didn't have to drive far..)

Regards,

Jack

[norman.yuan]

While your post was titled as "...create error", yet you say you do not get error message, so what is is the "error" as you think of?

To diagnose the code, you need top provide more code with the context how this GetSelections() method is called. To me this line:

AppActivate ThisDrawing.Application.Caption

suggests that your code does not run in AutoCAD VBA, but from an external application (i.e. you automate AutoCAD via AutoCAD COM API).

Also, you mentioned "...opens several files...", which might be the reason of the code longer work now as it did in older version AutoCAD (pre-Acad2015), because Acad2015 had a critical change (removing FIBER) that broke quite some older code: switch active document cancels active command and may also cancel custom code execution, depending on how the code is executed. The "no error message" error sounds quite like the case of active drawing change that interrupting code execution.

Again, without seeing whole picture, it is difficult to comment further.

[jquade]

Norman ,

Thank you for your comments. The title of my post is incorrect as SelectOnScreen is not creating the error, although it does create an error down the line since it did not allow the user to select anything. The line for "AppActivate ThisDrawing.Application.Caption" was added recently as I found it used in another post and gave it a try. I have removed the line and I'm still getting the same results. This code is written in AutoCAD VBA. You mentioned the code may be broken due to the update in Acad2015. That is probably the case and I would need to find another way to perform this task if it can't be fixed here.

What I have found is if I select only one drawing from my OpenDoc form the SelectOnScreen function works correctly. It is when I select more than one drawing that it doesn't allow me to select objects. Even though I have activated the current drawing.

I've cleaned up my code to only show what is needed to get past the SelectOnScreen issue (notice I didn't say error?)

I appreciate your assistance and knowledge,

Jack

Option Explicit
Public colDwgSel As New Collection '''drawings selected to open
Public oApp As AcadApplication
Public sPath As String
Private oDoc As AcadDocument
Private Response

Public Sub Wire()

Set oApp = AcadApplication
Set oDoc = oApp.ActiveDocument

sPath = oDoc.Path & "\"

'form to get unit type
Load FrmUnitType
FrmUnitType.show

'form to select drawings to open
Load FrmOpenDoc
FrmOpenDoc.show

Unload FrmUnitType
Unload FrmOpenDoc

' close all open drawings
For Each oDoc In oApp.Documents
Set oDoc = oApp.Documents.Item(0)
oDoc.Close
Next

'open all drawings selected in FrmOpenDoc
Dim DwgSel As Variant
For Each DwgSel In colDwgSel
oApp.Documents.Open DwgSel
Next
Set oDoc = oApp.Documents.Item(0)

'''call module to get devices in order to be wired
GetDevices

For Each oDoc In oApp.Documents
oDoc.Close True
Next

Set oDoc = Nothing
Set oApp = Nothing

End Sub

Private Sub GetDevices()

Dim drawing As AcadDocument
Dim sDwg As String

For Each drawing In ThisDrawing.Application.Documents
drawing.Activate

'call sub to select devices to be wired
GetSelections

Next drawing

Set drawing = Nothing

End Sub

Private Sub GetSelections()
Dim objDevices As AcadSelectionSet
Dim intCodes(0 To 0) As Integer
Dim varCodeValues(0 To 0) As Variant
intCodes(0) = 8 'set the code for layer
varCodeValues(0) = "DEVICE*" 'set the code value
On Error Resume Next
ThisDrawing.SelectionSets("DEVICES").Delete
On Error GoTo 0
Set objDevices = ThisDrawing.SelectionSets.Add("DEVICES")
'select only objects on device* layers
objDevices.SelectOnScreen intCodes, varCodeValues
If objDevices.Count > 0 Then
MsgBox "Selected " & objDevices.Count
Else
MsgBox "Was not prompted to select objects", vbOKCancel
End If
Set objDevices = Nothing
End Sub

[norman.yuan · Accepted solution]

When you post code, please use the button "</>" above the message window, so that the code format would be preserved and easy to read.

I did a much more simplified version of code sample, which open 3 files and upon each drawing being opened, user is asked to select on screen. The code works OK, but not sure how it is similar to your case:

Option Explicit

Public Sub SelectSetInDwgs()

    Dim dwgFiles(0 To 2) As String
    dwgFiles(0) = "E:\Temp\Test01.dwg"
    dwgFiles(1) = "E:\Temp\Test02.dwg"
    dwgFiles(2) = "E:\Temp\Test03.dwg"
    
    SelectEntitiesInDwgs dwgFiles
    
    '' Show the result
    Dim dwg As AcadDocument
    Dim ss As AcadSelectionSet
    
    On Error Resume Next
    For Each dwg In Application.Documents
        Set ss = dwg.SelectionSets("MySet")
        If Not ss Is Nothing Then
            MsgBox "Entities in SelectionSet: " & ss.Count & vbCrLf & dwg.Name
            '' Do something with the entities in the selectionset in this document
        Else
            MsgBox "No SelectionSet in this drawing: " & vbCrLf & dwg.Name
        End If
    Next

End Sub

Private Sub SelectEntitiesInDwgs(dwgFiles As Variant)

    Dim i As Integer
    Dim fileName As String
    For i = 0 To UBound(dwgFiles)
        fileName = dwgFiles(i)
        SelectEntitiesInDwg fileName
    Next
    
End Sub

Private Sub SelectEntitiesInDwg(fileName As String)

    Dim dwg As AcadDocument
    Dim ss As AcadSelectionSet
    
    Set dwg = Application.Documents.Open(fileName)
    Set ss = dwg.SelectionSets.Add("MySet")
    ss.SelectOnScreen
    
End Sub

I use array to hold file name and no selection filter for the selecting, which should not make any difference in terms of the issue you encountered.

Hope at least this gives you a bit hint.

[jquade]

Thank you Norman. Your new code worked for me also.

Regards,

Jack