【分享明经——发程序、拜新年专贴】

cnks

唉，多谢caoyin抬举，先留空位，有能拿出来的尽量咯

cnks

记得原来帮过别人改了一个“自动编号”的程序，自己感觉还算有点用，不过这种程序网络上太多：

功能：自动编号，可以加前缀、后缀，自定增加减少的序数（不关闭cad前提下可记忆前后缀）

 (defun c:bh (/ oce1 n1 zn h1 sxh1 p1)
(vl-load-com)
(setq oce1 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(if qz
()
(setq qz "")
)
(if hz
()
(setq hz "")
)
(initget "c")
(setq nqz (getstring (strcat "\n请输入前缀相同的部分<" qz ">/c(为空): " )))
(cond
((= nqz "c") (setq qz ""))
(T (if (/= nqz "")(setq qz nqz)))
)
(setq nhz (getstring (strcat "\n请输入后缀相同的部分<" hz ">/c(为空): " )))
(cond
((= nhz "c") (setq hz ""))
(T (if (/= nhz "")(setq hz nhz)))
)
(if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
(setq n1 1)
)
(if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
(setq zn 1)
)
(if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
(setq h1 2.5)
)
(setq sxh1 (strcat qz (xd-string_zeropad n1 3 "0" 0) hz))
(setq p1 (getpoint "\n请指定插入点: "))
(while (/= p1 nil)
(setq p1 (vlax-3d-point p1))
(setq txt (vla-addtext
ms
sxh1
p1
h1
)
)

(setq
n1 (+ n1 zn)
sxh1 (strcat qz (xd-string_zeropad n1 3 "0" 0) hz)
p1 (getpoint "\n请指定下一插入点: ")
)

)
(setvar "cmdecho" oce1)
(vlax-release-object ms)
(princ)
)


;; Form www.xdcad.net eachy 2005.9.21
;|
功 能 用指定字符首位补位格式化数字
参 数 intVal：要补位的数。;
Pad： 代表添加字符形成的数值的位数
sp 补位字符;
str 小数位数
示 例 (xd-stringZeroPad 123 4 "0" 0)
注 意 以上示例将返回“0123”。
_$ (XD-STRING_ZEROPAD 123 8 " " 2)
" 123.00"
_$ (XD-STRING_ZEROPAD 123 8 "A" 2)
"AA123.00"
|;
(defun xd-string_zeropad (intval pad sp str / zeros)
(setvar "dimzin" 0)
(strcat
(apply 'strcat
(repeat (- pad (strlen (rtos intval 2 str)))
(setq zeros (cons sp zeros)) ; make list
)
)
(rtos intval 2 str)
)
)

carrot1983

caoyin都这么说了，不发点东西，真不好意思。

来个经典的。今天重写。

;;;writenn by carrot1983 2008-12-06
(defun c:cd (/ e elist i newstring pt1 pt2)
  (command "._undo" "_begin")
  (princ "\n功能: 纯数字递增复制")
  (if (and (setq e (car (entsel "\n选择纯数字 <退出>: ")))
    (if (setq i (getint "\n输入增值 <1>: ")) t (setq i 1))
    (setq pt1 (getpoint "\n指定第一点 <退出>: "))
      )
    (while (setq pt2 (getpoint pt1 "\n下一点 <退出>: "))
      (setq elist (entget e))
      (setq newstring (itoa (+ (read (cdr (assoc 1 elist))) i))) ;_递增
      (entmake (subst (cons 1 newstring)
        (assoc 1 elist)
        elist
        )
      )
      (setq e (entlast))
      (command "._move" e "" "none" pt1 "none" pt2)
      (setq pt1 pt2)
    )
  )
  (command "._undo" "_end")
  (princ)
)

carrot1983

高手这么多，很多程序怕拿不出手。。。

程序就扔在这里啦：

http://carrot1983.ys168.com/ 

nonsmall

;;剪切板内容查看和设置

;;by nonsmall @ mjtd

(setq ob (vlax-create-object "htmlfile"))

;读取内容
(vba "ob.ParentWindow.ClipboardData.GetData(\"text\")"))

;设置内容为字符串123

(vba "ob.ParentWindow.ClipboardData.SetData(\"Text\",\"123\")")

===========================

VB原型:

Set obj = CreateObject("htmlfile")
ClipboardText=obj.ParentWindow.ClipboardData.GetData("text")
MsgBox ClipboardText

===========================

测试:

获取EXCEL复制一行的内容

命令: (setq ob (vlax-create-object "htmlfile"))
#<VLA-OBJECT DispHTMLDocument 06e0cac8>
命令: (vlax-variant-value (vba "ob.ParentWindow.ClipboardData.GetData(\"text\")"))
"1\t1\t1\t1\t1\t1\t1\t1\t1\r\n"

