[转贴]：Load_And_Run_VBA

eachy

2. (defun Load_And_Run_VBA        (File Procedure / cFile)
   
3.   (vl-load-com)
   
4.   (defun Get_VBP_List (/ cPr cPat VBPrj pQnt pCnt prLst)
   
5.     (setq VBPrj        (vlax-get
   
6.                   (vla-get-VBE
   
7.                     (vlax-get-acad-object)
   
8.                   )
   
9.                   'VBProjects
   
10.                 )
    
11.           pQnt        (vla-get-Count VBPrj)
    
12.           pCnt        1
    
13.     )
    
14.     (repeat pQnt
    
15.       (setq cPr (vla-Item VBPrj pCnt))
    
16.       (if (vl-catch-all-error-p
    
17.             (setq cPat (vl-catch-all-apply
    
18.                          'vlax-get
    
19.                          (list cPr 'FileName)
    
20.                        )
    
21.             )
    
22.           )
    
23.         (setq prLst (cons "*Invalid Project*" prLst))
    
24.         (setq prLst (cons cPat prLst))
    
25.       ) ;_ end if
    
26.       (setq pCnt (1+ pCnt))
    
27.     ) ;_ end repeat
    
28.     prLst
    
29.   ) ;_ end of Get_VBP_List
    
30.   (if (setq cFile (findfile File))
    
31.     (progn
    
32.       (if (not (member (strcase cFile)
    
33.                        (mapcar 'strcase (Get_VBP_List))
    
34.                )
    
35.           )
    
36.         (vl-vbaload cFile)
    
37.       ) ;_ end if
    
38.       (if (member (strcase cFile)
    
39.                   (mapcar 'strcase (Get_VBP_List))
    
40.           )
    
41.         (vl-vbarun Procedure)
    
42.         (princ
    
43.           (strcat "\n<!> Can't to load VBA Project: '"
    
44.                   cFile
    
45.                   "' <!> "
    
46.           )
    
47.         )
    
48.       ) ;_end if
    
49.     ) ;_end progn
    
50.     (princ
    
51.       (strcat "\n<!> Can't to find VBA Project: '"
    
52.               File
    
53.               "' <!> "
    
54.       )
    
55.     )
    
56.   ) ;_ end if
    
57.   (princ)
    
58. ) ;_ end of Load_And_Run_VBA

(defun Load_And_Run_VBA        (File Procedure / cFile)<br />   (vl-load-com)<br />   (defun Get_VBP_List (/ cPr cPat VBPrj pQnt pCnt prLst)<br />     (setq VBPrj        (vlax-get<br />                   (vla-get-VBE<br />                     (vlax-get-acad-object)<br />                   )<br />                   'VBProjects<br />                 )<br />           pQnt        (vla-get-Count VBPrj)<br />           pCnt        1<br />     )<br />     (repeat pQnt<br />       (setq cPr (vla-Item VBPrj pCnt))<br />       (if (vl-catch-all-error-p<br />             (setq cPat (vl-catch-all-apply<br />                          'vlax-get<br />                          (list cPr 'FileName)<br />                        )<br />             )<br />           )<br />         (setq prLst (cons "*Invalid Project*" prLst))<br />         (setq prLst (cons cPat prLst))<br />       ) ;_ end if<br />       (setq pCnt (1+ pCnt))<br />     ) ;_ end repeat<br />     prLst<br />   ) ;_ end of Get_VBP_List<br />   (if (setq cFile (findfile File))<br />     (progn<br />       (if (not (member (strcase cFile)<br />                        (mapcar 'strcase (Get_VBP_List))<br />                )<br />           )<br />         (vl-vbaload cFile)<br />       ) ;_ end if<br />       (if (member (strcase cFile)<br />                   (mapcar 'strcase (Get_VBP_List))<br />           )<br />         (vl-vbarun Procedure)<br />         (princ<br />           (strcat "\n<!> Can't to load VBA Project: '"<br />                   cFile<br />                   "' <!> "<br />           )<br />         )<br />       ) ;_end if<br />     ) ;_end progn<br />     (princ<br />       (strcat "\n<!> Can't to find VBA Project: '"<br />               File<br />               "' <!> "<br />       )<br />     )<br />   ) ;_ end if<br />   (princ)<br /> ) ;_ end of Load_And_Run_VBA

pengpeichun

好好学习学习

seek_sun

123