设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 利用LISP程序把文字放到粘贴板里面(最终程序在二楼。常 ...
123下一页
返回列表 发新帖
查看: 9369|回复: 26

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

  [复制链接]
zhb236623
发表于 2011-12-3 22:10:48 | 显示全部楼层 |阅读模式
本帖最后由 zhb236623 于 2011-12-26 14:48 编辑

借用了yucpp 的程序   http://bbs.mjtd.com/thread-85614-1-1.html




  3. ;;程序中的字符串哪里来的？我有个从cad中复制到剪切板的。
  4. ;;;=================================================================*
  5. ;;;功能：向系统剪贴板写入文字                                       *

  7. (defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
  8.   (and (= (type STR) 'STR)
  9.        (setq HTML (vlax-create-object "htmlfile"))
  10.        (setq RESULT (vlax-invoke
  11.                       (vlax-get        (vlax-get HTML 'PARENTWINDOW)
  12.                                 'CLIPBOARDDATA
  13.                       )
  14.                       'SETDATA
  15.                       "Text"
  16.                       STR
  17.                     )
  18.        )
  19.        (vlax-release-object HTML)
  20.   )
  21. )
  22. ;;;=================================================================*
  23. ;;函数测试
  24. (defun c:cc ()
  25. (vl-load-com)
  26.   (setq ss (ssget '((0 . "*TEXT"))))
  27.   (setq i 0)
  28.   (setq last_stri_str "")
  29.   (repeat (sslength ss)

  31.   (setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))

  33.   (setq txtcon_kuohao (strcat "(" txtcon ")"))


  36.   (setq last_stri   (vl-prin1-to-string txtcon_kuohao))

  38.   (setq last_stri_str (strcat last_stri_str last_stri))
  39. (setq i (1+ i))
  40. )

  42.   (setq last_stri_str (vl-string-translate "/" "-" last_stri_str))
  43. (setq last_stri_str (vl-string-translate """ " " last_stri_str))    ;;只好把这句再加上，然后把单个引号替换成空格。
  44. ;;;好像不能替换为空。不知道各位有什么好办法。这样得出来的两个地号中间就有一个空格，
  45. ;;不过这样也不影响命名规则

  47.   (ZML-CLIP-SETSTRING last_stri_str)
  48.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
  49.   (princ)
  50. )







cad, 剪切板, 剪贴板, 字符串, 程序

本帖被以下淘专辑推荐:

相关帖子
回复

使用道具 举报

664571221
发表于 2021-12-5 14:32:20 | 显示全部楼层
群主你的帖子最后得到的程序最终版本是哪个呢
回复 支持 反对

使用道具 举报

zhb236623
 楼主| 发表于 2011-12-5 14:33:19 | 显示全部楼层
本帖最后由 zhb236623 于 2011-12-26 14:49 编辑

修改完的程序。


  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:cc ()
  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.   (setq last_stri   (vl-prin1-to-string txtcon_kuohao))
  31.   (setq last_stri_str (strcat last_stri_str last_stri))
  32. (setq i (1+ i))
  33. )
  34. (setq str0 (getvar "DwgName")       ;"宗地图.dwg"
  35.         str0 (substr str0 1 )
  36. )       ;"宗地图"

  38.   (setq str1 (vl-string-translate "/" "-" last_stri_str))
  39.   (setq str2 (vl-string-translate "\"" " " str1))

  41. (while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2)))))    ;;加了这句就可以了。
  42. (setq str0 (vl-string-subst "" ".dwg"  str0))   。
  43. (setq str3 (strcat str0 str2))
  44.   (ZML-CLIP-SETSTRING str3)
  45.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
  46.   (princ)
  47. )

  49. ;;(while (> (strlen str) (strlen (setq str (vl-string-subst "" " " str)))))
  50. (defun c:c1 ()
  51. (vl-load-com)
  52.   (setq ss (ssget '((0 . "*TEXT"))))
  53.   (setq i 0)
  54.   (setq last_stri_str "")
  55.   (setq last_stri_hanzi "")
  56.   (repeat (sslength ss)
  57.   (setq txtcon (cdr (assoc 1 (entget (ssname ss i)))))
  58.   (if (> (ascii txtcon) 175)
  59.    
  60.     (progn
  61.   (setq txtcon_hanzi txtcon)
  62.     (setq last_stri_hanzi (strcat last_stri_hanzi  txtcon "、"))  
  63.    )
  64.   (progn
  65.    (setq txtcon_kuohao (strcat "(" txtcon ")"))
  66.     (setq last_stri   (vl-prin1-to-string txtcon_kuohao))
  67.     (setq last_stri_str (strcat last_stri_str last_stri))  
  68.   
  69.   )
  70. )
  71. (setq i (1+ i))
  72. )
  73.   (setq str1 (vl-string-translate "/" "-" last_stri_str))
  74.   (setq str2 (vl-string-translate "\"" " " str1))
  75. (while (> (strlen str2) (strlen (setq str2 (vl-string-subst "" " " str2)))))    ;;加了这句就可以了。
  76.   (setq str3 (strcat last_stri_hanzi str2))
  77.   (ZML-CLIP-SETSTRING str3)
  78.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
  79.   (princ)
  80. )


  83. (defun c:c2 ()
  84. (vl-load-com)
  85.   (setq txtss (ssget '((0 . "*TEXT"))))
  86.   (while (> (sslength txtss) 1)
  87.     (alert "只能选择一个文字串，请重新选择！")
  88.     (setq txtss (ssadd))
  89.     (setq txtss (ssget '((0 . "*TEXT"))))
  90.   )
  91.   (setq txtcon (cdr (assoc 1 (entget (ssname txtss 0)))))
  92.   (setq ent_str_last (vl-string-translate "/" "-" txtcon))
  93.   (setq ent_str_last_kuahao (strcat "(" ent_str_last ")"))
  94.   (ZML-CLIP-SETSTRING ent_str_last_kuahao)
  95.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
  96.   (princ)
  97. )  ;;end defun



本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

Andyhon
发表于 2011-12-5 15:09:08 | 显示全部楼层
Try
;; (setq txtcon_kuohao (strcat "(" txtcon ")"))
  (setq txtcon_kuohao txtcon)
回复 支持 反对

使用道具 举报

zhb236623
 楼主| 发表于 2011-12-5 15:46:18 | 显示全部楼层
本帖最后由 zhb236623 于 2011-12-5 15:54 编辑
Andyhon 发表于 2011-12-5 15:09
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函数好像就不能连接字符串了。

又试了把表加入选择集，最后再把选择集中各个表元素再变成一个表。但是还是没有成功。。。。求解。。谢谢。。

回复 支持 反对

使用道具 举报

Andyhon
发表于 2011-12-5 16:15:27 | 显示全部楼层
..选择集...
得就您的图纸作调试之用
请依该图纸(*.dwg) 加注您所要的正确结果
回复 支持 反对

使用道具 举报

zhb236623
 楼主| 发表于 2011-12-5 17:15:46 | 显示全部楼层
Andyhon 发表于 2011-12-5 16:15
..选择集...
得就您的图纸作调试之用
请依该图纸(*.dwg) 加注您所要的正确结果

原本图纸为   宗地图.dwg

要变成   宗地图(3-50-411-1111)(3-50-411-1).dwg   这样子

我现在的程序就是会在括号前后有空格   宗地图 (3-50-411-1111)  (3-50-411-1) .dwg   得到这样的结果。。。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

Andyhon
发表于 2011-12-5 17:39:42 | 显示全部楼层
(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:56:14 | 显示全部楼层
本帖最后由 zhb236623 于 2011-12-6 14:59 编辑
Andyhon 发表于 2011-12-5 17:39
(defun c:c1 ()
  (vl-load-com)
  (princ "\n字串一: ")


谢谢ANDYHON的指导。我的图纸可能也说得有问题，我只是列举了一种情况。地号可能有一行，可能有两行。没有说得很清楚 。。。从您的程序又学到不到。。。现在想问下个小问题。即替换。。。
  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:c2 ()
  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 ")"))

  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. )

  36. (setq str0 (getvar "DwgName")       ;"宗地图.dwg" 这里图纸名称也不一定是这个，所以我改成这样
  37.         str0 (substr str0 1 )
  38. )       ;"宗地图"


  41.   (setq last_stri_str (vl-string-translate "/" "-" last_stri_str))
  42. (setq last_stri_str (vl-string-translate """ " " last_stri_str));;这里为什么不能把 \  替换成空呢。我现在只好替换成空格。。
  43. (setq str0 (vl-string-subst "" ".dwg"  str0))   ;;而这里又能把 .dwg 替换成空呢。
  44. (setq last_stri_str (strcat str0 last_stri_str))
  45. ;(setq last_stri_str (vl-string-subst "" " "  last_stri_str))    ;;;这句加进函数里面也不起作用。也不能替换空格成空。
  46.   (ZML-CLIP-SETSTRING last_stri_str)
  47.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
  48.   (princ)
  49. )


回复 支持 反对

使用道具 举报

zhb236623
 楼主| 发表于 2011-12-6 15:05:00 | 显示全部楼层
Andyhon 发表于 2011-12-5 17:39
(defun c:c1 ()
  (vl-load-com)
  (princ "\n字串一: ")

其实现在的结果就是在命名的时候地号之间有两个空格，也不是很影响使用就是了。只是想弄明白为什么这个函数不能替换成空。。。。。
回复 支持 反对

使用道具 举报

Andyhon
发表于 2011-12-6 15:15:28 | 显示全部楼层

  3. (defun c:c1 ()
  4.   (vl-load-com)
  5.   (princ "\n字串一: ")
  6.   (setq e1 (ssget ":S:E" '((0 . "*TEXT"))))
  7.   (princ "\n字串二: ")
  8.   (setq e2 (ssget ":S:E" '((0 . "*TEXT"))))
  9.   (setq str0 (getvar "DwgName")       ;"宗地图.dwg"
  10.         str0 (substr str0 1 (- (strlen str0) 4))          ;"宗地图"
  11.         str1 (cdr (assoc 1  (entget (ssname e1 0))))
  12.         str1 (vl-string-translate "/" "-"  str1)
  13.   )
  14.   (if e2          ; 字串二
  15.     (setq  str2 (cdr (assoc 1  (entget (ssname e2 0))))
  16.            str2 (vl-string-translate "/" "-"  str2)
  17.     )
  18.     (setq str2 nil)
  19.   )
  20.   (if str2
  21.     (setq strs (strcat str0 "(" str1 ")(" str2 ")")
  22.     (setq strs (strcat str0 "(" str1 ")"))
  23.   )
  24.   (princ "\n") (princ strs)(princ)
  25. )
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-15 06:55 , Processed in 0.212392 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表