Sử dụng ClipBoard trong LISP : Copy và Paste dữ liệu kiểu Text

[gia_bach 1.549]

Giới thiệu với các bạn đọan LISP (vừa sưu tầm đuợc) lưu và lấy dữ liệu kiểu Text từ ClipBoard

Hàm SetClipBoardText By XShrimp : lưu dữ liệu kiểu Text vào ClipBoard

Hàm GetClipBoardText By Patrick_35 : lấy dữ liệu kiểu Text từ ClipBoard

 

Ứng dụng :

- Bản vẽ A có một Text (gọi là nguồn)

- Bản vẽ B, C ... có rất nhiều text (gọi là đích) có các nội dung không giống nhau

- Sau khi thực hiện lệnh [chọn đối tượng nguồn >enter> chọn các đối tựong đích >enter> ]thì các đối tượng đích sẽ có nội dung của đối tượng nguồn.

Trong CAD

- trên bản vẽ A gọi lệnh copy2 -> chọn Text nguồn,

- trên bản vẽ B, C ... gọi lệnh paste2 -> chọn các đối tựong đích >enter :bigsmile:

 

Với các Text từ nguồn khác như : Word, Excel , trình duyệt, … : hàm GetClipBoardText bỏ qua các đối tuợng đồ họa (image), chỉ chọn ra Text. Đặc biệt trong Excel : cho phép copy dữ liệu trong nhiều cell.

(vl-load-com)
(defun c:copy2 (/ ent str); Copy to ClipBoard
 (if
   (and
     (setq ent (car (entsel (strcat"\nChon Text de luu vao ClipBoard <<" (if (setq str (GetClipBoardText)) (Trim_Str str 15) "nil") ">> :"))))
     (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT") )
   (princ (strcat"\nDa luu <<" (SetClipBoardText (cdr (assoc 1 (entget ent)))) ">> vao ClipBoard." ))
   (alert "Chon doi tuong khong hop le.")
   )
 (princ)
 )

(defun c:paste2 (/ obj str ss); Paste from ClipBoard
 (if (setq str (GetClipBoardText))
   (progn
     (princ (strcat "\nChon text de gan gia tri tu ClipBoard <<" (Trim_Str str 15) ">> :"))
     (setq ss (ssget (list (cons 0 "*TEXT")) ))
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString (vlax-ename->vla-object e) str)     )
     )
   (alert (strcat "Gia tri ClipBoard hien hanh khong phai kieu String."
	   "\nGoi lenh Copy2 de luu gia tri vao ClipBoard."))
   )
 (princ)
)

(defun Trim_Str(Str len)
 (if(and Str (< len (strlen Str)))
   (strcat(substr Str 1 len)"...")
   Str
   ))
(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
 (if (= 'STR (type text))
   (progn
     (setq htmlfile (vlax-create-object "htmlfile")
    result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text ) )
     (vlax-release-object htmlfile)
     text
     ))
 )
