不做成命令总是很复杂的,:)下面的代码可以把工程的所有Sub注册为命令,前提是工程未加密,:)Lisp代码- (defun C:Sub2Cmd( / subname cmdname)
- (setq subname (getstring T "\n输入宏名:")
- cmdname (getstring T "\n输入命令名:"))
- (eval
- (list 'defun
- (read (strcat "C:" cmdname))
- nil
- '(setvar "cmdecho" 0)
- (list 'vl-vbarun subname)
- '(setvar "cmdecho" 1)
- (princ)
- ))
- )
- (vlax-add-cmd "Sub2Cmd" 'C:Sub2Cmd)
Vba代码- Public Sub RegAllSub()
- On Error Resume Next
- Dim pVbe As Object, pCode As Object
- Dim i, j, k
- Set pVbe = Application.VBE
- For Each i In pVbe.VBProjects
- For Each j In i.VBComponents
- If j.Type = 1 Or j.Type = 100 Then
- Set pCode = j.CodeModule
- For k = 1 To pCode.CountOfLines
- pCodeLine = pCode.Lines(k, 1)
- If (InStr(Trim(pCodeLine), "Public Sub ") = 1 Or InStr(Trim(pCodeLine), "Sub ") = 1) And InStr(pCodeLine, ")") = InStr(pCodeLine, "(") + 1 Then
- pSubName = Trim(RightStr(LeftStr(pCodeLine, "()"), "Sub "))
- ThisDrawing.SendCommand "Sub2Cmd" & vbCr & i.FileName & "!" & j.Name & "." & pSubName & vbCr & pSubName & vbCr
- End If
- Next k
- End If
- Next j
- Next i
- End Sub
|