请问如何读取文本内容到剪切板上，删除原来文本

wgij007

请问如何读取文本内容到剪切板上，删除原来文本
3楼问题也有效.

muwind

wgij007 发表于 2021-1-9 22:10
这个我知道，主要是顺序不一样，我要的是从下到下的顺序，还有在中间加一空格。

vl函数不太懂，用点复杂的方式实现
(ZML-CLIP-SETSTRING txtcon) 函数还是用的原作者的

1. (defun c:RQ( / txtss N Textdxf textstr textpoint1 txtlst txtcon txt)
   
2. (setq txtss (ssget '((0 . "*TEXT"))))
   
3. (if txtss
   
4. (progn
   
5.   (setq txtcon "")
   
6.   (setq N (sslength  txtss))
   
7.   (repeat N
   
8.         (setq textdxf(entget (ssname txtss (setq N (1- N)))))  
   
9.         (setq textstr (cdr (assoc 1 textdxf)))
   
10.                 (setq textpoint1 (cadr (cdr (assoc 10 textdxf))))
    
11.                 (setq txtlst (cons (cons textpoint1 textstr ) txtlst))
    
12.    )
    
13.   )
    
14. )
    
15. 
    
16. (setq txtlst  (vl-sort txtlst  '(lambda(a b)(> (car a)(car b)))))       
    
17. (foreach txt txtlst
    
18.    (setq txtcon (strcat txtcon " " (cdr txt)))
    
19. )
    
20. 
    
21. (setq txtcon (substr txtcon 2))
    
22. (ZML-CLIP-SETSTRING txtcon)
    
23. (princ)
    
24. )
    

(defun c:RQ( / txtss N Textdxf textstr textpoint1 txtlst txtcon txt)<br /> (setq txtss (ssget '((0 . "*TEXT"))))<br /> (if txtss <br /> (progn<br />   (setq txtcon "")<br />   (setq N (sslength  txtss))<br />   (repeat N<br />         (setq textdxf(entget (ssname txtss (setq N (1- N)))))  <br />         (setq textstr (cdr (assoc 1 textdxf)))<br />                 (setq textpoint1 (cadr (cdr (assoc 10 textdxf))))<br />                 (setq txtlst (cons (cons textpoint1 textstr ) txtlst))<br />    )<br />   )<br /> )<br /> <br /> (setq txtlst  (vl-sort txtlst  '(lambda(a b)(> (car a)(car b)))))        <br /> (foreach txt txtlst <br />    (setq txtcon (strcat txtcon " " (cdr txt)))<br /> )<br /> <br /> (setq txtcon (substr txtcon 2))<br /> (ZML-CLIP-SETSTRING txtcon)<br /> (princ)<br /> )<br />

xj6019

http://bbs.mjtd.com/forum.php?mo ... =%BC%F4%C7%D0%B0%E5

wgij007

非常感谢2楼。
有没大学神能帮改下.2楼连接里的一段代码,
明经上传图片都说大了，上不了，如下
123
456
789

123 456 789
把上面的文本，改成下面在剪切板里。
原贴在2楼连接里

(vl-load-com)
(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:RQ()
(vl-load-com)
  (setq txtcon (strcat))
     (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
     (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
  (setq i 0)
  (setq txtcon (strcat))
  (repeat (vla-get-count ssv)
            ;(setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtcon  v "\n00001111 ")))  ;"\n00001111 ")説明　这部分是在剪切板后面固定添加这部分内容
　　　　　　(setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtcon  v "")))
                         (progn
                           (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
                               (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
                                      (setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
                                      (setq pt (vla-get-TextOverride (vla-item ssv i)) )))
                               (setq pt (vla-get-TextString (vla-item ssv i)))
                           )
                            (list pt)
                          )))
            (setq i (1+ i))
            )
  (ZML-CLIP-SETSTRING txtcon)
(princ)
)

xj6019

你是想把好几个文字 在剪切板里连起来吗？直接全选择几个文字后运行代码直接就可以吧。选几个连接几个

wgij007

xj6019 发表于 2021-1-9 21:52
你是想把好几个文字 在剪切板里连起来吗？直接全选择几个文字后运行代码直接就可以吧。选几个连接几个

