唉，多谢caoyin抬举，先留空位，有能拿出来的尽量咯
<p>记得原来帮过别人改了一个“自动编号”的程序，自己感觉还算有点用，不过这种程序网络上太多：</p><p>功能：自动编号，可以加前缀、后缀，自定增加减少的序数（不关闭cad前提下可记忆前后缀）</p><p> <font face="新宋体">(defun c:bh (/ oce1 n1 zn h1 sxh1 p1)<br/>(vl-load-com)<br/>(setq oce1 (getvar "cmdecho"))<br/>(setvar "cmdecho" 0)<br/>(setq ms (vla-get-modelspace<br/>(vla-get-activedocument (vlax-get-acad-object))<br/>)<br/>)<br/>(if qz<br/>()<br/>(setq qz "")<br/>)<br/>(if hz<br/>()<br/>(setq hz "")<br/>)<br/>(initget "c")<br/>(setq nqz (getstring (strcat "\n请输入前缀相同的部分<" qz ">/c(为空): " )))<br/>(cond<br/>((= nqz "c") (setq qz ""))<br/>(T (if (/= nqz "")(setq qz nqz)))<br/>)<br/>(setq nhz (getstring (strcat "\n请输入后缀相同的部分<" hz ">/c(为空): " )))<br/>(cond<br/>((= nhz "c") (setq hz ""))<br/>(T (if (/= nhz "")(setq hz nhz)))<br/>)<br/>(if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))<br/>(setq n1 1)<br/>)<br/>(if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))<br/>(setq zn 1)<br/>)<br/>(if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))<br/>(setq h1 2.5)<br/>)<br/>(setq sxh1 (strcat qz (xd-string_zeropad n1 3 "0" 0) hz))<br/>(setq p1 (getpoint "\n请指定插入点: "))<br/>(while (/= p1 nil)<br/>(setq p1 (vlax-3d-point p1))<br/>(setq txt (vla-addtext<br/>ms<br/>sxh1<br/>p1<br/>h1<br/>)<br/>)<br/><br/>(setq<br/>n1 (+ n1 zn)<br/>sxh1 (strcat qz (xd-string_zeropad n1 3 "0" 0) hz)<br/>p1 (getpoint "\n请指定下一插入点: ")<br/>)<br/><br/>)<br/>(setvar "cmdecho" oce1)<br/>(vlax-release-object ms)<br/>(princ)<br/>)<br/><br/><br/>;; Form www.xdcad.net eachy 2005.9.21<br/>;|<br/>功 能 用指定字符首位补位格式化数字<br/>参 数 intVal：要补位的数。;<br/>Pad： 代表添加字符形成的数值的位数<br/>sp 补位字符;<br/>str 小数位数<br/>示 例 (xd-stringZeroPad 123 4 "0" 0)<br/>注 意 以上示例将返回“0123”。<br/>_$ (XD-STRING_ZEROPAD 123 8 " " 2)<br/>" 123.00"<br/>_$ (XD-STRING_ZEROPAD 123 8 "A" 2)<br/>"AA123.00"<br/>|;<br/>(defun xd-string_zeropad (intval pad sp str / zeros)<br/>(setvar "dimzin" 0)<br/>(strcat<br/>(apply 'strcat<br/>(repeat (- pad (strlen (rtos intval 2 str)))<br/>(setq zeros (cons sp zeros)) ; make list<br/>)<br/>)<br/>(rtos intval 2 str)<br/>)<br/>)</font></p>
本帖最后由 作者 于 2008-12-6 22:56:26 编辑 <br /><br /> <p>caoyin都这么说了，不发点东西，真不好意思。</p><p>来个经典的。今天重写。</p><p>;;;writenn by carrot1983 2008-12-06<br/>(defun c:cd (/ e elist i newstring pt1 pt2)<br/> (command "._undo" "_begin")<br/> (princ "\n功能: 纯数字递增复制")<br/> (if (and (setq e (car (entsel "\n选择纯数字 <退出>: ")))<br/> (if (setq i (getint "\n输入增值 <1>: ")) t (setq i 1))<br/> (setq pt1 (getpoint "\n指定第一点 <退出>: "))<br/> )<br/> (while (setq pt2 (getpoint pt1 "\n下一点 <退出>: "))<br/> (setq elist (entget e))<br/> (setq newstring (itoa (+ (read (cdr (assoc 1 elist))) i))) ;_递增<br/> (entmake (subst (cons 1 newstring)<br/> (assoc 1 elist)<br/> elist<br/> )<br/> )<br/> (setq e (entlast))<br/> (command "._move" e "" "none" pt1 "none" pt2)<br/> (setq pt1 pt2)<br/> )<br/> )<br/> (command "._undo" "_end")<br/> (princ)<br/>)</p>
本帖最后由 作者 于 2008-12-6 23:03:31 编辑 <br /><br /> <p>高手这么多，很多程序怕拿不出手。。。</p><p>程序就扔在这里啦：</p><p><a href="http://carrot1983.ys168.com/">http://carrot1983.ys168.com/</a> </p><p></p>
本帖最后由 作者 于 2008-12-8 11:55:33 编辑 <br /><br /> <p>;;剪切板内容查看和设置</p><p>;;by nonsmall @ mjtd</p><p>(setq ob (vlax-create-object "htmlfile"))</p><p>;读取内容<br/>(vba "ob.ParentWindow.ClipboardData.GetData(\"text\")"))</p><p>;设置内容为字符串123</p><p>(vba "ob.ParentWindow.ClipboardData.SetData(\"Text\",\"123\")")</p><p>===========================</p><p>VB原型:</p><p>Set obj = CreateObject("htmlfile")<br/>ClipboardText=obj.ParentWindow.ClipboardData.GetData("text")<br/>MsgBox ClipboardText</p><p>===========================</p><p>测试:</p><p>获取EXCEL复制一行的内容<br/></p><p></p><p>命令: (setq ob (vlax-create-object "htmlfile"))<br/>#<VLA-OBJECT DispHTMLDocument 06e0cac8><br/>命令: (vlax-variant-value (vba "ob.ParentWindow.ClipboardData.GetData(\"text\")"))<br/>"1\t1\t1\t1\t1\t1\t1\t1\t1\r\n"</p><p></p><p>上面VBA函数原型<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72391">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72391</a></p>
<p>发布一个字符串转表的程式,写的不好，请大家批评指导.</p><p><font color="#5233cc">新年也快要到了，先给大家</font><font color="#3300ff" size="4">拜早年了.</font></p><p><font color="#5233cc"></font> </p><p><font color="#5233cc">祝愿各位明经同仁天天快乐 ...</font></p><p><font color="#5233cc"></font> </p><p><font color="#5233cc">祝愿明经人气更上新台阶、旺、旺、旺...</font></p>
<p>衷心感谢</p><p><a href="http://www.mjtd.com">www.mjtd.com</a></p><p>这里是CAD知识的海洋，是中国工程的的CAD之家。</p>
感谢各位的支持
俺的程序下载率好高呀，
本帖最后由 作者 于 2008-12-13 17:38:29 编辑
最近工作比较忙，没怎么写程序了。发个以前的，没怎么测试。技巧和难度不大，但愿可以为大家节省点时间罢了
;| xapp 生成activex实体--------by lxx.2008.3
这是一个集成的生成activex实体的函数，不必再一个个去找了.
测试:
(setq a (xapp "doc"))
(setq b (xapp "HTML"))
(setq b (xapp "MSG"))
(xapp (setq nam "WORD.DOC"))
(setq ps (xapp "PHOTOSHOP"))
(vlax-dump-object ps)
(vla-get-name (vla-get-ActiveDocument ps)) -> "aaa"
|;
(defun xapp (nam /); 全局变量: (*APPLST)
(if (setqobj (cdr(assoc (strcase nam) *applst)))
(vlax-get-or-create-object obj)
)
)
;;;(vlax-get-or-create-object".NET Framework")
(setq *applst '(("REGEXP" . "VBScript.RegExp");; 正则表达式
("DBX" . "ObjectDBX.AxDbDocument") ;; CAD的activex接口
("SHELL" . "Shell.Application");; WINDOWS SHELL
;; vbs
("FSO" . "Scripting.FileSystemObject")
("SCR" . "ScriptControl")
("WSC.SH" . "wscript.shell")
("WSC.NET" . "wscript.Network")
;; xml,word,excell,acess,ie,html
("XML" . "Microsoft.XMLHTTP")
("XML.DOC" . "MSXML2.DOMDocument")
("EXCEL" . "Excel.Application")
("EXCEL.SHEET" . "Excel.Sheet")
("WORD" . "Word.application")
("WORD.DOC" . "Word.Document")
("ACESS" . "Access.Application")
("IE" . "Internetexplorer.application")
("HTML" . "htmlfile")
;;
("PHOTOSHOP" . "PhotoShop.Application")
("WBEM" . "wbemScripting.SwbemLocator")
("ADO.CON" . "ADODB.Connection")
("ADO.STM" . "ADODB.Stream")
("ADO.REC" . "wADODB.Recordset")
("CAO" . "CAO.DbConnect")
;; ms app
("SAPI" . "Sapi.SpVoice")
("AGENT" . "Agent.Control");;让默林来帮你说话
("COMDLG" . "mscomdlg.commondialog") ;; windows file select dialog
("MSN" . "MSNMessenger.MessengerApp") ;; msn
("WMP" . "WMPlayer.OCX");Windows Media Player:
("PRN" . "WinPrint.WinPrintX");;WinPrint :
("MSG" . "Messenger.UIAutomation.1")
("D2" . "System.Drawing.Drawing2D")
)
)
;| ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝参考资料＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(vlax-get-or-create-object prog-id)
创建NOTEPAD对象实例。
但可以通过获取程序句柄，用windows API的 SENDKEY的方法操作。
方法一：
从HKEY_CLASSES_ROOT\\开始 这个方法根据应用程序所能打开的文档类型判断。
比如 WINWORD.EXE 关联了 *.DOC 文件， 那么打开 HKEY_CLASSES_ROOT\\ .DOC 键它默认值为Word.Document.8
Content Type： application/msword
注册表信息说明：DOC 为Word.Document.8对象 其应用程序为application 则 程序PROG-ID为Word.application
*.DOCX文件的默认值为Word.Document.12
Content Type： application/vnd.openxmlformats-officedocument.wordprocessingml.document
另外：有些程序的PROG-ID 在文档类型的 OpenWithProgids下面
如：.DMP文件 VisualStudio.dmp.8.0
|;