读取剪切板刷文字内容
请问，CAD中，如何读取剪切板的文字内容，并把内容刷给已有的文字？没有昵称呀 发表于 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)
)
;
;================剪贴板到对象------------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)
)
;
(defun l-ssget1(wz)
(ssget wz '((-4 . "<OR")(0 . "TEXT,MTEXT,DIMENSION")(-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>")(-4 . "OR>")))
)
;
(defun l-dxft(bh sne)
(cdr(assoc bh(entget sne)))
)
;
(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)
)
)
;
(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
)
;
(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
)
;
(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)
)
; 多搜一下论坛吧，多得很 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)
刚才测试了一下，功能强大，感谢分享 liufii 发表于 2022-8-16 19:19
;================对象到剪贴板------------OK--T
(defun c:t(/ dx dxl sne)
(vl-load-com)
这个好像对于属性块文字不适用，如果能支持就更完美了 刚才测试了一下，功能强大，感谢分享 要是支持属性块就完美了
页:
[1]