利用LISP程序把文字放到粘贴板里面(最终程序在二楼。常用CC/C1效果自己测试)
本帖最后由 zhb236623 于 2011-12-26 14:48 编辑借用了yucpp 的程序 http://bbs.mjtd.com/thread-85614-1-1.html
;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。
;;;=================================================================*
;;;功能：向系统剪贴板写入文字 *
(defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
(and (= (type STR) 'STR)
(setq HTML (vlax-create-object "htmlfile"))
(setq RESULT (vlax-invoke
(vlax-get (vlax-get HTML 'PARENTWINDOW)
'CLIPBOARDDATA
)
'SETDATA
"Text"
STR
)
)
(vlax-release-object HTML)
)
)
;;;=================================================================*
;;函数测试
(defun c:cc ()
(vl-load-com)
(setq ss (ssget '((0 . "*TEXT"))))
(setq i 0)
(setq last_stri_str "")
(repeat (sslength ss)
(setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
(setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq last_stri (vl-prin1-to-string txtcon_kuohao))
(setq last_stri_str (strcat last_stri_str last_stri))
(setq i (1+ i))
)
(setq last_stri_str (vl-string-translate "/" "-" last_stri_str))
(setq last_stri_str (vl-string-translate "\"" " " last_stri_str)) ;;只好把这句再加上，然后把单个引号替换成空格。
;;;好像不能替换为空。不知道各位有什么好办法。这样得出来的两个地号中间就有一个空格，
;;不过这样也不影响命名规则
(ZML-CLIP-SETSTRING last_stri_str)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
群主你的帖子最后得到的程序最终版本是哪个呢 本帖最后由 zhb236623 于 2011-12-26 14:49 编辑
修改完的程序。
;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。
;;;=================================================================*
;;;功能：向系统剪贴板写入文字 *
(defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
(and (= (type STR) 'STR)
(setq HTML (vlax-create-object "htmlfile"))
(setq RESULT (vlax-invoke
(vlax-get (vlax-get HTML 'PARENTWINDOW)
'CLIPBOARDDATA
)
'SETDATA
"Text"
STR
)
)
(vlax-release-object HTML)
)
)
;;;=================================================================*
;;函数测试
(defun c:cc ()
(vl-load-com)
(setq ss (ssget '((0 . "*TEXT"))))
(setq i 0)
(setq last_stri_str "")
(repeat (sslength ss)
(setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
(setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq last_stri (vl-prin1-to-string txtcon_kuohao))
(setq last_stri_str (strcat last_stri_str last_stri))
(setq i (1+ i))
)
(setq str0 (getvar "DwgName") ;"宗地图.dwg"
str0 (substr str0 1 )
) ;"宗地图"
(setq str1 (vl-string-translate "/" "-" last_stri_str))
(setq str2 (vl-string-translate "\"" " " str1))
(while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2))))) ;;加了这句就可以了。
(setq str0 (vl-string-subst "" ".dwg"str0)) 。
(setq str3 (strcat str0 str2))
(ZML-CLIP-SETSTRING str3)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
;;(while (> (strlen str) (strlen (setq str (vl-string-subst "" " " str)))))
(defun c:c1 ()
(vl-load-com)
(setq ss (ssget '((0 . "*TEXT"))))
(setq i 0)
(setq last_stri_str "")
(setq last_stri_hanzi "")
(repeat (sslength ss)
(setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
(if (> (ascii txtcon) 175)
(progn
(setq txtcon_hanzi txtcon)
(setq last_stri_hanzi (strcat last_stri_hanzitxtcon "、"))
)
(progn
(setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq last_stri (vl-prin1-to-string txtcon_kuohao))
(setq last_stri_str (strcat last_stri_str last_stri))
)
)
(setq i (1+ i))
)
(setq str1 (vl-string-translate "/" "-" last_stri_str))
(setq str2 (vl-string-translate "\"" " " str1))
(while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2))))) ;;加了这句就可以了。
(setq str3 (strcat last_stri_hanzi str2))
(ZML-CLIP-SETSTRING str3)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
(defun c:c2 ()
(vl-load-com)
(setq txtss (ssget '((0 . "*TEXT"))))
(while (> (sslength txtss) 1)
(alert "只能选择一个文字串，请重新选择！")
(setq txtss (ssadd))
(setq txtss (ssget '((0 . "*TEXT"))))
)
(setq txtcon (cdr (assoc 1 (entget (ssname txtss 0)))))
(setq ent_str_last (vl-string-translate "/" "-" txtcon))
(setq ent_str_last_kuahao (strcat "(" ent_str_last ")"))
(ZML-CLIP-SETSTRING ent_str_last_kuahao)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
);;end defun
Try
;; (setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq txtcon_kuohao txtcon) 本帖最后由 zhb236623 于 2011-12-5 15:54 编辑
Andyhon 发表于 2011-12-5 15:09 http://bbs.mjtd.com/static/image/common/back.gif
Try
;; (setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq txtcon_kuohao txtcon)
照现在这个程序复制出来的东东两个地号中间会有空格：(3-50-411-4)(3-50-411-2)(3-50-411-1)
即每个括号前或者后面都有一个空格。不过其实也不是很影响使用就是了。
这句应该不能去掉吧。我本来就是要在字符串3-50-411-4中加上括号 变成(3-50-411-4)
其实在程序中应该可以用read 去掉双引号。但是去掉就不是字符串，变成(3-50-411-4) 这样要用strcat函数好像就不能连接字符串了。
又试了把表加入选择集，最后再把选择集中各个表元素再变成一个表。但是还是没有成功。。。。求解。。谢谢。。
..选择集...
得就您的图纸作调试之用
请依该图纸(*.dwg) 加注您所要的正确结果 Andyhon 发表于 2011-12-5 16:15 static/image/common/back.gif
..选择集...
得就您的图纸作调试之用
请依该图纸(*.dwg) 加注您所要的正确结果
原本图纸为 宗地图.dwg
要变成 宗地图(3-50-411-1111)(3-50-411-1).dwg 这样子
我现在的程序就是会在括号前后有空格 宗地图 (3-50-411-1111)(3-50-411-1) .dwg 得到这样的结果。。。
(defun c:c1 ()
(vl-load-com)
(princ "\n字串一: ")
(setq e1 (ssget ":S:E" '((0 . "*TEXT"))))
(princ "\n字串二: ")
(setq e2 (ssget ":S:E" '((0 . "*TEXT"))))
(setq str0 (getvar "DwgName") ;"宗地图.dwg"
str0 (substr str0 1 6) ;"宗地图"
str1 (cdr (assoc 1(entget (ssname e1 0))))
str2 (cdr (assoc 1(entget (ssname e2 0))))
str1 (vl-string-translate "/" "-"str1)
str2 (vl-string-translate "/" "-"str2)
strs (strcat str0 "(" str1 ")(" str2 ")")
)
(princ "\n") (princ strs)(princ)
)
本帖最后由 zhb236623 于 2011-12-6 14:59 编辑
Andyhon 发表于 2011-12-5 17:39 http://bbs.mjtd.com/static/image/common/back.gif
(defun c:c1 ()
(vl-load-com)
(princ "\n字串一: ")
谢谢ANDYHON的指导。我的图纸可能也说得有问题，我只是列举了一种情况。地号可能有一行，可能有两行。没有说得很清楚 。。。从您的程序又学到不到。。。现在想问下个小问题。即替换。。。 ;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。
;;;=================================================================*
;;;功能：向系统剪贴板写入文字 *
(defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
(and (= (type STR) 'STR)
(setq HTML (vlax-create-object "htmlfile"))
(setq RESULT (vlax-invoke
(vlax-get (vlax-get HTML 'PARENTWINDOW)
'CLIPBOARDDATA
)
'SETDATA
"Text"
STR
)
)
(vlax-release-object HTML)
)
)
;;;=================================================================*
;;函数测试
(defun c:c2 ()
(vl-load-com)
(setq ss (ssget '((0 . "*TEXT"))))
(setq i 0)
(setq last_stri_str "")
(repeat (sslength ss)
(setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
(setq txtcon_kuohao (strcat "(" txtcon ")"))
(setq last_stri (vl-prin1-to-string txtcon_kuohao))
(setq last_stri_str (strcat last_stri_str last_stri))
(setq i (1+ i))
)
(setq str0 (getvar "DwgName") ;"宗地图.dwg" 这里图纸名称也不一定是这个，所以我改成这样
str0 (substr str0 1 )
) ;"宗地图"
(setq last_stri_str (vl-string-translate "/" "-" last_stri_str))
(setq last_stri_str (vl-string-translate "\"" " " last_stri_str));;这里为什么不能把 \替换成空呢。我现在只好替换成空格。。
(setq str0 (vl-string-subst "" ".dwg"str0)) ;;而这里又能把 .dwg 替换成空呢。
(setq last_stri_str (strcat str0 last_stri_str))
;(setq last_stri_str (vl-string-subst "" " "last_stri_str)) ;;;这句加进函数里面也不起作用。也不能替换空格成空。
(ZML-CLIP-SETSTRING last_stri_str)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
Andyhon 发表于 2011-12-5 17:39 static/image/common/back.gif
(defun c:c1 ()
(vl-load-com)
(princ "\n字串一: ")
其实现在的结果就是在命名的时候地号之间有两个空格，也不是很影响使用就是了。只是想弄明白为什么这个函数不能替换成空。。。。。
(defun c:c1 ()
(vl-load-com)
(princ "\n字串一: ")
(setq e1 (ssget ":S:E" '((0 . "*TEXT"))))
(princ "\n字串二: ")
(setq e2 (ssget ":S:E" '((0 . "*TEXT"))))
(setq str0 (getvar "DwgName") ;"宗地图.dwg"
str0 (substr str0 1 (- (strlen str0) 4)) ;"宗地图"
str1 (cdr (assoc 1(entget (ssname e1 0))))
str1 (vl-string-translate "/" "-"str1)
)
(if e2 ; 字串二
(setqstr2 (cdr (assoc 1(entget (ssname e2 0))))
str2 (vl-string-translate "/" "-"str2)
)
(setq str2 nil)
)
(if str2
(setq strs (strcat str0 "(" str1 ")(" str2 ")")
(setq strs (strcat str0 "(" str1 ")"))
)
(princ "\n") (princ strs)(princ)
)