难得上网，一上来就见到不错的资料
本帖最后由 作者 于 2007-8-9 21:01:10 编辑
虽说有的方面功能可能比lisp多一点点但事实上大多数都是用不到的啦!
我这个函数写出来很久了,但几乎都没用到过,
在CAD的lisp中用不到太高深的系统方面的知识的,
就如之前一高人发的win32api for lisp功能够强大吗?但为什么用的人不多
用来解决时常小小的CAD问题的,实际上就lisp就够了没必要用太多的混合编程,
会很多编程语言的人都不用lisp来编程了.
想想你都可以在lisp中用字符拼成VB语句说明你VB用的很好哦
你直接就用VBA来写程序不是更快更好?,为什么还要用lisp来拼写VB语句呢?
下面我的fsxm-vbs源程序代码,
秘诀就是:写一个会写vbs函数的lisp程序!
这是核心代码:
(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))
)
完整代码如下:
(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)
)
看样子，可以打通alisp的任督二脉了。
相当不错的资料,的确让人大开眼界。既然<font face="Verdana" color="#61b713"><strong>fsxm</strong><font color="#000000">大侠已经公布了秘诀，<font color="#ff0099">无痕</font>版主是否舍得将你的源程序拿出来让大家共赏，对比和学习学习呢？</font></font>
强悍！！编程越来越简单了，但是想成为高手却越来越难了！！！
i fl u.l h.
本帖最后由 作者 于 2007-8-12 1:09:37 编辑 <br /><br /> <p>fsxm 的 <font color="#0000ff">写一个会写vbs函数的lisp程序! <font color="#000000">的想法很好.我进行了如下测试</font></font></p><p>(fsxm-vbs '(msgbox "测试"))<br/>(fsxm-vbs '(msgbox "测试" & "ok")) -> 丢失"ok"<br/>(fsxm-vbs '(msgbox (strcat "测试 " "&" " ok"))) -> #<%catch-all-apply-error%><br/>(fsxm-vbs '(msgbox (strcat "测试 " & " ok"))) -> #<%catch-all-apply-error%><br/>(fsxm-vbs '(msgbox ("测试 " & " ok"))) ->#<%catch-all-apply-error%></p><p>也许我的方法不对.没有得出想要的结果.发现未能够很好支持 &,+等函数,vbs函数在表达式中未能嵌套.</p><p>于是自己对原来的xcal做了升级.借用了fsxm的将vbs函数写成lisp函数格式的</p><p>想法.并且作了功能上的增强.<font color="#dd226d">将函数方式进行到底！</font>详细介绍如下:</p><p><br/><font color="#0000ff">(xvbs a) = 函数方式执行vbs语句(第二代) by 梁雄啸.2007.8<br/>函数：xvbs<br/>格式：(xvbs 函数表达式)<br/>参数：函数表达式，格式：表 或 字符串.<br/> vbs函数用'引导，如：(list 'msgbox "测试") 或 '(msgbox "测试").<br/> 可多重嵌套.<br/> 支持lisp变量.变量不用'引导.<br/> 支持vbs的&,+等函数.<br/> 字符串格式,如:<br/></font><font color="#0e0e7b">测试:<br/>1. (xvbs '(msgbox ("测试时间 : " & vbcr & now )1))<br/>2. 支持变量:<br/> (setq path (getvar "acadver"))<br/> (xvbs (list 'msgbox (list "测试" '& 'vbcr '& path) 3))<br/>3. 支持在函数表达式中使用lisp语句:<br/> (xvbs(list 'msgbox (list "测试" '& 'vbcr '& (strcat "cad版本号 = " (getvar "acadver"))) 3))<br/>4. 连续执行多个vbs语句,支持vbs中变量传递:<br/> (xvbs '(cs = "测试"))<br/> (xvbs '(msgbox (cs & "ok"))) ;; cs是在vbs中定义的变量.<br/>5. 支持字符串表达式:<br/> (xvbs "msgbox(\"测试时间:\" & now)")<br/><br/></font></p><p>再对开始的实例进行测试:</p><p>(xvbs '(msgbox ("测试 " & " ok"))) ->返回正确.</p><p>下载请点链接:</p><p><a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62199">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62199</a></p>
<p><font color="#ee3d11">以下說明有例子嗎?</font></p><p>2.如果VBS內容過長,可分成幾段來移植,但是被調用的子函數必須寫在前面.<br/> 即把調用子函數的部分放到最後.有回車的地方要保留,如:<br/> (setq STR \"<br/> ****移植的語句****<br/> \"<br/> )</p><p>下列的註解你的程序會先處理掉嗎?</p><p>;; 正則表達式應用. ok<br/>(setq str " <br/>function regexptest(patrn, strng)<br/>dim regex, match, matches ' 建立變量。<br/>set regex = new regexp ' 建立正則表達式。<br/>regex.pattern = patrn ' 設置模式。<br/>regex.ignorecase = true ' 設置是否區分字符大小寫。<br/>regex.global = true ' 設置全局可用性。<br/>set matches = regex.execute(strng) ' 執行搜索。<br/>for each match in matches ' 遍歷匹配集合。<br/>retstr = retstr & \"match found at position \" & match.firstindex & \". match value is '\"<br/>retstr = retstr & match.value & \"'.\" & vbcrlf<br/>next<br/>regexptest = retstr<br/>end function<br/>msgbox(regexptest(\"is.\", \"is1 is2 is3 is4\"))<br/>")<br/>(xxvbs str "")</p>
<p>回龙龙仔，你贴子里面那个就是实例。这只是建议的书写格式。</p><p>其实以下输入格式都是可以的：</p><p>1.<br/>(setq str " <br/>a = \"测试\"<br/>msgbox a<br/>")<br/>(xxvbs str "")<br/>2.<br/>(setq str "a = \"测试\"<br/> msgbox a")<br/>(xxvbs str "")<br/>3.<br/>(setq str "a = \"测试\" \nmsgbox a")<br/>(xxvbs str "")<br/>4.<br/>(xxvbs "a = \"测试\" \nmsgbox a" "")<br/>5.<br/>(xxvbs "a = \"测试\"<br/> msgbox a" "")</p><p>程序支持vbs语句加注解，我已经测试过，正常。</p>
本帖最后由 作者 于 2007-8-13 12:37:58 编辑 <br /><br /> <p>我知道你的程序支持vbs语句加注解,但我重寫的程序不支持加注解,想不出為甚麼? </p><p>也不支持wscript.CreateObject==>要改為CreateObject</p><p>我用下列</p><p> (setq MSSC (vlax-create-object "MSScriptControl.ScriptControl"))</p><p> OR (setq MSSC (vlax-create-object "ScriptControl")) 都不支持加注解</p><p></p><p></p>