（完成）[编程申请]：求将WORD等字处理软件里面的文字粘贴到ACAD里面的程序...

marting · 发表于 2002-8-3 17:37:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

用了前几天晓东写的把ACAD里面的文字拷贝到剪切板的程序，很方便，谢谢晓东。

提个申请，把WORD里面的文字先拷贝的剪切板，然后在ACAD里面，把剪切板里面的文字用TEXT给写到ACAD里面的程序，要求可以判断换行，指定字高等等。

eachy · 发表于 2002-8-3 19:27:27

;|
命令：txt2clip

功能：该程序可以把ACAD的字符(text)实体拷贝到剪切板上，一行一个字符串。

命令：clip2txt

功能：该程序可以把剪切板上的字符拷贝到ACAD(text)实体，和原行字符一致。

程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
      LISP目录，自己加入到菜单里面就可以非常方便的使用了。
      关于程序的建议请到“晓东CAD空间-编程申请”论坛
      http://www.xdcad.net/forum留言
|;

XDSoft · 发表于 2002-8-3 19:52:08

最初由 marting 发布
[B]用了前几天晓东写的把ACAD里面的文字拷贝到剪切板的程序，很方便，谢谢晓东。

提个申请，把WORD里面的文字先拷贝的剪切板，然后在ACAD里面，把剪切板里面的文字用TEXT给写到ACAD里面的程序，要求可以判断换行，指... [/B]

;|
命令：txt_getclip

功能：读入系统剪切板中的文字写到ACAD中，方便大家在WORD等字处理软件写好文字排好版后写入ACAD

说明：1、程序可以处理多行文本、可以控制行距、字高、是否保留文字前面的空格
      2、程序可以判断字处理软件中的回车换行符，多个空行处理后只保留一个换行
      3、任何时候文字后面的空格都去除掉。
      4、程序使用当前的字型设置写文字，所以请朋友用本程序前设置好字型。
      5、文字以0度方向写

      程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
      LISP目录，自己加入到菜单里面就可以非常方便的使用了。
      关于程序的建议请到“晓东CAD空间-编程申请”论坛
      http://www.xdcad.net/forum留言
|;

[FONT=courier new]
(defun c:txt_getclip (/ txt tf pt thigh tintv box n)
(if (not $txt_clip_thigh)
(setq $txt_clip_thigh 600)
)
(if (not $txt_clip_intv)
(setq $txt_clip_intv 5)
)
(if (not $txt_clip_prefix)
(setq $txt_clip_prefix t)
)
(if (setq txt (xdrx_getclipboard))
(progn
(setq tf t)
(while tf
(prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2)
" | 行距系数:" (itoa $txt_clip_intv) " | "
(if $txt_clip_prefix
"保留前导空格"
"去除前导空格"
) " }"
)
)
(initget 128 "High Intv Space")
(setq pt (getpoint "\n请点取文字的插入点[字高:High / 行距系数:Intv / 前导空格:Space]<退出>:"))
(cond
((= (type pt) 'LIST)
(setq tf nil)
)
((= pt "High")
(if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh
2 2
) ">:"
)
)
)
(setq $txt_clip_thigh thigh)
)
)
((= pt "Intv")
(initget 2)
(if (setq tintv (getint (strcat "\n请输入行距系数(相对字高的几分之几)<"
(itoa $txt_clip_intv) ">:"
)
)
)
(setq $txt_clip_intv tintv)
)
)
((= pt "Space")
(if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1)))
(setq $txt_clip_prefix t)
(setq $txt_clip_prefix nil)
)
)
((= (type pt) 'STR))
(t
(exit)
)
)
)
(setq txt (xdrx_string_tok txt "\r\n"))
(foreach n txt
(setq n (xdrx_string_trimright n))
(if (not $txt_clip_prefix)
(setq n (xdrx_string_TrimLeft n))
)
(command "._text" pt $txt_clip_thigh "" n)
(setq box (xdrx_entity_box (entlast))
pt (mapcar
'-
(mapcar
'+
(mapcar
'-
(car box)
(last box)
)
pt
)
(list 0.0 (/ $txt_clip_thigh $txt_clip_intv) 0.0)
)
)
)
)
)
(prompt "\n当前系统剪切板没有数据或者非可识别格式！")
(princ)
)
[/FONT]

