[VBA程序]：请教？

luln

请教：如何用sendcommand命令来调用lisp函数？

XDSoft

给你贴个小程序，看看里面的用法

2. 
   
3. [FONT=courier new]
   
4. Private Sub useLispToGetSelectionSet()
   
5.    
   
6.    ' Declare variables
   
7.    Dim ssnew As AcadSelectionSet
   
8.    Dim setcount As Integer
   
9.    Dim xDel As Integer
   
10. 
    
11.    ' Remove all selectionsets, include this
    
12.    ' if the SelectionsSet named Layout1 already exists
    
13.    setcount = ThisDrawing.SelectionSets.Count
    
14.    For xDel = 0 To setcount - 1
    
15.         ThisDrawing.SelectionSets.Item(xDel).Delete
    
16.    Next xDel
    
17.    
    
18.    ' Make a new selection set
    
19.    Set ssnew = ThisDrawing.SelectionSets.Add("Layout1")
    
20.    
    
21.    ' Use SendCommand to send a Lisp routine to put the objects
    
22.    ' in Model space in a selection set, you can change "Model" to the
    
23.    ' name of the Layout to put the entities on that layout in the
    
24.    ' selection set
    
25.    ThisDrawing.SendCommand ("(Setq ss1(ssget " & Chr(34) & "X" & Chr(34) & _
    
26.    "'((410 . " & Chr(34) & "Model" & Chr(34) & "))))" & vbCr)
    
27.   
    
28.    ' Make the selection set ssnew the last selection set
    
29.    ' created above
    
30.    ssnew.Select acSelectionSetPrevious
    
31.    
    
32.    ' Display a message box reporting the number of entities
    
33.    ' in the Selection set
    
34.    MsgBox "Number of entities in ssnew: " & ssnew.Count
    
35.    
    
36.    ' Delete the Seletion Set
    
37.    ssnew.Delete
    
38. 
    
39. End Sub[/FONT]

<br /> [FONT=courier new]<br /> Private Sub useLispToGetSelectionSet()<br />    <br />    ' Declare variables<br />    Dim ssnew As AcadSelectionSet<br />    Dim setcount As Integer<br />    Dim xDel As Integer<br /> <br />    ' Remove all selectionsets, include this<br />    ' if the SelectionsSet named Layout1 already exists<br />    setcount = ThisDrawing.SelectionSets.Count<br />    For xDel = 0 To setcount - 1<br />         ThisDrawing.SelectionSets.Item(xDel).Delete<br />    Next xDel<br />    <br />    ' Make a new selection set<br />    Set ssnew = ThisDrawing.SelectionSets.Add("Layout1")<br />    <br />    ' Use SendCommand to send a Lisp routine to put the objects<br />    ' in Model space in a selection set, you can change "Model" to the<br />    ' name of the Layout to put the entities on that layout in the<br />    ' selection set<br />    ThisDrawing.SendCommand ("(Setq ss1(ssget " & Chr(34) & "X" & Chr(34) & _<br />    "'((410 . " & Chr(34) & "Model" & Chr(34) & "))))" & vbCr)<br />   <br />    ' Make the selection set ssnew the last selection set<br />    ' created above<br />    ssnew.Select acSelectionSetPrevious<br />    <br />    ' Display a message box reporting the number of entities<br />    ' in the Selection set<br />    MsgBox "Number of entities in ssnew: " & ssnew.Count<br />    <br />    ' Delete the Seletion Set<br />    ssnew.Delete<br /> <br /> End Sub[/FONT]

XDSoft

再贴一个，这个里面用了如何调用setvar

2. 
   
3. [FONT=courier new]
   
4. Public Sub getMyEntityData()
   
5.     Dim myObj As AcadObject
   
6.     Dim ss1 As AcadSelectionSet
   
7.     Dim entHandle As String
   
8. 
   
9.     Set ss1 = ThisDrawing.SelectionSets.Add("test1")
   
10.     ss1.SelectOnScreen
    
11. 
    
12.     Set myObj = ss1(0)
    
13. 
    
14.     entHandle = myObj.handle
    
15. 
    
16.     ' Get the DXF code 0 of the object
    
17.     ThisDrawing.SendCommand ("(setvar ""users1"" (cdr (assoc 0 (entget (handent
    
18. """ & entHandle & """))))) ")
    
19.     Debug.Print "assoc 0 of entity = " & ThisDrawing.GetVariable("users1")
    
20. 
    
21.     ThisDrawing.SelectionSets("test1").Delete
    
22. End Sub[/FONT]

<br /> [FONT=courier new]<br /> Public Sub getMyEntityData()<br />     Dim myObj As AcadObject<br />     Dim ss1 As AcadSelectionSet<br />     Dim entHandle As String<br /> <br />     Set ss1 = ThisDrawing.SelectionSets.Add("test1")<br />     ss1.SelectOnScreen<br /> <br />     Set myObj = ss1(0)<br /> <br />     entHandle = myObj.handle<br /> <br />     ' Get the DXF code 0 of the object<br />     ThisDrawing.SendCommand ("(setvar ""users1"" (cdr (assoc 0 (entget (handent <br /> """ & entHandle & """))))) ")<br />     Debug.Print "assoc 0 of entity = " & ThisDrawing.GetVariable("users1")<br /> <br />     ThisDrawing.SelectionSets("test1").Delete<br /> End Sub[/FONT]

luln

多谢晓东的指点