Đại loại nó là thế này (???):

(defun c:mrlayout (/ i laylst pe1 pe2 ss txt)
  (setq pe1 (getpoint "\ngoc tren ben trai :")
	pe2 (getcorner pe1 "\ngoc duoi ben phai :")
	i 0 layLst (layoutlist) )
  (while (< i (length layLst))
    (command "layout" "set" (nth i layLst))
    (if (setq ss (ssget "_c" pe1 pe2 (list(cons 0 "text"))))
      (progn
	(setq txt (cdr (assoc 1 (entget (ssname ss 0)))))
	(if (snvalid txt)
	  (command "layout" "r" ""...
>>

Đại loại nó là thế này (???):

(defun c:mrlayout (/ i laylst pe1 pe2 ss txt)
  (setq pe1 (getpoint "\ngoc tren ben trai :")
	pe2 (getcorner pe1 "\ngoc duoi ben phai :")
	i 0 layLst (layoutlist) )
  (while (< i (length layLst))
    (command "layout" "set" (nth i layLst))
    (if (setq ss (ssget "_c" pe1 pe2 (list(cons 0 "text"))))
      (progn
	(setq txt (cdr (assoc 1 (entget (ssname ss 0)))))
	(if (snvalid txt)
	  (command "layout" "r" "" txt)  )) )
    (setq i(1+ i)))
  (princ))

Ái dà! Nó còn 1 dòng lỗi nữa mà bạn không thông báo.
; error: bad function: #<SUBR @098d7b68 -lambda->
Thôi thì, đành lấy cái này vậy. Cũng chính là lisp đó, tôi down về rồi sửa gì để hết lỗi thì bây giờ quên mất. Bạn dùng nó nhé!

;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
;;; UPDATE BY KETXU (04/04/2012)
;;; Creates a "Wipeout" from an object (circle,...
>>

Ái dà! Nó còn 1 dòng lỗi nữa mà bạn không thông báo.
; error: bad function: #<SUBR @098d7b68 -lambda->
Thôi thì, đành lấy cái này vậy. Cũng chính là lisp đó, tôi down về rồi sửa gì để hết lỗi thì bây giờ quên mất. Bạn dùng nó nhé!

;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
;;; UPDATE BY KETXU (04/04/2012)
;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs)
;;; Works whatever the current ucs and object OCS
;http://xaydungit.vn/diendan/showthread.php?7784-Wipe-PLine-v%C3%A0-b%E1%BA%ADt-t%E1%BA%AFt-nhanh-Wipeout&p=14880779#post14880779
;----- Chuyen ss thanh cac Wipeout.
(defun c:ob2wo (/ ent lst nor ss)
  (vl-load-com)
  (if  (setq ss (ssget (list (cons 0 "CIRCLE,ELLIPSE,LWPOLYLINE"))))    
    (progn
      (vla-StartundoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
      )
        (initget "Yes No")      
        (setq ans (getkword "\nDelete source object?  <No>: "))      
      (foreach ent (ST:Ss->ListEnt ss)
        (setq lst (ent2ptlst ent))
        (setq nor (cdr (assoc 210 (entget ent))))    
        (makeWipeout lst nor)
        (if (or (not ans) (wcmatch (strcase ans) "YES"))(entdel ent))
      )
      (vla-EndundoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
      )
    )
  )
)
;----- Bat/Tat qua lai giua Wipeout va Pline
;; WOF (gile)
;; Toggles wipeout frames
(defun c:wof (/ elst)
  (cond
    ((and
        (setq elst (dictsearch (namedobjdict) "ACAD_WIPEOUT_VARS"))
        (ssget "x" '((0 . "WIPEOUT,INSERT")))
    )
    (entmod    (subst    (cons 70 (boole 6 (cdr (assoc 70 elst)) 1))    (assoc 70 elst)    elst))
    (vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
        (vla-update obj)
    )
  )
    (T (princ "\nHave no wipeout object !"))
    )
  (princ)
)
;----- Chuyen cac Wipeout thanh Pline
;; WO2PL (gile)
;; Re-creates a wipeout boundary (lwpolyline)
(defun c:wo2pl (/ ss n wo elst pts norm ans)
  (if (setq ss (ssget '((0 . "WIPEOUT"))))
  (progn
    (initget "Yes No")      
    (setq ans (getkword "\nDelete source object?  <No>: "))    
    (foreach wo    (ST:Ss->ListEnt ss)    
      (setq
        elst (entget wo)
        norm (vunit (v^v (cdr (assoc 11 elst)) (cdr (assoc 12 elst))))
        pts 	(wipeout2plst wo)
      )
      (entmake
    (append
      (list    '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 90 (length pts))
        (cons 38 (caddr (trans (car pts) 0 norm)))
        '(70 . 1)
        (cons 210 norm)
      )
      (mapcar '(lambda (pt)
         	(setq pt (trans pt 0 norm))
         	(list 10 (car pt) (cadr pt))
       	)
          pts
      )
    )
      )
      (if (or (not ans) (wcmatch (strcase ans) "YES"))(entdel wo))
(princ)      
  )))  
)
;;==================SUB ROUTINES==================;;
;; returns the wipeout point list (WCS)
(defun wipeout2plst (wo / elst u v mat)
  (setq    elst (entget wo)
    u    (cdr (assoc 11 elst))
    v    (cdr (assoc 12 elst))
    mat  (list u (mapcar '- v) '(0. 0. 1.))
  )
  (mapcar
    '(lambda (p)
   	(mapcar '+
       	(mxv (trp mat) p)
       	(mapcar '(lambda (x y) (/ (+ x y) 2.)) u v)
       	(cdr (assoc 10 elst))
   	)
 	)
    (cdr
      (mapcar 'cdr
          (vl-remove-if-not '(lambda (x) (= (car x) 14)) elst)
      )
    )
  )
)
;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
;; V^V
;; Returns the cross product of 2 vectors
(defun v^v (v1 v2)
  (list    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
    (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
    (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  )
)
;; VUNIT
;; Returns the single unit vector
(defun vunit (v)
  ((lambda (l)
 	(if (/= 0 l)
   	(mapcar (function (lambda (x) (/ x l))) v)
 	)
   )
    (distance '(0 0 0) v)
  )
)
 
 
;;; ENT2PTLST
;;; Returns the vertices list of the polygon figuring the curve object
;;; Coordinates defined in OCS
 
(defun ent2ptlst (ent / obj dist n lst p_lst prec)
  (vl-load-com)
  (if (= (type ent) 'ENAME)
    (setq obj (vlax-ename->vla-object ent))
  )
  (cond
    ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
 	(setq dist    (/ (vlax-curve-getDistAtParam
         	obj
         	(vlax-curve-getEndParam obj)
       	)
       	50
        )
   	n    0
 	)
 	(repeat 50
   	(setq
 	lst
      (cons
        (trans
          (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
          0
          (vlax-get obj 'Normal)
        )
        lst
      )
   	)
 	)
    )
    (T
 	(setq p_lst (vl-remove-if-not
       	'(lambda (x)
              (or (= (car x) 10)
              (= (car x) 42)
              )
            )
       	(entget ent)
     	)
 	)
 	(while p_lst
   	(setq
 	lst
      (cons
        (append (cdr (assoc 10 p_lst))
            (list (cdr (assoc 38 (entget ent))))
        )
        lst
      )
   	)
   	(if (/= 0 (cdadr p_lst))
 	(progn
   	(setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
     	dist (/ (- (if    (cdaddr p_lst)
                  (vlax-curve-getDistAtPoint
                obj
                (trans (cdaddr p_lst) ent 0)
                  )
                  (vlax-curve-getDistAtParam
                obj
                (vlax-curve-getEndParam obj)
                  )
                )
                (vlax-curve-getDistAtPoint
                  obj
                  (trans (cdar p_lst) ent 0)
                )
         	)
         	prec
              )
     	n    0
   	)
   	(repeat (1- prec)
     	(setq
       	lst (cons
         	(trans
           	(vlax-curve-getPointAtDist
         	obj
         	(+ (vlax-curve-getDistAtPoint
                  obj
                  (trans (cdar p_lst) ent 0)
                )
                (* dist (setq n (1+ n)))
         	)
           	)
           	0
           	ent
         	)
         	lst
       	)
     	)
   	)
 	)
   	)
   	(setq p_lst (cddr p_lst))
 	)
    )
  )
  lst
)
 
 
;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object
 
(defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)
  (if (not (member "acwipeout.arx" (arx)))
    (arxload "acwipeout.arx")
  )
  (setq    dxf10 (list (apply 'min (mapcar 'car pt_lst))
            (apply 'min (mapcar 'cadr pt_lst))
            (caddar pt_lst)
          )
  )
  (setq
    max_dist
 	(float
   	(apply 'max
          (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
   	)
 	)
  )
  (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
  (setq
    dxf14 (mapcar
        '(lambda (p)
       	(mapcar '/
           	(mapcar '- p cen)
           	(list max_dist (- max_dist) 1.0)
       	)
     	)
        pt_lst
      )
  )
  (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
  (entmake (append (list '(0 . "WIPEOUT")
         	'(100 . "AcDbEntity")
         	'(100 . "AcDbWipeout")
         	'(90 . 0)
         	(cons 10 (trans dxf10 nor 0))
         	(cons 11 (trans (list max_dist 0.0 0.0) nor 0))
         	(cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
         	'(13 1.0 1.0 0.0)
         	'(70 . 7)
         	'(280 . 1)
         	'(71 . 2)
         	(cons 91 (length dxf14))
       	)
       	(mapcar '(lambda (p) (cons 14 p)) dxf14)
   	)
  )
)
 
(defun ST:Ss->ListEnt (ss / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))
    (setq l (cons e l))
  )  
) 

thank bác.e đã thử wipeout vật thể có chứa arc và ok.

à, nhân tiện cho em hỏi có bác nào có lisp tự động vẽ viền bo ngoài của 1 vật thể ko, ví dụ e có 1 block có hình dạng phức tạp nhưng chỉ muốn tạo viền bo ngoài của vật thể đó để sau đó dùng wipeot cho block đó nổi lên trên các đối tượng khác

Lisp Modify các Mline trên bản vẽ theo Mlstyle Current.

Cách sử dụng:

1). Tạo Mlstyle theo ý muốn, sau đó Set Current.

2). Dùng Lisp.

;;;-----------------------------------------
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can...
>>

;;;-----------------------------------------
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can tinh:")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:MUL( / i m e ss)
(SelData) (setq i 0 m 1.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))
(WriteRes m)
)
;;;-----------------------------------------
(defun C:SUM( / i s e ss)
(SelData) (setq i 0 s 0.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))
(WriteRes s)
)
;;;-----------------------------------------

1/ Mô tả lisp trên

+ Tính tổng các số dạng text số

+ Kết quả : Pick chọn text có sẵn để ghi kết quả

2/ Giúp mình sửa lại như sau :

+ Kết quả trả về sẽ hiện ở vùng bên trên vùng Command (giống kết quả của lệnh "di")

Thanks !

Xét lại thì tất cả các hình đều có lý của nó ^^ Ket vẫn dạy học sinh là k được Hatch Select Object các đối tượng mà tự thân nó k kín, giờ vẫn giữ quan điểm đó ^^ (trừ TH đặc biệt), k biết đến bao giờ thì thay đổi.

Vụ dính vào nhau thì hatch riêng chắc sẽ ổn thôi 

(defun c:hp()
(setq ss (ssget (list (cons 0 "*POLYLINE"))) i -1)
(while (setq e (ssname ss (setq i...
>>

Xét lại thì tất cả các hình đều có lý của nó ^^ Ket vẫn dạy học sinh là k được Hatch Select Object các đối tượng mà tự thân nó k kín, giờ vẫn giữ quan điểm đó ^^ (trừ TH đặc biệt), k biết đến bao giờ thì thay đổi.

Vụ dính vào nhau thì hatch riêng chắc sẽ ổn thôi 

(defun c:hp()
(setq ss (ssget (list (cons 0 "*POLYLINE"))) i -1)
(while (setq e (ssname ss (setq i (1+ i)))) (command ".-Hatch" "s" e "" ""))
)

Còn vụ thế nào là kín thì tuỳ OP quy định, ket hem ý kiến

Anh có thể cho xuất ra text sẵn có và đổi thành màu đỏ được ko ạ?

bạn có thể dùng cái này để đo và xuất luôn ra Dim có Layer và kích thước màu đỏ cũng được

(defun C:DIMARC ( / pt1 pt2 cen a1 a2 D1 D2 p r oldOs)
 (setq oldOs (getvar "OSMODE"))
 (prompt "Pick 2 points on an arc - ")
...
>>

Anh có thể cho xuất ra text sẵn có và đổi thành màu đỏ được ko ạ?

bạn có thể dùng cái này để đo và xuất luôn ra Dim có Layer và kích thước màu đỏ cũng được

(defun C:DIMARC ( / pt1 pt2 cen a1 a2 D1 D2 p r oldOs)
 (setq oldOs (getvar "OSMODE"))
 (prompt "Pick 2 points on an arc - ")
 (setvar "OSMODE" 512)
   (COMMAND "-LAYER" "m" "Dim" "color" 1 "" "")(PRINC)
 (while (not cen)
  (setq   pt1 (getpoint "1st pt: ")
   cen (osnap pt1 "_CEN")
  )
  (if (not cen) (alert "Doesn't lie on an arc, retry")
      (setq pt2 (getpoint cen " 2nd pt: ")))
 );while
 (setvar "OSMODE" 0)
 (setq a1 (angle cen pt1) a2 (angle cen pt2) ad (abs (- a2 a1))
   r (distance pt1 cen)
   D1 (* r ad)
   D2 (* r (- (* 2 pi) ad)) )
 (prompt (strcat "\nArc length: " (rtos D1) ",   complementar arc: " (rtos D2))) 
 (command "_DIMANGULAR" "" cen pt1 pt2 "_T" (rtos D1) pause)
 (setvar "OSMODE" oldOs)
 (prin1))
(princ "\nDIMARC command loaded.")
(princ)

bạn thử dùng cái này có được không:

(DEFUN C:DT1(/ A)
  (SETQ A (GETPOINT "CHON DIEM : "))
  (COMMAND "BOUNDARY" A "")
  (COMMAND "AREA" "O" (SSGET "L"))
  (COMMAND "ERASE" (SSGET "L") "")
 (command "-style" "text" "Times New Roman" 2.5 "1" "0" "n" "n") ;;;;Muon sua Text to hay nho 2.5 ...
  (command "-layer" "m" "Text""c" "White" "" "")
(setq e_lst (entget (tblobjname "style" (getvar 'textstyle))))
(entmod (subst (cons 50 0.261799) (setq...
>>

bạn thử dùng cái này có được không:

(DEFUN C:DT1(/ A)
  (SETQ A (GETPOINT "CHON DIEM : "))
  (COMMAND "BOUNDARY" A "")
  (COMMAND "AREA" "O" (SSGET "L"))
  (COMMAND "ERASE" (SSGET "L") "")
 (command "-style" "text" "Times New Roman" 2.5 "1" "0" "n" "n") ;;;;Muon sua Text to hay nho 2.5 ...
  (command "-layer" "m" "Text""c" "White" "" "")
(setq e_lst (entget (tblobjname "style" (getvar 'textstyle))))
(entmod (subst (cons 50 0.261799) (setq old (assoc 50 e_lst)) e_lst))
  (command "text" "j" "tl" A "" (strcat "DT: " (rtos (/ (* (GETVAR "AREA") 10) 10) 2 2) " m²"))
(entmod (subst old (assoc 50 e_lst) e_lst))
  (PRINC "\nDIEN TICH LA : ")(PRINC  (/ (* (GETVAR "AREA") 10) 10))(PRINC" m²")(prompt "\nDA TINH XONG DIEN TICH!")(princ))

;; Write CSV - Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - list of lists, sublist is row of cell values
;; csv - filename of CSV file to write
;; Returns T if successful, else nil

(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep)...

;; Write CSV - Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - list of lists, sublist is row of cell values
;; csv - filename of CSV file to write
;; Returns T if successful, else nil

(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)

;; List -> CSV - Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - list containing row of CSV cell values
;; sep - CSV separator token

(defun LM:lst->csv ( lst sep )
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)

(defun LM:csv-addquotes ( str sep / pos )
(cond
( (wcmatch str (strcat "**"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
( str )
)
)
(defun C:ttt(/ e obj pt pt1 dis lt lst)
(vl-load-com)
(setq e (car (entsel "Chon PL")))
(setq obj (vlax-ename->vla-object e))
(setq lst (list (list "Lytrinh" "Cach tim" "Toa do X" "Toa do Y")))
(while (setq pt (getpoint "\nPick diem"))
(setq pt1 (vlax-curve-getClosestPointTo obj pt))
(setq dis (distance pt pt1))
(setq lt (vlax-curve-getDistAtPoint obj pt1))
(princ (strcat "Ly trinh = " (rtos lt 2 2) "\nKhoach cach den tim = " (rtos dis 2 2)))
(setq lst (cons (list (rtos lt 2 2) (rtos dis 2 2) (rtos (car pt1) 2 3) (rtos (cadr pt1) 2 3)) lst))
)
(if (and
(setq fn (getfiled "Create Output File" "" "csv" 1))
(LM:WriteCSV (reverse lst) fn)
)
(startapp "explorer" fn)
)

)

Trong lúc chờ đợi bác Phamthanhbinh có 1 lisp chuẩn hơn. Tôi làm sơ bộ cho bạn như thế này. Có thể chữa cháy trước mắt cho yêu cầu của bạn. Hì hì

Nhân đề nghị của anh 2 lúa cad nông dân bên trên tôi làm thêm 1 bước nữa, chỉ cần đánh lệnh test nó sẽ tự động nối line,arc.

Nhưng tôi chưa có file line arc số lượng lớn để test, bạn nào có file lớn đưa lên để test thử. File lisp như sau:

(defun c:test(/ kc L1 L2 tieptuc tm1 tm2 tm ng obj)
  (defun noithem(d v kc tr / tm tm1)
    (if (setq tm (car...
>>

Nhân đề nghị của anh 2 lúa cad nông dân bên trên tôi làm thêm 1 bước nữa, chỉ cần đánh lệnh test nó sẽ tự động nối line,arc.

Nhưng tôi chưa có file line arc số lượng lớn để test, bạn nào có file lớn đưa lên để test thử. File lisp như sau:

(defun c:test(/ kc L1 L2 tieptuc tm1 tm2 tm ng obj)
  (defun noithem(d v kc tr / tm tm1)
    (if (setq tm (car (vl-remove nil
(mapcar '(lambda(x) (if (and (/= v (cadar x))
    (or (<= (distance d (car x)) kc) (<= (distance d (last x)) kc))) x nil)) L1))))
    (if (or (and tr (<= (distance d (car tm)) kc)) 
            (and (not tr) (<= (distance d (last tm)) kc)))
    (setq ng t tm1 (reverse tm))
    (setq ng nil tm1 tm)))
  )
  
  (defun ssfrom (sl / ss0) (setq ss0 (ssadd)) (foreach v sl (ssadd v ss0)) ss0)
  ;;;
  (setq kc (getreal "\nNhap khoang ho cho phep de noi:")
L1 (mapcar '(lambda(x) (list (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object x))) x
(vlax-curve-getEndPoint obj))) (acet-ss-to-list (ssget "X" '((0 . "LINE,ARC")))))
L2 (list (car L1))
L1 (cdr L1))
  (setvar "cmdecho" 0)
  (while L1
    (setq tieptuc t)
    (while tieptuc      
      (if (setq tm1 (noithem (caar L2) (cadar L2) kc t))
        (setq L2 (cons tm1 L2) L1 (vl-remove (if ng (reverse tm1) tm1) L1)))
      (if (setq tm2 (noithem (last (last L2)) (cadr (last L2)) kc nil))
        (setq L2 (append L2 (list tm2)) L1 (vl-remove (if ng (reverse tm2) tm2) L1)))
      (if (and (not tm1)(not tm2))
(setq tieptuc nil
     tm (COMMAND ".PEDIT" "M" (ssfrom (mapcar 'cadr L2)) ""  "Y" "J" kc "")
     L2 (list (car L1))
     L1 (cdr L1)))
    )
  )
  (setvar "cmdecho" 1)
)
 

Của bạn đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
 ...
>>

Của bạn đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
dd (getpoint "\nDiem cuoi cua Polyline:")
cd (getreal "\nNhap buoc de rai:")
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
sl (getint "\nSo luong coc rai")
ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)

Còn Lisp này hỏi nhập độ rộng mới -> chọn Text  -> sẽ thay đổi độ rộng cho Text

(defun c:tf(/ ss tw)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
  ;;;;;Ex: (Tue-ent-mod 1 (ssname (TUE-ss-entsel '((0 . "TEXT")) "\npick chon doi tuong TEXT / An phim bat ki de thoat :")  0)"TUE")
  ;;;;;;;;-->> Thay Text thanh chuoi "TUE"
  ;;;;;;;;dxf = 62 ma mau object; dxf = 6 ma Linetype cuar object
 ...
>>

Còn Lisp này hỏi nhập độ rộng mới -> chọn Text  -> sẽ thay đổi độ rộng cho Text

(defun c:tf(/ ss tw)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
  ;;;;;Ex: (Tue-ent-mod 1 (ssname (TUE-ss-entsel '((0 . "TEXT")) "\npick chon doi tuong TEXT / An phim bat ki de thoat :")  0)"TUE")
  ;;;;;;;;-->> Thay Text thanh chuoi "TUE"
  ;;;;;;;;dxf = 62 ma mau object; dxf = 6 ma Linetype cuar object
  (setq entget-ename (entget ename))
  (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
          (setq entget-ename (append entget-ename (list (cons dxf newValue))))
  )
  (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
  (entmod entget-ename)
  ename
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
 
  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
          (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  )
)
(if (setq ss (ssget '((0 . "TEXT"))))
  (progn
    (setq tw (getreal "\n Nhap do rong chu :"))
    (foreach x (Tue-ss-list (list ss))
      (Tue-ent-mod 41 x tw)
    )
  )
)
)

Bạn dùng lisp này, nhập độ rộng hiện tại , chọn text , nó sẽ bắt các text có độ rộng đó, sau đó bạn muốn làm gì thì vào properties.

Bạn chọn 4 text màu vàng rồi enter 1 cái, nó xuất ra file "dao dap.txt" ở thư mục cùng file cad.

Mỗi lần chọn 4 text rồi enter. Muốn dứt lệnh thì enter thêm cái nữa.

Tôi không biết đưa ra excel thế nào nên chỉ đưa ra txt thôi.