(defun GetClipBoardText( / htmlfile result ) ; By Patrick_35
 (setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'GetData "Text" ) )
 (vlax-release-object htmlfile)
 result
)

[Thaistreetz 539]

Cái này đúng là tuyệt thật, bản thân em đã từng chủ quan nghĩ rằng lisp không thể can thiệp vào clipboad của window. đúng là autolisp thật là tuyệt vời.

[Phiphi- 176]

Bác có thể upgrade LISP trên để có thể thực hiện được liên tục các bước copy-paste mà không cần phải nhập lại lệnh, thí dụ:

1- Đánh lệnh Copy2, chọn một Text của b/v A

2- Đánh lệnh Paste2, chọn Text ở b/v B để thay thế

3- Chọn Text khác của b/v A

4. Chọn Text khác của b/v B để thay thế

5. Cứ tiếp tục như thế...

...

ESC/ENTER để exit.

Thank you.

[Phiphi- 176]

Bác có thể upgrade LISP trên để có thể thực hiện được liên tục các bước copy-paste mà không cần phải nhập lại lệnh, thí dụ:

1- Đánh lệnh Copy2, chọn một Text của b/v A

2- Đánh lệnh Paste2, chọn Text ở b/v B để thay thế

3- Chọn Text khác của b/v A

4. Chọn Text khác của b/v B để thay thế

5. Cứ tiếp tục như thế...

...

ESC/ENTER để exit.

Thank you.

Bác tham khảo Lisp TTC dưới đây của AsmiTools (chỉ dùng trong 1 b/v mà thôi)

- Đánh lệnh TTC rồi đánh P

- Chọn Text để copy

- Chọn Text khác để thay thế

- Cứ tiếp tục copy-paste ...

Demo: http://www.asmitools.com/Files/Lisps/Ttc.html

 

;; ==================================================================== ;;
;;                                                                      ;;
;;  TTC.LSP - The program copies the text from: DText, MText,           ;;
;;            Tables, Dimensions, Attributes, Attributes,               ;;
;;            Attributes Definitions, DText, MText and inner            ;;
;;            block's DText and MText to: DText, MText, Tables,         ;;
;;            Attribures and Attributes Definitions. There are          ;;
;;            Multiple and Pair-wise modes.                             ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: TTC                                             ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.3, 29 November, 2005, Riga, Latvia                               ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;                             [url="http://www.asmitools.com"]http://www.asmitools.com[/url]                 ;;
;;                                                                      ;;
;; ==================================================================== ;;

(defun c:ttc (/ actDoc vlaObj sObj sText curObj oldForm
               oType oldMode conFlag errFlag *error*)

 (vl-load-com)

     (setq actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object)))
         (vla-StartUndoMark actDoc)

 (defun TTC_Paste(pasteStr / nslLst vlaObj hitPt
                  hitRes Row Column)
   (setq errFlag nil)
   (if
    (setq nslLst(nentsel "\nPaste text >"))
      (progn
       (cond
         ((and
            (= 4(length nslLst))
            (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))
           ); end and
            (setq vlaObj(vlax-ename->vla-object
               (cdr(assoc -1(entget(car(last nslLst)))))))
          (if
            (vl-catch-all-error-p
              (vl-catch-all-apply
                'vla-put-TextOverride(list vlaObj pasteStr)))
                  (progn
                    (princ "\n Can't paste. Object may be on locked layer  ")
                    (setq errFlag T)
                   ); end progn
            ); end if
          ); end condition #1
         ((and
            (= 4(length nslLst))
            (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
           ); end and
           (setq vlaObj
             (vlax-ename->vla-object
                (cdr(assoc -1(entget(car(last nslLst))))))
                 hitPt(vlax-3D-Point(trans(cadr nslLst)1 0))
                 hitRes(vla-HitTest vlaObj hitPt
                       (vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
           ); end setq
           (if(= :vlax-true hitRes)
            (progn
              (if(vl-catch-all-error-p
                   (vl-catch-all-apply
                     'vla-SetText(list vlaObj Row Column pasteStr)))
            (progn
              (princ "\n Can't paste. Object may be on locked layer  ")
              (setq errFlag T)
              ); end progn
             ); end if
            ); end progn
           ); end if
          ); end condition # 2
         ((and
             (= 4(length nslLst))
             (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
          ); end and
           (princ "\n Can't paste to block's DText or MText  ")
           (setq errFlag T)
           ); end condition #3
        ((and
           (= 2(length nslLst))
           (member(cdr(assoc 0(entget(car nslLst))))
            '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
          ); end and
        (setq vlaObj(vlax-ename->vla-object(car nslLst)))
       (if(vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-put-TextString(list vlaObj pasteStr)))
            (progn
              (princ "\n Error. Can't pase text  ")
              (setq errFlag T)
            ); end progn
           ); end if
         ); end condition #4
       (T
         (princ "\n Can't paste. Invalid object  ")
         (setq errFlag T)
        ); end condition #5
       ); end cond
             T
      ); end progn
            nil
           ); end if
    ); end of TTC_Paste


   (defun TTC_MText_Clear(Mtext / Text Str)
     (setq Text "")
     (while(/= Mtext "")
       (cond
         ((wcmatch(strcase
          (setq Str
           (substr Mtext 1 2)))"\\[\\{}`~]")
           (setq Mtext(substr Mtext 3)
              Text(strcat Text Str)
              ); end setq
          ); end condition #1
        ((wcmatch(substr Mtext 1 1) "[{}]")
         (setq Mtext
         (substr Mtext 2))
         ); end condition #2
        ((and
         (wcmatch
          (strcase
            (substr Mtext 1 2)) "\\P")
              (/=(substr Mtext 3 1) " ")
          ); end and
        (setq Mtext (substr Mtext 3)
              Text (strcat Text " ")
              ); end setq
          ); end condition #3
       ((wcmatch
          (strcase
            (substr Mtext 1 2)) "\\[LOP]")
            (setq Mtext(substr Mtext 3))
          ); end condition #4
       ((wcmatch
          (strcase
            (substr Mtext 1 2)) "\\[ACFHQTW]")
          (setq Mtext
           (substr Mtext
            (+ 2(vl-string-search ";" Mtext))))
          ); end condition #5
       ((wcmatch
          (strcase (substr Mtext 1 2)) "\\S")
            (setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text(strcat Text (vl-string-translate "#^\\" " " Str))
                  Mtext(substr Mtext (+ 4 (strlen Str)))
             ); end setq
           (print Str)
         ); end condition #6
        (T(setq Text(strcat Text(substr Mtext 1 1))
                Mtext (substr Mtext 2)
                ); end setq
        ); end condition #7
      ); end cond
    ); end while
  Text
); end of TTC_MText_Clear


 (defun TTC_Copy (/ sObj sText tType actDoc)
  (if
   (and
    (setq sObj(car(nentsel "\nCopy text... ")))
    (member(setq tType(cdr(assoc 0(entget sObj))))
     '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
    ); end and
   (progn
     (setq actDoc(vla-get-ActiveDocument
       (vlax-get-Acad-object))
           sText(vla-get-TextString
      (vlax-ename->vla-object sObj))
     ); end setq
     (if(= tType "MTEXT")
        (setq sText(TTC_MText_Clear sText))
       ); end if
     ); end progn
    ); end if
   sText
   ); end of TTC_Copy

 (defun CCT_Str_Echo(paseStr / comStr)
   (if(< 20(strlen paseStr))
     (setq comStr
      (strcat
        (substr paseStr 1 17)"..."))
     (setq comStr paseStr)
     ); end if
    (princ(strcat "\nText = \"" comStr "\""))
   (princ)
   ); end of CCT_Str_Echo

   (defun *error*(msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
    (princ "\nQuit TTC")
   (princ)
   ); end of *error*

   (if(not ttc:Mode)(setq ttc:Mode "Multiple"))
    (initget "Multiple Pair-wise")
    (setq oldMode ttc:Mode
          ttc:Mode(getkword
                    (strcat "\nSpecify mode [Multiple/Pair-wise] <"ttc:Mode">: "))
          conFlag T
          paseStr ""
         ); end setq
   (if(null ttc:Mode)(setq ttc:Mode oldMode))
   (if(= ttc:Mode "Multiple")
     (progn
       (if(and(setq paseStr(TTC_Copy))conFlag)
        (progn
         (CCT_Str_Echo paseStr)
        (while(setq conFlag(TTC_Paste paseStr))T
           ); end while
       ); end progn
     ); end if
   ); end progn
     (progn
       (while(and conFlag paseStr)
          (setq paseStr(TTC_Copy))
           (if(and paseStr conFlag)
             (progn
              (CCT_Str_Echo paseStr)
               (setq errFlag T)
                 (while errFlag
                   (setq conFlag(TTC_Paste paseStr))
               );end while
             ); end progn
           ); end if
         ); end while
       ); end progn
     ); end if
  (vla-EndUndoMark actDoc)
  (princ "\nQuit TTC")
 (princ)
 ); end c:ttc

(princ "\nhttp:\\\\www.AsmiTools.com ")
(princ "\n Type TTC to run text to text copy tool ")

[gia_bach 1.549]

Bác có thể upgrade LISP trên để có thể thực hiện được liên tục các bước copy-paste mà không cần phải nhập lại lệnh, thí dụ:

1- Đánh lệnh Copy2, chọn một Text của b/v A

2- Đánh lệnh Paste2, chọn Text ở b/v B để thay thế

3- Chọn Text khác của b/v A

4. Chọn Text khác của b/v B để thay thế

5. Cứ tiếp tục như thế...

...

ESC/ENTER để exit.

Thank you.

Update theo yêu cầu của bạn.

Với lệnh Copy2 tại dòng nhắc : Chon Text de luu vao ClipBoard : bạn có thể tạm ngưng chờ lệnh Paste2 ở bản vẽ khác.

Với lệnh Paste2 tại dòng nhắc : Tiep tuc chon Text khac Yes/No :, bạn có thể tạm ngưng để chuyển qua bản vẽ khác chọn Text nguồn mới đưa vào ClipBoard. Sau đó lại tiếp tục .....

Tuy nhiên theo nhận xét của tui thì yêu cầu cũng không cải tiến đuợc bao nhiêu, so với lệnh cũ việc nhập lại lệnh tương đuơng nhấn Enter nhưng đôi khi gây phiền phức hơn.

(vl-load-com)
(defun c:copy2 (/ ent str); Copy to ClipBoard
 (princ (strcat"\nGia tri ClipBoard hien hanh <<" (if (setq str (GetClipBoardText)) (Trim_Str str 15) "nil") ">> :"))
 (while (setq ent (car (entsel (strcat"\nChon Text de luu vao ClipBoard :"))))    
   (if (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")
     (princ (strcat"\nDa luu <<" (SetClipBoardText (cdr (assoc 1 (entget ent)))) ">> vao ClipBoard." ))
     (alert "Chon doi tuong khong hop le.")
     )
   )
 (princ)
 )

(defun c:paste2 (/ obj str ss); Paste from ClipBoard
 (setq str (GetClipBoardText) flag T)
 (while (/= flag "N")
   (and
     str
     (princ (strcat "\nChon text de gan gia tri tu ClipBoard <<" (Trim_Str str 15) ">> :"))
     (setq ss (ssget (list (cons 0 "*TEXT")) ))
     )
   (if ss
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString (vlax-ename->vla-object e) str)     )
     )
   (initget "Y N")
   (setq flag (getkword "Tiep tuc chon Text khac Yes/No  :"))
   (setq str (GetClipBoardText))
   )
 (if (not str)
   (alert (strcat "Gia tri ClipBoard hien hanh khong phai kieu String."
           "\nGoi lenh Copy2 de luu gia tri vao ClipBoard."))   )
 (princ)
)

(defun Trim_Str(Str len)
 (if(and Str (< len (strlen Str)))
   (strcat(substr Str 1 len)"...")
   Str
   ))
(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
 (if (= 'STR (type text))
   (progn
     (setq htmlfile (vlax-create-object "htmlfile")
    result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text ) )
     (vlax-release-object htmlfile)
     text
     ))
 )
(defun GetClipBoardText( / htmlfile result ) ; By Patrick_35
 (setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'GetData "Text" ) )
 (vlax-release-object htmlfile)
 result
)

[master_worse 88]

Giới thiệu với các bạn đọan LISP (vừa sưu tầm đuợc) lưu và lấy dữ liệu kiểu Text từ ClipBoard

Hàm SetClipBoardText By XShrimp : lưu dữ liệu kiểu Text vào ClipBoard

Hàm GetClipBoardText By Patrick_35 : lấy dữ liệu kiểu Text từ ClipBoard

 

Ứng dụng :

Trong CAD

- trên bản vẽ A gọi lệnh copy2 -> chọn Text nguồn,

- trên bản vẽ B, C ... gọi lệnh paste2 -> chọn các đối tựong đích >enter :bigsmile:

 

Có cách nào gộp 2 lệnh copy2 và paste2 thành một không nhỉ??? :bigsmile:

 

---------

[Trang72 2]

Có thể copy và reaplace (thay thế) một cụm nhiều text dời rạc được không ví dụ:

 

 

Sắt

0.3

0.2

0.7

0.8

0.8

 

Bằng nhôm

0.2

0.6

0.6

0.7

0.9

 

[ndtnv 481]

Nên dùng hàm vla-get-TextString để lấy nội dung vì  trong help đối với MTEXT mã dxf 1

Text string. If the text string is less than 250 characters, all characters appear in group 1. If the text string is greater than 250 characters, the string is divided into 250-character chunks, which appear in one or more group 3 codes. If group 3 codes are used, the last group is a group 1 and has fewer than 250 characters

Nếu text string dài hơn 250 ký tự, string được chia thành từng đoạn 250 trong dxf 3, phần còn lại < 250 ký tự mới trong dxf 1

 

[thanhduan2407 272]

Các bác cho em hỏi.

Nếu em quét chọn 1 tập đối tượng Text chẳng hạn. Em muốn lấy tọa độ của Text, nội dung Text ( X Y Z ND) cho vào Clipboard được không ạ?

Sau khi quét chọn Text, kết thúc lệnh thì có thể paste được vào Notepad hoặc Word  hoặc Excel ...

X1 Y1 Z1 MD

X2 Y2 Z2 NHA

................

Lisp trên trình bày hơi rối tý nên em chỉnh sửa lại cho đẹp mắt

(vl-load-com)
(defun c:copy2 (/ ent str); Copy to ClipBoard
(if (and (setq ent (car (entsel (strcat"\nChon Text de luu vao ClipBoard <<" (if (setq str (GetClipBoardText)) (Trim_Str str 15) "nil") ">> :"))))
	 (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")
    )
    (princ (strcat"\nDa luu <<" (SetClipBoardText (cdr (assoc 1 (entget ent)))) ">> vao ClipBoard." ))
    (alert "Chon doi tuong khong hop le.")
)
(princ)
)

(defun c:paste2 (/ obj str ss); Paste from ClipBoard
  (if (setq str (GetClipBoardText))
    (progn
      (princ (strcat "\nChon text de gan gia tri tu ClipBoard <<" (Trim_Str str 15) ">> :"))
      (setq ss (ssget (list (cons 0 "*TEXT")) ))
      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-TextString (vlax-ename->vla-object e) str)
      )
    )
    (alert (strcat "Gia tri ClipBoard hien hanh khong phai kieu String."
		   "\nGoi lenh Copy2 de luu gia tri vao ClipBoard."))
  )
  (princ)
)

(defun Trim_Str(Str len)
  (if (and Str (< len (strlen Str)))
      (strcat(substr Str 1 len)"...")
    Str
  )
)

(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
  (if (= 'STR (type text))
    (progn
      (setq htmlfile (vlax-create-object "htmlfile")
	    result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text )
      )
      (vlax-release-object htmlfile)
      text
    )
    )
  )

(defun GetClipBoardText( / htmlfile result ) ; By Patrick_35
  (setq htmlfile (vlax-create-object "htmlfile")
	result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'GetData "Text" )
  )
  (vlax-release-object htmlfile)
  result
)

Cảm ơn các anh, các bác nhiều

[Doan Van Ha 3.186]

Đang thắc mắc là tại sao Thanhduan không xuất trực tiếp ((x1 y1 z1 ND1) (x2 y2 z2 ND2) (x3 y3 z3 ND3)...) sang mà phải thông qua Clipboard?

[thanhduan2407 272]

Đang thắc mắc là tại sao Thanhduan không xuất trực tiếp ((x1 y1 z1 ND1) (x2 y2 z2 ND2) (x3 y3 z3 ND3)...) sang mà phải thông qua Clipboard?

Dạ, em đang nghiên cứu về Copy và Paste Clipboard. Cái em nói trên chỉ là ví dụ thôi ạ. 

Em đang nghiên cứu về kiểu mảng danh sách rồi cho vào Clipboard. Không biết có ổn không? Hiii

Với cách copy Clipboard thì em đỡ phải lưu ra file rồi mới mở bác Hạ ạ.

Cảm ơn bác đã quan tâm

[Tot77 508]

Các hàm trên chỉ nhận 1 string thôi, không nhận mảng hay list.

Bạn phải sắp xếp trước rồi mới đưa vào clipboard.

[thanhduan2407 272]

Em nghĩ là được. Trong Clip này em thấy họ làm dc anh ạ

[gia_bach 1.549]

Em nghĩ là được. Trong Clip này em thấy họ làm dc anh ạ

Ví dụ này họ dùng VBA Automation để liên kết Acad với Excel.

 

Nhầm rồi !

Chỉnh sửa Tháng 11 7, 2014 theo gia_bach

[Tue_NV 3.912]

Em nghĩ là được. Trong Clip này em thấy họ làm dc anh ạ

 

Chào Thanhduan!

Em tạo các string nối nhau với các ký tự \t (dấu tab) và ký tự \n (xuống dòng)

\t (dấu tab) có tác dụng chia dữ liệu thành các cột trên excel

\n (xuống dòng) có tác dụng chia dữ liệu thành các hàng trên excel

 

Cái này anh quên khuấy mất, hỏi tác giả và đã thử nghiệm được rồi

Chúc em thành công!

[thanhduan2407 272]

Em cảm ơn anh Gia_Bach. Em chưa rõ lắm ạ.

@Tue_NV: Anh có thể cho em 1 đoạn Code hướng dẫn không ạ?

[Tue_NV 3.912]

Em cảm ơn anh Gia_Bach. Em chưa rõ lắm ạ.

@Tue_NV: Anh có thể cho em 1 đoạn Code hướng dẫn không ạ?

 

1./ Có lẽ anh gia_bach đã nhầm. Đoạn video đó load file *.vlx

2./ Thanhduan thử đoạn code sau :

 

(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
  (if (= 'STR (type text))
    (progn
      (setq htmlfile (vlax-create-object "htmlfile")
        result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text )
      )
      (vlax-release-object htmlfile)
      text
    )
    )
  )
(defun c:copy2 (/ ss i ename entg str)
  (setq i -1 str "")
  (if (setq ss (ssget '((0 . "TEXT"))))
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq entg (entget ename))
      (setq str (strcat str "X = " (rtos (cadr (assoc 10 entg))) "\t"
                "Y = " (rtos (caddr (assoc 10 entg))) "\t"


            "Z = " (rtos (caddr (assoc 10 entg))) "\t"
                (cdr(assoc 1 (entget ename))) "\n"
        ))
    )
  )
  (SetClipBoardText str)
)

Cách sử dụng :

Dùng lệnh Copy2 -> Chọn Text -> Mở Excel -> Nhấn Ctrol+V

[thanhduan2407 272]

1./ Có lẽ anh gia_bach đã nhầm. Đoạn video đó load file *.vlx

2./ Thanhduan thử đoạn code sau :

 

(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
  (if (= 'STR (type text))
    (progn
      (setq htmlfile (vlax-create-object "htmlfile")
        result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text )
      )
      (vlax-release-object htmlfile)
      text
    )
    )
  )
(defun c:copy2 (/ ss i ename entg str)
  (setq i -1 str "")
  (if (setq ss (ssget '((0 . "TEXT"))))
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq entg (entget ename))
      (setq str (strcat str "X = " (rtos (cadr (assoc 10 entg))) "\t"
                "Y = " (rtos (caddr (assoc 10 entg))) "\t"


            "Z = " (rtos (caddr (assoc 10 entg))) "\t"
                (cdr(assoc 1 (entget ename))) "\n"
        ))
    )
  )
  (SetClipBoardText str)
)

Cách sử dụng :

Dùng lệnh Copy2 -> Chọn Text -> Mở Excel -> Nhấn Ctrol+V

Ok. Vậy là em hiểu rồi ạ.

Cảm ơn anh Tue_NV nhiều