[FONT=courier new] 
(defun c:txt_getclip (/ txt tf pt thigh tintv box n) 
  (if (not $txt_clip_thigh) 
    (setq $txt_clip_thigh 600) 
  ) 
  (if (not $txt_clip_intv) 
    (setq $txt_clip_intv 5) 
  ) 
  (if (not $txt_clip_prefix) 
    (setq $txt_clip_prefix t) 
  ) 
  (if (setq txt (xdrx_getclipboard)) 
    (progn 
      (setq tf t) 
      (while tf 
        (prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2) 
                        " | 行距系数:" (itoa $txt_clip_intv) " | " 
                        (if $txt_clip_prefix 
                          "保留前导空格" 
                          "去除前导空格" 
                        ) " }" 
                ) 
        ) 
        (initget 128 "High Intv Space") 
        (setq pt (getpoint "\n请点取文字的插入点[字高:High / 行距系数:Intv / 前导空格:Space]<退出>:")) 
 
        (cond 
          ((= (type pt) 'LIST) 
            (setq tf nil) 
          ) 
          ((= pt "High") 
            (if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh 
                                                                   2 2 
                                                             ) ">:" 
                                     ) 
                            ) 
                ) 
              (setq $txt_clip_thigh thigh) 
            ) 
          ) 
          ((= pt "Intv") 
            (initget 2) 
            (if (setq tintv (getint (strcat "\n请输入行距系数(相对字高的几分之几)<" 
                                            (itoa $txt_clip_intv) ">:" 
                                    ) 
                            ) 
                ) 
              (setq $txt_clip_intv tintv) 
            ) 
          ) 
          ((= pt "Space") 
            (if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1))) 
              (setq $txt_clip_prefix t) 
              (setq $txt_clip_prefix nil) 
            ) 
          ) 
          ((= (type pt) 'STR)) 
          (t 
            (exit) 
          ) 
        ) 
      ) 
      (setq txt (xdrx_string_tok txt "\r\n")) 
      (foreach n txt 
        (setq n (xdrx_string_trimright n)) 
        (if (not $txt_clip_prefix) 
          (setq n (xdrx_string_TrimLeft n)) 
        ) 
        (command "._text" pt $txt_clip_thigh "" n) 
        (setq box (xdrx_entity_box (entlast)) 
              pt (mapcar 
                   '- 
                   (mapcar 
                     '+ 
                     (mapcar 
                       '- 
                       (car box) 
                       (last box) 
                     ) 
                     pt 
                   ) 
                   (list 0.0 (/ $txt_clip_thigh $txt_clip_intv) 0.0) 
                 ) 
        ) 
      ) 
    ) 
  ) 
  (prompt "\n当前系统剪切板没有数据或者非可识别格式！") 
  (princ) 
) 
[/FONT]

John · 发表于 2003-1-21 13:55:12

晓东，谢谢你的工具箱
它解决了很多我们实际使用中的问题
提供了很多方便

但还有个小小的问题
使用读剪贴板功能的时候
要精确控制行距几乎是不可能的，看起来用到了textbox的尺寸，这不是一个直观的数据
指定字高可以但指定两行文字插入点间距就不得齐门而入了，所以只好把你这部分的程序作了一点小小的改动，因为是自己用的，所以直接就用您原来的程序改了，在指定间距时输入的值将直接作为插入点间距，这样在写入到固定格式的材料表中时方便一点。
我的修改后的lsp贴在下面，可能不入法眼吧，不过也许有人用得着。

在此也提一个小小的请求，希望下一版修订的时候，能在读剪贴板功能中除了指定行距系数外，能够加入直接指定行距的选项，不胜感激 :)

