利用LISP程序把文字放到粘贴板里面(最终程序在二楼。常用CC/C1效果自己测试)

zhb236623

Andyhon 发表于 2011-12-6 15:15

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=31776

看了这篇，问题解决。等会上传结果。。。谢谢ANDYHON关注。。。

zhb236623

Andyhon 发表于 2011-12-5 17:39
(defun c:c1 ()
  (vl-load-com)
  (princ "\n字串一: ")

2. ;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。
   
3. ;;;=================================================================*
   
4. ;;;功能：向系统剪贴板写入文字                                       *
   
5. (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
   
6.   (and (= (type STR) 'STR)
   
7.        (setq HTML (vlax-create-object "htmlfile"))
   
8.        (setq RESULT (vlax-invoke
   
9.                       (vlax-get        (vlax-get HTML 'PARENTWINDOW)
   
10.                                 'CLIPBOARDDATA
    
11.                       )
    
12.                       'SETDATA
    
13.                       "Text"
    
14.                       STR
    
15.                     )
    
16.        )
    
17.        (vlax-release-object HTML)
    
18.   )
    
19. )
    
20. ;;;=================================================================*
    
21. ;;函数测试
    
22. (defun c:c3 ()
    
23. (vl-load-com)
    
24.   (setq ss (ssget '((0 . "*TEXT"))))
    
25.   (setq i 0)
    
26.   (setq last_stri_str "")
    
27.   (repeat (sslength ss)
    
28.   (setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
    
29.   (setq txtcon_kuohao (strcat "(" txtcon ")"))
    
30. 
    
31.   (setq last_stri   (vl-prin1-to-string txtcon_kuohao))
    
32.   (setq last_stri_str (strcat last_stri_str last_stri))
    
33. (setq i (1+ i))
    
34. )
    
35. 
    
36. (setq str0 (getvar "DwgName")       ;"宗地图.dwg"
    
37.         str0 (substr str0 1 )
    
38. )       ;"宗地图"
    
39. 
    
40. 
    
41.   (setq str1 (vl-string-translate "/" "-" last_stri_str))
    
42.   (setq str2 (vl-string-translate """ " " str1))
    
43.   
    
44.   (while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2)))))    ;;加了这句就可以了。
    
45. 
    
46. (setq str0 (vl-string-subst "" ".dwg"  str0))   。
    
47. (setq str3 (strcat str0 str2))
    
48. 
    
49.   (ZML-CLIP-SETSTRING str3)
    
50.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
    
51.   (princ)
    
52. )
    
53. 
    
54. 
    
55. ;;(while (> (strlen str) (strlen (setq str (vl-string-subst "" " " str)))))
    
56. 
    

;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。<br /> ;;;=================================================================*<br /> ;;;功能：向系统剪贴板写入文字                                       *<br /> (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)<br />   (and (= (type STR) 'STR)<br />        (setq HTML (vlax-create-object "htmlfile"))<br />        (setq RESULT (vlax-invoke<br />                       (vlax-get        (vlax-get HTML 'PARENTWINDOW)<br />                                 'CLIPBOARDDATA<br />                       )<br />                       'SETDATA<br />                       "Text"<br />                       STR<br />                     )<br />        )<br />        (vlax-release-object HTML)<br />   )<br /> )<br /> ;;;=================================================================*<br /> ;;函数测试<br /> (defun c:c3 ()<br /> (vl-load-com)<br />   (setq ss (ssget '((0 . "*TEXT"))))<br />   (setq i 0)<br />   (setq last_stri_str "")<br />   (repeat (sslength ss)<br />   (setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))<br />   (setq txtcon_kuohao (strcat "(" txtcon ")"))<br /> <br />   (setq last_stri   (vl-prin1-to-string txtcon_kuohao))<br />   (setq last_stri_str (strcat last_stri_str last_stri))<br /> (setq i (1+ i))<br /> )<br /> <br /> (setq str0 (getvar "DwgName")       ;"宗地图.dwg" <br />         str0 (substr str0 1 ) <br /> )       ;"宗地图"<br /> <br /> <br />   (setq str1 (vl-string-translate "/" "-" last_stri_str))<br />   (setq str2 (vl-string-translate """ " " str1))<br />   <br />   (while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2)))))    ;;加了这句就可以了。<br /> <br /> (setq str0 (vl-string-subst "" ".dwg"  str0))   。 <br /> (setq str3 (strcat str0 str2))<br /> <br />   (ZML-CLIP-SETSTRING str3)<br />   (princ "\n文字已复制到剪切板,可以直接粘贴了！")<br />   (princ)<br /> )<br /> <br /> <br /> ;;(while (> (strlen str) (strlen (setq str (vl-string-subst "" " " str)))))<br /> <br />

zhb236623

Andyhon 发表于 2011-12-5 17:39
(defun c:c1 ()
  (vl-load-com)
  (princ "\n字串一: ")

ANDYHON我这个不管地号有几行，都可以直接全选，不用选再次，程序可以达到要求。。

zhb236623

Andyhon 发表于 2011-12-5 17:39
(defun c:c1 ()
  (vl-load-com)
  (princ "\n字串一: ")

楼主的比较精简，不过我的程序能够达到自己的要求，用起来比较顺手。。。。还是要感谢您的指点。。。

Andyhon

...不管地号有几行，都可以直接全选...
没有先后次序的问题?

zhb236623

Andyhon 发表于 2011-12-6 15:15

str0 (substr str0 1 (- (strlen str0) 4))  楼主这句也有点问题，有时候电脑设置成没有后缀（没有扩展名），这样就错了。

还是有的我说的不够 详细。。。。

Andyhon

...没有后缀...

只要能掌握运用函数,都可以给自己量身订制所需的程序底
程序通常都是依使用后所遇到的状况逐步补强滴
也惟有自己最清楚所能掌控的资讯.....

zhb236623

Andyhon 发表于 2011-12-6 15:41
...没有后缀...

只要能掌握运用函数,都可以给自己量身订制所需的程序底

说的极是。。。就是没有后缀名   .dwg  的时候。。。

zhb236623

Andyhon 发表于 2011-12-6 15:31
...不管地号有几行，都可以直接全选...
没有先后次序的问题?

恩，是的，不需要先后，只是加上新老地号到时候找图纸方便。


新地号全部比老地号长，所以如果要先后顺序的话只要加个长度判断，然后就可以了。

another2121

zhb236623 发表于 2011-12-5 14:33
修改完的程序。

非常好。。。很强大。。。。