这个我知道，主要是顺序不一样，我要的是从下到下的顺序，还有在中间加一空格。

wgij007

muwind 发表于 2021-1-9 17:04
vl函数不太懂，用点复杂的方式实现
(ZML-CLIP-SETSTRING txtcon) 函数还是用的原作者的

(defun c:twt()
  (setq ss (ssget '((0 . "text"))))
  (while (/= nil ss)
    (progn
  (if ss
    (progn
      (setq en (ssname ss 0))
      (setq txt (cdr (assoc 1 (setq enl (entget en)))))
      (ssdel en ss)
      (repeat (sslength ss)
        (setq e (ssname ss 0))
        (ssdel e ss)
        (setq txt (strcat txt (cdr (assoc 1 (entget e)))))
        (entdel e)
        )
      (setq enl (subst (cons 1 txt) (assoc 1 enl) enl))
      (entmod enl)
      )
    )
  (setq ss (ssget '((0 . "text"))))
  )
    )
  (princ)
  )

这个从上向下排，如何改呀，谢谢

muwind

wgij007 发表于 2021-1-13 18:59
(defun c:twt()
  (setq ss (ssget '((0 . "text"))))
  (while (/= nil ss)

直接排序应该是不能的，先构成一个表，然后获取Y值排序
我之前用了比较复杂的方式就是先获取了文字内容和坐标Y 构成点对进行排序，其实可以直接DXF组码排序。
如果要从下往上就，把大于改为小于号。

muwind

你大概是想合并字符串吧  

1. (defun c:twt()
   
2. 
   
3.   (while (setq ss (ssget '((0 . "text"))))       (setq txtcon "")
   
4.       (setq N (sslength ss))
   
5.       (repeat (setq N (sslength ss))
   
6.         (setq  txtname (ssname ss  (setq N( 1- N))))
   
7.         (setq  txtdxf  (entget txtname ))        
   
8.         (setq  txtlst  (cons txtdxf  txtlst ))                        
   
9.         (entdel txtname)
   
10.        );得到dxf列表
    
11.            (setq txtlst  (vl-sort txtlst  '(lambda(a b)(> (cadr (cdr (assoc 10 a))) (cadr (cdr (assoc 10 b)))))))
    
12.            (setq enddxf (last txtlst))
    
13.            ;按坐标y排序完成,获取最后dxf
    
14.            (foreach a txtlst
    
15.           (setq txtcon (strcat txtcon " " (cdr (assoc 1 a))))
    
16.         );获取字符串
    
17.            (setq txtcon (substr txtcon 2))
    
18.            ;去除开头空格
    
19.       (setq enddxf (subst (cons 1 txtcon) (assoc 1 enddxf) enddxf))
    
20.       (entmake enddxf) ；由于对象都删除了因此需要重建一个
    
21.       )
    
22.   (princ)
    
23.   )
    

(defun c:twt()<br /> <br />   (while (setq ss (ssget '((0 . "text"))))       (setq txtcon "")<br />       (setq N (sslength ss))<br />       (repeat (setq N (sslength ss))<br />         (setq  txtname (ssname ss  (setq N( 1- N))))<br />         (setq  txtdxf  (entget txtname ))        <br />         (setq  txtlst  (cons txtdxf  txtlst ))                        <br />         (entdel txtname)<br />        );得到dxf列表<br />            (setq txtlst  (vl-sort txtlst  '(lambda(a b)(> (cadr (cdr (assoc 10 a))) (cadr (cdr (assoc 10 b))))))) <br />            (setq enddxf (last txtlst))<br />            ;按坐标y排序完成,获取最后dxf<br />            (foreach a txtlst <br />           (setq txtcon (strcat txtcon " " (cdr (assoc 1 a))))<br />         );获取字符串<br />            (setq txtcon (substr txtcon 2))<br />            ;去除开头空格<br />       (setq enddxf (subst (cons 1 txtcon) (assoc 1 enddxf) enddxf))<br />       (entmake enddxf) ；由于对象都删除了因此需要重建一个<br />       )<br />   (princ)<br />   )<br />