[FONT=courier new]
(defun c:txt_getclip (/ txt tf pt thigh tintv box n)
(if (not $txt_clip_thigh)
(setq $txt_clip_thigh 600)
)
(if (not $txt_clip_intv)
(setq $txt_clip_intv 5)
)
(if (not $txt_clip_prefix)
(setq $txt_clip_prefix t)
)
(if (setq txt (xdrx_getclipboard))
(progn
(setq tf t)
(while tf
(prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2)
" | 行距系数:" (itoa $txt_clip_intv) " | "
(if $txt_clip_prefix
"保留前导空格"
"去除前导空格"
) " }"
)
)
(initget 128 "High Intv Space")
(setq pt (getpoint "\n请点取文字的插入点[字高:High / 行距系数:Intv / 前导空格:Space]<退出>:"))
(cond
((= (type pt) 'LIST)
(setq tf nil)
)
((= pt "High")
(if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh
2 2
) ">:"
)
)
)
(setq $txt_clip_thigh thigh)
)
)
((= pt "Intv")
(initget 2)
(if (setq tintv (getint (strcat "\n请输入行距系数(相对字高的几分之几)<"
(itoa $txt_clip_intv) ">:"
)
)
)
(setq $txt_clip_intv tintv)
)
)
((= pt "Space")
(if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1)))
(setq $txt_clip_prefix t)
(setq $txt_clip_prefix nil)
)
)
((= (type pt) 'STR))
(t
(exit)
)
)
)
(setq txt (xdrx_string_tok txt "\r\n"))
(foreach n txt
(setq n (xdrx_string_trimright n))
(if (not $txt_clip_prefix)
(setq n (xdrx_string_TrimLeft n))
)
(command "._text" pt $txt_clip_thigh "" n)
(setq pt (mapcar
'-
pt
(list 0.0 (* 1.0 $txt_clip_intv) 0.0)
)
)
)
)
(prompt "\n当前系统剪切板没有数据或者非可识别格式！")
)
(princ)
)
[/FONT]

[FONT=courier new] 
(defun c:txt_getclip (/ txt tf pt thigh tintv box n) 
  (if (not $txt_clip_thigh) 
    (setq $txt_clip_thigh 600) 
  ) 
  (if (not $txt_clip_intv) 
    (setq $txt_clip_intv 5) 
  ) 
  (if (not $txt_clip_prefix) 
    (setq $txt_clip_prefix t) 
  ) 
  (if (setq txt (xdrx_getclipboard)) 
    (progn 
      (setq tf t) 
      (while tf 
        (prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2) 
                        " | 行距系数:" (itoa $txt_clip_intv) " | " 
                        (if $txt_clip_prefix 
                          "保留前导空格" 
                          "去除前导空格" 
                        ) " }" 
                ) 
        ) 
        (initget 128 "High Intv Space") 
        (setq pt (getpoint "\n请点取文字的插入点[字高:High / 行距系数:Intv / 前导空格:Space]<退出>:")) 
 
        (cond 
          ((= (type pt) 'LIST) 
            (setq tf nil) 
          ) 
          ((= pt "High") 
            (if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh 
                                                                   2 2 
                                                             ) ">:" 
                                     ) 
                            ) 
                ) 
              (setq $txt_clip_thigh thigh) 
            ) 
          ) 
          ((= pt "Intv") 
            (initget 2) 
            (if (setq tintv (getint (strcat "\n请输入行距系数(相对字高的几分之几)<" 
                                            (itoa $txt_clip_intv) ">:" 
                                    ) 
                            ) 
                ) 
              (setq $txt_clip_intv tintv) 
            ) 
          ) 
          ((= pt "Space") 
            (if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1))) 
              (setq $txt_clip_prefix t) 
              (setq $txt_clip_prefix nil) 
            ) 
          ) 
          ((= (type pt) 'STR)) 
          (t 
            (exit) 
          ) 
        ) 
      ) 
      (setq txt (xdrx_string_tok txt "\r\n")) 
      (foreach n txt 
        (setq n (xdrx_string_trimright n)) 
        (if (not $txt_clip_prefix) 
          (setq n (xdrx_string_TrimLeft n)) 
        ) 
        (command "._text" pt $txt_clip_thigh "" n) 
         (setq pt (mapcar 
                   '- 
                     pt 
                   (list 0.0 (* 1.0 $txt_clip_intv) 0.0) 
                 ) 
        ) 
      ) 
    ) 
    (prompt "\n当前系统剪切板没有数据或者非可识别格式！") 
  ) 
  (princ) 
) 
 
  [/FONT]