上面VBA函数原型http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72391

祥子

发布一个字符串转表的程式,写的不好，请大家批评指导.

新年也快要到了，先给大家拜早年了.

 

祝愿各位明经同仁天天快乐 ...

 

祝愿明经人气更上新台阶、旺、旺、旺...

HRQ28

衷心感谢

www.mjtd.com

这里是CAD知识的海洋，是中国工程的的CAD之家。

caoyin

感谢各位的支持

liminnet

俺的程序下载率好高呀，

狂刀无痕

最近工作比较忙，没怎么写程序了。发个以前的，没怎么测试。技巧和难度不大，但愿可以为大家节省点时间罢了

2. ;| xapp 生成activex实体--------by lxx.2008.3
3. 这是一个集成的生成activex实体的函数，不必再一个个去找了.
4. 测试:
5. (setq a (xapp "doc"))
6. (setq b (xapp "HTML"))
7. (setq b (xapp "MSG"))
8. (xapp (setq nam "WORD.DOC"))
9. (setq ps (xapp "PHOTOSHOP"))
10. (vlax-dump-object ps)
11. (vla-get-name (vla-get-ActiveDocument ps)) -> "aaa"
12. |;
13. (defun xapp (nam /); 全局变量: (*APPLST)
14.   (if (setq  obj (cdr(assoc (strcase nam) *applst)))
15.      (vlax-get-or-create-object obj)
16.   )
17. )
18. ;;;(vlax-get-or-create-object  ".NET Framework")
19. (setq *applst '(("REGEXP" . "VBScript.RegExp");; 正则表达式
20.   ("DBX" . "ObjectDBX.AxDbDocument") ;; CAD的activex接口
21.   ("SHELL" . "Shell.Application");; WINDOWS SHELL
22.   ;; vbs
23.   ("FSO" . "Scripting.FileSystemObject")
24.   ("SCR" . "ScriptControl")
25.   ("WSC.SH" . "wscript.shell")
26.   ("WSC.NET" . "wscript.Network")
27.   ;; xml,word,excell,acess,ie,html
28.   ("XML" . "Microsoft.XMLHTTP")
29.   ("XML.DOC" . "MSXML2.DOMDocument")
30.   ("EXCEL" . "Excel.Application")
31.   ("EXCEL.SHEET" . "Excel.Sheet")
32.   ("WORD" . "Word.application")
33.   ("WORD.DOC" . "Word.Document")
34.   ("ACESS" . "Access.Application")
35.   ("IE" . "Internetexplorer.application")
36.   ("HTML" . "htmlfile")
37.                 ;;
38.   ("PHOTOSHOP" . "PhotoShop.Application")
39.   ("WBEM" . "wbemScripting.SwbemLocator")
40.   ("ADO.CON" . "ADODB.Connection")
41.   ("ADO.STM" . "ADODB.Stream")
42.   ("ADO.REC" . "wADODB.Recordset")
43.   ("CAO" . "CAO.DbConnect")
44.   ;; ms app
45.   ("SAPI" . "Sapi.SpVoice")
46.                 ("AGENT" . "Agent.Control");;让默林来帮你说话
47.   ("COMDLG" . "mscomdlg.commondialog") ;; windows file select dialog
48.   ("MSN" . "MSNMessenger.MessengerApp") ;; msn
49.   ("WMP" . "WMPlayer.OCX");Windows Media Player:
50. 　　　　　　　　("PRN" . "WinPrint.WinPrintX");;WinPrint :
51.   ("MSG" . "Messenger.UIAutomation.1")
52.   ("D2" . "System.Drawing.Drawing2D")
53.         )
54. )
55. ;| ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝参考资料＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
56. (vlax-get-or-create-object prog-id)
57. 创建NOTEPAD对象实例。
58. 但可以通过获取程序句柄，用windows API的 SENDKEY的方法操作。
59. 方法一：
60. 从HKEY_CLASSES_ROOT\\开始 这个方法根据应用程序所能打开的文档类型判断。
61.    比如 WINWORD.EXE 关联了 *.DOC 文件， 那么打开 HKEY_CLASSES_ROOT\\ .DOC 键  它默认值为Word.Document.8
62. Content Type： application/msword
63. 注册表信息说明：DOC 为Word.Document.8对象 其应用程序为application 则 程序PROG-ID为Word.application
64. *.DOCX文件的默认值为Word.Document.12   
65. Content Type： application/vnd.openxmlformats-officedocument.wordprocessingml.document
66. 另外：有些程序的PROG-ID 在文档类型的 OpenWithProgids下面
67. 如：.DMP文件 VisualStudio.dmp.8.0
68. |;

;| 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 (setq  obj (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 |;