664571221 发表于 2023-10-13 14:48:39

各位大神求帮忙修改下这个程序，第一个复制的程序不用右键确认，我想第二个程序修改为

各位大神求帮忙修改下这个程序，第一个复制的程序不用右键确认，我想第二个程序修改为选择两个文字连接后，不用右键确认，直接到粘贴板


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(list " 粘贴板T5" "N2")各种文字复制
(defun c:N()
(vl-load-com)
(setq ent (entget (car (entsel "\n选择复制文本:"))))
(setq tx (cdr (assoc 1 ent)))
(vldos-write-clip tx)
)

(defun vldos-write-clip      (text / htmlfile result)
(setq      result
         (vlax-invoke
         (vlax-get
             (vlax-get
               (setq htmlfile (vlax-create-object "htmlfile"))
               'ParentWindow
             )
             'ClipBoardData
         )
         'SetData
         "Text"
         text
         )
)
(vlax-release-object htmlfile)
text
)




第二个程序

;;;功能：向系统剪贴板写入文字
;;;引用地址http://bbs.mjtd.com/forum.php?mo ... hlight=%BC%F4%C7%D0
(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:tt ( / str str1)
(if      (setq str(ssget ":E:S" '((0 . "TEXT"))))
      (progn
                (setq str(cdr(assoc 1(entget(ssname str 0)))))
                (while(setq str1(ssget ":E:S" '((0 . "TEXT"))))
                        (setq str(strcat str "-"(cdr(assoc 1(entget(ssname str1 0))))))                     
                )
                (ZML-CLIP-SETSTRINGstr)
      )
))

咏郡 发表于 2023-10-15 20:19:48

(defun c:N(/ vldos-write-clip xz tx)
(vl-load-com)
        (defun vldos-write-clip      (text / htmlfile result)
(setq      result
         (vlax-invoke
         (vlax-get
             (vlax-get
               (setq htmlfile (vlax-create-object "htmlfile"))
               'ParentWindow
             )
             'ClipBoardData
         )
         'SetData
         "Text"
         text
         )
)
(vlax-release-object htmlfile)
text
)
       
(defun xz( i / ent tx)
                (while (= nil tx)
                        (setq ent (entget (car (entsel (strcat "\n选择第<"i">复制文本:")))))
(if(= nil(setq tx (cdr (assoc 1 ent))))
                        (princ"\n 你选择的不是文字，重新选取！"))
                )
                tx
        )
       
        (setq tx (strcat(xz "1")(xz "2")))
(vldos-write-clip tx)
)

664571221 发表于 2023-10-15 20:57:51

咏郡 发表于 2023-10-15 20:19
(defun c:N(/ vldos-write-clip xz tx)
(vl-load-com)
        (defun vldos-write-clip      (text / htmlf ...

(defun c:N(/ vldos-write-clip xz tx)
(vl-load-com)
        (defun vldos-write-clip      (text / htmlfile result)
(setq      result
         (vlax-invoke
         (vlax-get
             (vlax-get
               (setq htmlfile (vlax-create-object "htmlfile"))
               'ParentWindow
             )
             'ClipBoardData
         )
         'SetData
         "Text"
         text
         )
)
(vlax-release-object htmlfile)
text
)
       
(defun xz( i / ent tx)
                (while (= nil tx)
                        (setq ent (entget (car (entsel (strcat "\n选择第<"i">复制文本:")))))
(if(= nil(setq tx (cdr (assoc 1 ent))))
                        (princ"\n 你选择的不是文字，重新选取！"))
                )
                tx
        )
       
        (setq tx (strcat(xz "1")"*"(xz "2")))
(vldos-write-clip tx)
)

ljpnb 发表于 2023-10-15 22:03:21

如果只需要选择两组文字，只需要把while改成if就可以了

664571221 发表于 2023-10-16 08:28:36

ljpnb 发表于 2023-10-15 22:03
如果只需要选择两组文字，只需要把while改成if就可以了

怎么改大神...

hubeiwdlue 发表于 2023-10-18 14:12:22

之所以要右键确认，是因为whlie语句，你把while语句去掉就行了。(vl-load-com)
(defun ZML-CLIP-SETSTRING (STR / )
(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:tt ( / )
(if      (setq str(ssget ":E:S" '((0 . "TEXT"))))
      (progn
                (setq str(cdr(assoc 1(entget(ssname str 0)))))
                                              (setq str1(ssget ":E:S" '((0 . "TEXT"))))
                                              (setq str(strcat str "-"(cdr(assoc 1(entget(ssname str1 0))))))
                (ZML-CLIP-SETSTRINGstr)
      )
))

664571221 发表于 2023-10-18 20:36:52

hubeiwdlue 发表于 2023-10-18 14:12
之所以要右键确认，是因为whlie语句，你把while语句去掉就行了。

谢谢大神，你是做半导体的吗

hubeiwdlue 发表于 2023-10-18 21:09:37

本帖最后由 hubeiwdlue 于 2023-10-18 22:11 编辑

664571221 发表于 2023-10-18 20:36
谢谢大神，你是做半导体的吗
不是啊。头像是随便找的，:lol
页: [1]
查看完整版本: 各位大神求帮忙修改下这个程序，第一个复制的程序不用右键确认，我想第二个程序修改为