coving · 发表于 2003-1-25 21:48:03

很好用，我以前都用asctext.lsp，现在用这个方便多了，可以象在草稿纸上随写随输入cad。
楼上的John改输入行间距，不错！
但是中文提示都没有改，我改了过来，并试运行通过，代码如下：

<normalfont>
(defun c:txt_getclip (/ txt tf pt thigh tintv box n)
(if (not $txt_clip_thigh)
(setq $txt_clip_thigh 400)
)
(if (not $txt_clip_intv)
(setq $txt_clip_intv 700)
)
(if (not $txt_clip_prefix)
(setq $txt_clip_prefix t)
)
(if (setq txt (xdrx_getclipboard))
(progn
(setq tf t)
(while tf
(prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2)
" | 行间距:" (itoa $txt_clip_intv) " | "
(if $txt_clip_prefix
"保留前导空格"
"去除前导空格"
) " }"
)
)
(initget 128 "High Intv Space")
(setq pt (getpoint "\n请点取文字的插入点[字高:High / 行间距:Intv / 前导空格:Space]<退出>:"))
(cond
((= (type pt) 'LIST)
(setq tf nil)
)
((= pt "High")
(if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh
2 2
) ">:"
)
)
)
(setq $txt_clip_thigh thigh)
)
)
((= pt "Intv")
(initget 2)
(if (setq tintv (getint (strcat "\n请输入行间距<"
(itoa $txt_clip_intv) ">:"
)
)
)
(setq $txt_clip_intv tintv)
)
)
((= pt "Space")
(if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1)))
(setq $txt_clip_prefix t)
(setq $txt_clip_prefix nil)
)
)
((= (type pt) 'STR))
(t
(exit)
)
)
)
(setq txt (xdrx_string_tok txt "\r\n"))
(foreach n txt
(setq n (xdrx_string_trimright n))
(if (not $txt_clip_prefix)
(setq n (xdrx_string_TrimLeft n))
)
(command "._text" pt $txt_clip_thigh "" n)
(setq pt (mapcar
'-
pt
(list 0.0 (* 1.0 $txt_clip_intv) 0.0)
)
)
)
)
(prompt "\n当前系统剪切板没有数据或者非可识别格式！")
)
(princ)
)

