(defun C:TCC (/ lst str txt 2ClipB) ;***** TCC = copy *****
(vl-load-com)
(princ "\nChon cac Text/Mtext/Dimension can copy...")
(setq lst (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION")))))
(setq str "")
(foreach n lst
(cond
((= (cdr (assoc 0 (entget n))) "TEXT")
(setq txt (cdr (assoc 1 (entget n))))
)
((= (cdr (assoc 0 (entget n))) "MTEXT")
(setq txt (cdr (assoc 1 (entget n))))
)
((= (cdr (assoc 0 (entget n))) "DIMENSION")
(if (= (cdr (assoc 1 (entget n))) "")
(setq txt (rtos (cdr (assoc 42 (entget n)))2 0))
(setq txt (cdr (assoc 1 (entget n))))
)
)
)
(setq str (strcat str txt "\n"))
)
(vlax-invoke
(vlax-get
(vlax-get (setq 2ClipB (vlax-create-object "htmlfile"))
'ParentWindow
)
'ClipBoardData
)
'SetData
"Text"
str
)
(vlax-release-object 2ClipB)
(princ)
)
;*********************************************
(defun C:DD (/ ss->vla s1 s2 s3 s11 s12 n e1 e2 i j i1 ii) ;***** DD -> da'n *****
(vl-load-com)
(setq s11 (QGetClipText))
(princ "\nSelect Texts to Paste value: ")
(setq s2 (ssget '((0 . "*TEXT"))))
(command "_.undo" "_be")
;*******************
(setq ii 0)
(While (> (vl-string-search "\n" s11) 0)
(setq s11 (vl-string-subst "*" "\n" s11))
(setq ii (+ 1 ii))
)
;******************
(setq s1 (vl-sort (ss_vla s2)
'(lambda (a b)
(< (car (vlax-get a 'InsertionPoint))
(car (vlax-get b 'InsertionPoint))
)
)
)
)
(setq s2 (vl-sort (ss_vla s2)
'(lambda (a b)
(< (car (vlax-get a 'InsertionPoint))
(car (vlax-get b 'InsertionPoint))
)
)
)
)
;******************
(If (> ii (vl-list-length s2))
(Progn
(Alert "So kich thuoc copy nhieu hon so kich thuoc can da'n !")
(command "_.undo" "_end")
(Ext)
)
)
;******************
(setq i1 -1)
(setq s12 "")
(While (> (strlen s11) 0)
(setq s12 (substr s11 1 (vl-string-search "*" s11)))
(setq s11 (vl-string-subst "" (strcat s12 "*") s11))
(vla-put-textstring (nth (setq i1 (1+ i1)) s1) s12)
)
;**********************
(setq s3 "")
(setq i 0)
(setq j 1)
(While (< i (- ii 1))
(While (< j ii)
(if (> (atof (vla-get-textstring (nth i s1))) (atof (vla-get-textstring (nth j s1))))
(Progn
(setq s3 (vla-get-textstring (nth i s1)))
(vla-put-textstring (nth i s1) (vla-get-textstring (nth j s1)))
(vla-put-textstring (nth j s1) s3)
)
)
(setq j (+ 1 j))
)
(setq j (+ 1 i))
(setq i (+ 1 i))
)
(setq n (min (vl-list-length s1) (vl-list-length s2)))
(setq i -1)
(repeat n
(vla-put-textstring
(nth (setq i (1+ i)) s2)
(vla-get-textstring (nth i s1))
)
)
(command "_.undo" "_end")
(princ)
)