How can I pass the selectionSet in VBA to that in Lisp

I had wrote a code in Lisp and then want to implement the UI in VBA

How to pass the selection set made by VBA to Lisp and then used by Lisp
command such as (command "move" "" PT1 PT2 "") ?

for example:

VBA code:
Sub Test()
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets("test")
If Err Then Set ss = ThisDrawing.SelectionSets.Add("test")
ss.Clear
ss.SelectOnScreen
ThisDrawing.SendCommand "passSelection" & vbCr
End Sub




Lisp code:
(defun cassSelection()
(vl-load-com)
(setq acadapp (vlax-get-acad-object))
(setq acaddoc (vla-get-activedocument acadapp))
(setq selectionsets (vla-get-selectionsets acaddoc))


(setq ss (vla-item selectionsets "test"))

; ..........(how to implement ss->allobj "allobj" as a lisp selection)

(command "move" allObj "" PT1 PT2 "")


;.......................................


)

 

Look at this for some way(s)

http://code.acadx.com/articles/002.htm

Murph

 

I just figured out something like this that involved the VBA SendCommand function, which is basically equivalent to the AutoLISP (command... function.

It involved creating a VBA Group of items. I then moved the group "nowhere" (from 0,0 to 0,0) using VBA. This allowed me to then use the "P"revious option in my VBA SendCommand string. BTW, this was done to create an XClip of attached XRefs.

'==============================================
Private Sub GroupXRefs(ByVal strXClipBlocks As String)
On Error GoTo ErrHandler
'groups all attached XRefs for XClipping (in MakeVPort sub)
    Dim i%
    Dim intCodes(1) As Integer
    Dim sp(0 To 2) As Double
    Dim varData(1) As Variant
    Dim objSS As AcadSelectionSet
    Dim objEnts() As AcadEntity
    Dim objEnt As AcadEntity
    Dim objGroup As AcadGroup

'pts
    sp(0) = 0: sp(1) = 0: sp(2) = 0

Set objGroup = ThisDrawing.Groups.Add("XREFS")
    Set objSS = ThisDrawing.SelectionSets.Add("XREFS")

'build filter for selset
    intCodes(0) = 0: varData(0) = "INSERT" 'entity type
    intCodes(1) = 2: varData(1) = strXClipBlocks 'name

objSS.Select acSelectionSetAll, , , intCodes, varData

'set entitiay array bounds
    ReDim objEnts(objSS.Count - 1)

'build entitiy from ss
    For i% = 0 To objSS.Count - 1
        Set objEnts(i%) = objSS(i%)
    Next i%
    'addd ents to group
    objGroup.AppendItems objEnts

'Move nowhere
    For Each objEnt In objGroup
        objEnt.Move sp, sp
    Next

CleanUp:
    If Not objGroup Is Nothing Then objGroup.Delete
    If Not objSS Is Nothing Then objSS.Delete
    Set objGroup = Nothing
    Set objSS = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Number & vbCr & Err.Description
    Resume CleanUp
End Sub

'==============================
Then elsewhere I used this:

' XClip pts - translate WCS pt to UCS
    varUCSLL = ThisDrawing.Utility.TranslateCoordinates(dblLL, acWorld, acUCS, False)
    varUCSUR = ThisDrawing.Utility.TranslateCoordinates(dblUR, acWorld, acUCS, False)

' Add XClip
    strLL = CStr(varUCSLL(0) - 25) & "," & CStr(varUCSLL(1) - 25)
    strUR = CStr(varUCSUR(0) + 25) & "," & CStr(varUCSUR(1) + 25)
    'build string
    strCmd = "XCLIP" & vbCr & "P" & vbCr & vbCr & "N" & vbCr & "R" & vbCr & strLL & vbCr & strUR & vbCr
    ThisDrawing.SendCommand strCmd