Dim objEnt As AcadEntity
EvalLispExpression AcadApp, "(setq ss (ssadd))"
For Each objEnt In ss
EvalLispExpression AcadApp, "(ssadd " & _
"(handent " & Chr(34) & _
objEnt.Handle & Chr(34) & ")" & _
"ss" & _
")"
Next
EvalLispExpression AcadApp, "(sssetfirst nil ss)"
EvalLispExpression AcadApp, "(setq ss nil)"
End Sub
Public Function EvalLispExpression(ByVal AcadApp As AcadApplication, lispStatement As String)
Dim VL As Object, VLF As Object
Dim sym As Object, ret As Object, retVal
Select Case Val(Left(AcadApp.Application.Version, 2))
Case Is = 15
Set VL = AcadApp.Application.GetInterfaceObject("VL.Application.1")
Case Is >= 16
Set VL = AcadApp.Application.GetInterfaceObject("VL.Application.16")
End Select
Set VLF = VL.ActiveDocument.Functions
Set sym = VLF.Item("read").funcall(lispStatement)
On Error Resume Next
retVal = VLF.Item("eval").funcall(sym)
If Err Then
EvalLispExpression = ""
Else
EvalLispExpression = retVal
End If
On Error GoTo 0
End Function
Public Sub TestC(ByVal AcadApp As AcadApplication)
Dim sSet As AcadSelectionSet
For Each sSet In AcadApp.Application.ActiveDocument.SelectionSets
If sSet.Name = "TESTC" Then sSet.Delete: Exit For
Next
Set sSet = AcadApp.Application.ActiveDocument.SelectionSets.Add("TESTC")
sSet.Select acSelectionSetAll
ShowSelectionSetCrips AcadApp, sSet
sSet.Delete
End Sub
(defun c:TestC( / rndobj)
(vl-load-com)
(setq rndobj (vlax-get-or-create-object "TestX.TestB"))
(vlax-invoke-method rndobj "TestC" (vlax-get-acad-object))
(vlax-release-object rndobj)
(princ)
)
regsvr32 /s TestX.dll
全部评论