[日积月累]：关于PickfirstSelectionSet Bug的解决办法

雪山飞狐(lzh)

也许并不是一个Bug，而是我们没发现罢了

2. 
   
3. Sub Example_PickfirstSelectionSet()
   
4.     ' This example lists all the objects in the pickfirst selection set.
   
5.     ' Before running this example, create some objects in the active
   
6.     ' drawing and select those objects. The objects currently selected
   
7.     ' in the active drawing will be returned in the pickfirst selection set.
   
8.             
   
9.     Dim pfSS As AcadSelectionSet
   
10.     Dim ssobject As AcadEntity
    
11.     Dim msg As String
    
12.     msg = vbCrLf
    
13.    
    
14.     Set pfSS = ThisDrawing.PickfirstSelectionSet
    
15.     For Each ssobject In pfSS
    
16.         msg = msg & vbCrLf & ssobject.ObjectName
    
17.     Next ssobject
    
18.     MsgBox "The Pickfirst selection set contains: " & msg
    
19.    
    
20. End Sub
    

<br /> Sub Example_PickfirstSelectionSet()<br />     ' This example lists all the objects in the pickfirst selection set.<br />     ' Before running this example, create some objects in the active<br />     ' drawing and select those objects. The objects currently selected<br />     ' in the active drawing will be returned in the pickfirst selection set.<br />             <br />     Dim pfSS As AcadSelectionSet<br />     Dim ssobject As AcadEntity<br />     Dim msg As String<br />     msg = vbCrLf<br />     <br />     Set pfSS = ThisDrawing.PickfirstSelectionSet<br />     For Each ssobject In pfSS<br />         msg = msg & vbCrLf & ssobject.ObjectName<br />     Next ssobject<br />     MsgBox "The Pickfirst selection set contains: " & msg<br />     <br /> End Sub<br />

以上的例子在IDE窗口中运行没问题
调用-vbarun命令运行时不能正确运行
可以用下列方法j解决
定义Lisp函数：

2. 
   
3. (defun tls-sub2cmd(filename subname cmdname)
   
4. (eval
   
5.   (list 'defun
   
6.    (read (strcat "c:" cmdname))
   
7.    nil
   
8.    '(if (cadr(ssgetfirst)) (sssetfirst nil (ssget)))
   
9.    (list 'vla-RunMacro
   
10.          '(vlax-get-acad-object)
    
11.           (strcat filename "!" subname)
    
12.    )
    
13.    '(sssetfirst nil nil)
    
14.    '(princ)
    
15.   )
    
16. )
    
17. (vlax-add-cmd cmdname (strcat "C:" cmdname))
    
18. (princ)
    
19. )
    

<br /> (defun tls-sub2cmd(filename subname cmdname)<br /> (eval<br />   (list 'defun<br />    (read (strcat "c:" cmdname))<br />    nil<br />    '(if (cadr(ssgetfirst)) (sssetfirst nil (ssget)))<br />    (list 'vla-RunMacro<br />          '(vlax-get-acad-object)<br />           (strcat filename "!" subname)<br />    )<br />    '(sssetfirst nil nil)<br />    '(princ)<br />   )<br /> )<br /> (vlax-add-cmd cmdname (strcat "C:" cmdname))<br /> (princ)<br /> )<br />

调用格式为：
(tls-sub2cmd "文件名" "宏名" "命令名")