读取剪切板刷文字内容

没有昵称呀

请问，CAD中，如何读取剪切板的文字内容，并把内容刷给已有的文字？

liufii

没有昵称呀 发表于 2022-8-16 19:09
您好，这个链接的附件下载不下来，能否贴下码源呢?

;================对象到剪贴板------------OK--T
(defun c:t(/ dx dxl sne)
        (vl-load-com)
        (and
                (or
                        (setq dx (cadr (ssgetfirst)))
                        (setq dx (l-ssget1 "_:S:l"))
                )
                (sssetfirst nil nil)
                (setq
                        sne (l-dxft 0 (ssname dx 0))
                        dxl (vlax-ename->vla-object(ssname dx 0))
                )
                (cond
                        ((/= (sslength dx) 1)(alert "只能选择一个对象！"))
                        ((= "INSERT"                 sne)(l-jtbx (car(l-dxtk dxl nil nil))))
                        ((= "DIMENSION" sne)(l-jtbx (l-dxdim dx 0)))
                        (t (l-jtbx (vla-get-TextString dxl)))
                )
        )
        (princ)
)[/code]
;
;================剪贴板到对象------------OK--TY
(defun c:ty(/ dx dxl i sne wz)
        (vl-load-com)
        (and
                (or
                        (setq dx (cadr (ssgetfirst)))
                        (setq dx (l-ssget1 "_:S:l"))
                )
                (sssetfirst nil nil)
                (setq wz (l-jtbd) i -1)
                (if (vl-string-position 13 wz)
                        (setq wz (vl-list->string (reverse(cdr(member 13 (reverse(vl-string->list wz)))))))
                        (setq wz wz)
                )
                (repeat (sslength dx)
                        (setq i (1+ i) sne (l-dxft 0 (ssname dx i)) dxl (vlax-ename->vla-object(ssname dx i)))
                        (cond
                                ((= "INSERT"    sne) (l-dxtk dxl wz nil))
                                ((= "DIMENSION" sne) (vla-put-TextOverride dxl wz))
                                (t (vla-put-TextString dxl wz))
                        )
                )
        )
        (princ)
)[/code]
;
(defun l-ssget1(wz)
        (ssget wz '((-4 . "<OR")(0 . "TEXT,MTEXT,DIMENSION")(-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>")(-4 . "OR>")))
)[/code]
;
(defun l-dxft(bh sne)
        (cdr(assoc bh(entget sne)))
)[/code]
;
(defun l-jtbx(lt1 / t1 t2)
        (and
                (= (type lt1) 'str)
                (setq t1 (vlax-create-object "htmlfile"))
                (setq t2 (vlax-invoke
                                                         (vlax-get (vlax-get t1 'PARENTWINDOW)
                                                                 'CLIPBOARDDATA
                                                         )
                                                         'SETDATA
                                                         "Text"
                                                         lt1
                                                 )
                )
                (vlax-release-object t1)
        )
)[/code]
;
(defun l-jtbd(/ t1 t2)
        (and
                (setq t1 (vlax-create-object "htmlfile"))
                (setq t2 (vlax-invoke
                                                         (vlax-get (vlax-get t1 'PARENTWINDOW)
                                                                 'CLIPBOARDDATA
                                                         )
                                                         'GETDATA
                                                         "Text"
                                                 )
                )
                (vlax-release-object t1)
        )
        t2
)[/code]
;
(defun l-dxdim(dx i / wz)
        (setq wz (cdr(assoc -2(tblsearch "BlOCK"(l-dxft 2(ssname dx i))))))
        (while (/= (l-dxft 0 wz) "MTEXT") (setq wz (entnext wz)))
        (setq wz (l-dxft 1 wz))
        (if (member 59 (vl-string->list wz))
                (setq wz (vl-list->string (cdr(member 59 (vl-string->list wz)))))
        )
        wz
)[/code]
;
(defun l-dxtk(dxl lx fw / i lst wzb wzl)
        (setq lst (vlax-safearray->list (vlax-variant-value (vla-getattributes dxl))) i 0)
        (cond
                ((= lx nil)
                        (foreach x lst
                                (if (/= (vla-get-TagString x) "比例")
                                        (setq
                                                wzl (cons (vla-get-TextString x) wzl)
                                                wzb (cons (vla-get-TagString x)  wzb)
                                        )
                                )
                        )
                        (setq wzl (reverse wzl) wzb (reverse wzb))
                )
                ((listp lx)
                        (foreach x lst
                                (if (/= (vla-get-TagString x) "比例")
                                        (progn
                                                (vla-put-TextString x (nth i lx))
                                                (setq i (1+ i))
                                        )
                                )
                        )
                        (setq wzl t)
                )
                (t
                        (vla-put-TextString (car lst) lx)
                        (setq wzl t)
                )
        )
        (if fw (list wzb wzl) wzl)
)[/code]
;

cqu20104225

多搜一下论坛吧，多得很

sharetow

http://bbs.mjtd.com/thread-183707-1-1.html

没有昵称呀

sharetow 发表于 2022-8-16 10:29
http://bbs.mjtd.com/thread-183707-1-1.html

您好，这个链接的附件下载不下来，能否贴下码源呢?

没有昵称呀

liufii 发表于 2022-8-16 19:19
;================对象到剪贴板------------OK--T
(defun c:t(/ dx dxl sne)
        (vl-load-com)

刚才测试了一下，功能强大，感谢分享

cj52000

liufii 发表于 2022-8-16 19:19
;================对象到剪贴板------------OK--T
(defun c:t(/ dx dxl sne)
        (vl-load-com)

这个好像对于属性块文字不适用，如果能支持就更完美了

技术工作室

刚才测试了一下，功能强大，感谢分享

菜鸟初来乍到

要是支持属性块就完美了