分享

无限制调用vbs为lisp使用!

 求真我 2014-03-05
(vl-load-com)
(cond ((null *MSSC*)
       (setq *MSSC* (vlax-create-object "MSScriptControl.ScriptControl"))
       (vlax-put *MSSC* "Language" "VBS")
      )
)
(defun Fsxm-VBS-Eval (str)
  (vlax-invoke *MSSC* 'eval str)
)
(defun Fsxm-VBS-Exec (str)
  (vlax-invoke-method *MSSC* 'ExecuteStatement str)
)
(defun Fsxm-VBS-Run (Fun_lst)
  (vl-catch-all-apply 'vlax-invoke(vl-list* *mssc* "run" Fun_lst))
)
(defun Fsxm-VBS (VBSlst / cmd cmdstr0 cmdstr1 func i pastr return)
  (setq func (vl-princ-to-string (car VBSlst))
 cmdstr0 ""
 cmdstr1 ""
 i 0
 cmd (cdr VBSlst)
  )
  (foreach x cmd
    (setq i (1+ i))
    (setq pastr (if x (strcat "Fsxm" (itoa i)) " "))
    (setq cmdstr0 (strcat cmdstr0 " , " "Fsxm" (itoa i)))
    (setq cmdstr1 (strcat cmdstr1 " , " pastr))
  )
  (setq cmdstr0 (substr cmdstr0 4))
  (setq cmdstr1 (substr cmdstr1 4))
  (Fsxm-VBS-Exec
    (strcat
      "Function Fsxm_vbs(" cmdstr0  ")\nFsxm_vbs = Array ("
      func     "("   cmdstr1
      "))\nEnd Function"
     )
  )
  (setq return (vl-catch-all-apply
   'vlax-invoke
   (append (list *mssc* "run" "Fsxm_vbs") cmd)
        )
  )
  (if (listp return) (car return) return)
)

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多