<normalfont> 
(defun c:txt_getclip (/ txt tf pt thigh tintv box n) 
  (if (not $txt_clip_thigh) 
    (setq $txt_clip_thigh 400) 
  ) 
  (if (not $txt_clip_intv) 
    (setq $txt_clip_intv 700) 
  ) 
  (if (not $txt_clip_prefix) 
    (setq $txt_clip_prefix t) 
  ) 
  (if (setq txt (xdrx_getclipboard)) 
    (progn 
      (setq tf t) 
      (while tf 
        (prompt (strcat "\n{当前字高:" (rtos $txt_clip_thigh 2 2) 
                        " | 行间距:" (itoa $txt_clip_intv) " | " 
                        (if $txt_clip_prefix 
                          "保留前导空格" 
                          "去除前导空格" 
                        ) " }" 
                ) 
        ) 
        (initget 128 "High Intv Space") 
        (setq pt (getpoint "\n请点取文字的插入点[字高:High / 行间距:Intv / 前导空格:Space]<退出>:")) 
 
        (cond 
          ((= (type pt) 'LIST) 
            (setq tf nil) 
          ) 
          ((= pt "High") 
            (if (setq thigh (getreal (strcat "\n请输入字高<" (rtos $txt_clip_thigh 
                                                                   2 2 
                                                             ) ">:" 
                                     ) 
                            ) 
                ) 
              (setq $txt_clip_thigh thigh) 
            ) 
          ) 
          ((= pt "Intv") 
            (initget 2) 
            (if (setq tintv (getint (strcat "\n请输入行间距<" 
                                            (itoa $txt_clip_intv) ">:" 
                                    ) 
                            ) 
                ) 
              (setq $txt_clip_intv tintv) 
            ) 
          ) 
          ((= pt "Space") 
            (if (= 1 (setq tspace (xdrx_yesorno "\n是否保留前导空格" 1))) 
              (setq $txt_clip_prefix t) 
              (setq $txt_clip_prefix nil) 
            ) 
          ) 
          ((= (type pt) 'STR)) 
          (t 
            (exit) 
          ) 
        ) 
      ) 
      (setq txt (xdrx_string_tok txt "\r\n")) 
      (foreach n txt 
        (setq n (xdrx_string_trimright n)) 
        (if (not $txt_clip_prefix) 
          (setq n (xdrx_string_TrimLeft n)) 
        ) 
        (command "._text" pt $txt_clip_thigh "" n) 
         (setq pt (mapcar 
                   '- 
                     pt 
                   (list 0.0 (* 1.0 $txt_clip_intv) 0.0) 
                 ) 
        ) 
      ) 
    ) 
    (prompt "\n当前系统剪切板没有数据或者非可识别格式！") 
  ) 
  (princ) 
)

xiaoyanyan · 发表于 2003-12-27 22:05:50

众人拾柴火焰高，我也来添点力！
将文本文件中的文字插入AutoCAD图形中。
;read text from file
(defun C:RTXT ()
(setq oldvalue (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq name (getstring "\n输入文本文件名:"))
(setq sp (getpoint "\n输入插入图形中的起点:"))
(setq ts (getdist sp "\n输入字符高:"))
(setq a (* 180. (/ (getangle sp "\nRotation 输入字符串角度:") pi)))
(setq txt (open name "r"))
(setq dt (read-line txt))
;; (setq lns (getdist sp "\nEnter line spacing in drawing units:"))
(setq lns (* 1.333333 ts))
(setq ls (rtos lns 2 2))
(setq b (rtos (+ -90. a) 2 2))
(setq ls (strcat "@" ls "<" b))
(command "text" sp ts a dt)
(while (/= dt nil)
 (setq dt (read-line txt))
 (command "text" ls ts a dt)
)
(close txt)
(command "redraw")
(setvar "CMDECHO" oldvalue)

vvss · 发表于 2003-12-29 11:03:36

小弟汗颜

wqfcf · 发表于 2004-2-6 16:08:53

需要那么复杂吗？
在CAD中线“选择性粘贴”，在弹出的对话框中选择“autocad图元”即可.
该操作还可以将EXCEL表格拷贝到CAD中！！！

zwx123 · 发表于 2004-2-9 09:30:42

怎样修改一下，直接应用LSP程序文件，不需要加载入晓东工具箱呢？

xxxddd · 发表于 2004-2-9 10:19:07

最初由 zwx123 发布
[B]怎样修改一下，直接应用LSP程序文件，不需要加载入晓东工具箱呢？ [/B]

我安不了晓东工具箱，同楼上建议一样，哪位高手再改改？谢谢！

账号		自动登录	找回密码
密码			立即注册

（完成）[编程申请]：求将WORD等字处理软件里面的文字粘贴到ACAD里面的程序...

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：求将WORD等字处理软件里面的文字粘贴到ACAD里面的程序...

可否不加入晓东工具箱直接用