Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
 
(defun C:GC (/ ss L e)
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )))
L  0.0
k  (getvar "dimlfac")
)
 
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua...
>>

Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
 
(defun C:GC (/ ss L e)
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )))
L  0.0
k  (getvar "dimlfac")
)
 
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua <1-Text co san / 2-Text moi>: "))
(if (= ans "1")
(progn
(setq te (entget (car (entsel "\n Chon Text de gan ket qua: ")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)
)
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua: "))
(setq h (getreal "\n Nhap chieu cao text ket qua: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 11 p) (cons 40 h) 
(cons 7 (getvar 'textstyle)) (cons 1 (strcat "D-L" (rtos L 2 1) " "))))
;;; (command "text" p h "0" (strcat "D-L" (rtos L 2 1) " "))
)
)
(ssdel e ss)
)
(princ)
)
 

Cái này xuất ra excel file csv thì ok, còn lập bảng kẻ line thì chỉ viết ra kết quả thôi.

(defun c:ton(/ B1 B2 B3 FILE LI N SS TM VT X)
(setq ss (ssget '((0 . "TEXT")))
li nil
file (open (strcat (getvar "dwgprefix") "1.csv") "a")
v0 (ssname ss 0)
n 0
dd (getpoint "\nVi tri dat bang:"))
 
(foreach v (mapcar '(lambda(x) (cdr (assoc 1 (entget x))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (and (setq vt...
>>

Cái này xuất ra excel file csv thì ok, còn lập bảng kẻ line thì chỉ viết ra kết quả thôi.

(defun c:ton(/ B1 B2 B3 FILE LI N SS TM VT X)
(setq ss (ssget '((0 . "TEXT")))
li nil
file (open (strcat (getvar "dwgprefix") "1.csv") "a")
v0 (ssname ss 0)
n 0
dd (getpoint "\nVi tri dat bang:"))
 
(foreach v (mapcar '(lambda(x) (cdr (assoc 1 (entget x))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (and (setq vt (vl-string-search "(" v)) (vl-string-search ")" v))
(progn
(setq b1 (substr v 1 (1- vt))
b2 (substr v (+ 2 vt))
b3 (vl-list->string (vl-remove-if '(lambda(x) (or (= 41 x) (<= 48 x 57))) (vl-string->list b2)))
)
(if (setq tm (assoc b1 li))
(setq li (subst (cons b1 (+ (cdr tm) (atof b2))) tm li))
(setq li (cons (cons b1 (atof b2)) li))
)
)
)
)
(foreach v li
(entmake (list (cons 0 "TEXT") (cons 10 dd) (cons 11 dd) (cons 40 (cdr (assoc 40 (entget v0)))) (cons 8 (cdr (assoc 8 (entget v0))))
(cons 41 (cdr (assoc 41 (entget v0)))) (cons 7 (cdr (assoc 7 (entget v0))))
(cons 72 (cdr (assoc 72 (entget v0)))) (cons 73 (cdr (assoc 73 (entget v0))))
(cons 1 (strcat (itoa (setq n (1+ n))) "\t\t\t" (car v) "\t\t\t" (strcase b3) "\t\t\t" (rtos (cdr v))))))
(write-line (strcat (itoa n) "," (car v) "," (strcase b3) "," (rtos (cdr v))) file)
(setq dd (polar dd (* 1.5 pi) (* 2 (cdr (assoc 40 (entget v0))))))
) 
(close file)
)

Ví dụ: Duy đã có 3 lisp xd xt xmt mỗi lisp bước đầu đều yêu cầu chọn 1 đối tượng duy nhất. Duy muốn gọi lệnh sd thì chọn 1 đối tượng là nó chạy luôn các lệnh xd xt xmt mà không hỏi chọn đối tượng 1 lần nửa (yêu cầu ko sửa lisp xd xt xmt còn lisp sd thì sửa thoải mái)

>>

Cái lisp này viết lâu rồi, chắc vẫn còn xài được. Cad phải có cài Express.

(defun c:dtc (/ v0 el en l tong oe nd)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0...
>>

Cái lisp này viết lâu rồi, chắc vẫn còn xài được. Cad phải có cài Express.

(defun c:dtc (/ v0 el en l tong oe nd)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

;; DIM RotatedDimension UCS TU THIET LAP THEO HUONG DIM
;; THUC HIEN DIM GIONG CACH DIM BANG DIMALIGNED
;;;;BY TDV
(DEFUN C:RDimension(/  lst-var osmodeod Pt1 Pt2 Pt1X Pt1Y Pt2X Pt2Y)
  (setq lst-var (start-defun lst-var))
  (command "undo" "begin") 
  (setq osmodeod (getvar "osmode"))
  (setvar "cmdecho" 0)
  (command "_.ucsicon" "_off")
  (command "_.ucs" "_w")
  (setq Pt1 (getpoint "Specify first extension line origin:")) 
  (setq Pt2 (getpoint...
>>

;; DIM RotatedDimension UCS TU THIET LAP THEO HUONG DIM
;; THUC HIEN DIM GIONG CACH DIM BANG DIMALIGNED
;;;;BY TDV
(DEFUN C:RDimension(/  lst-var osmodeod Pt1 Pt2 Pt1X Pt1Y Pt2X Pt2Y)
  (setq lst-var (start-defun lst-var))
  (command "undo" "begin") 
  (setq osmodeod (getvar "osmode"))
  (setvar "cmdecho" 0)
  (command "_.ucsicon" "_off")
  (command "_.ucs" "_w")
  (setq Pt1 (getpoint "Specify first extension line origin:")) 
  (setq Pt2 (getpoint Pt1"\nSpecify second extension line origin:"))
  (prompt "\nSpecify dimension line location or Exit <Exit>:")
  (setq Pt1X (car Pt1))
  (setq Pt1Y (cadr Pt1))
  (setq Pt1 (list Pt1x Pt1Y 0)) ;;;set Z=0
  (setq Pt2X (car Pt2))
  (setq Pt2Y (cadr Pt2))
  (setq Pt2 (list Pt2x Pt2Y 0)) ;;;set Z=0
  (prompt "\nDimension text = ")
  (prin1 (distance Pt1 Pt2)) ;;; In ket qua ra
  
  
  (setvar "osmode" 0)
  (command "_.ucs" "_p")
  (if (and (= (car (trans Pt1 0 1)) (car (trans Pt2 0 1))) (< (cadr (trans Pt1 0 1)) (cadr (trans Pt2 0 1))))
   (command "_.ucs""_3" (trans Pt1 0 1) (trans Pt2 0 1) (polar (trans Pt1 0 1) (+ (DTR 90) (angle (trans Pt1 0 1) (trans Pt2 0 1))) 5))
   (progn
    (if (< (car (trans Pt1 0 1)) (car (trans Pt2 0 1)))
     (command "_.ucs""_3" (trans Pt1 0 1) (trans Pt2 0 1) (polar (trans Pt1 0 1) (+ (DTR 90) (angle (trans Pt1 0 1) (trans Pt2 0 1))) 5))
     (command "_.ucs""_3" (trans Pt2 0 1) (trans Pt1 0 1) (polar (trans Pt2 0 1) (+ (DTR 90) (angle (trans Pt2 0 1) (trans Pt1 0 1))) 5))
    )
   )
  )
  (setvar "osmode" osmodeod)
  (command "_.DIMLINEAR" "non" (trans Pt1 0 1) "non" (trans Pt2 0 1)  pause)
  (command "_.ucsicon" "_on")
  (command "_.ucs" "_p")
  (done-defun lst-var)
  (command "undo" "end")
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; chuyen goc tu Do sang Radian
(defun DTR (A) (* pi (/ A 180.0)))
;;;;;;;;;;------------------THE END-----------------------;;;;;;;;
;;;;kiem-soat-loi-co-the-phat-sinh-khi-nguoi-dung-nhan-esc-de-thoat-lenh
(defun start-defun (lst-var / err)
 (setvar "cmdecho" 0) 
 (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
 (setq err *error*
       *error* (lambda (msg)
                (redraw)
                (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
                (vl-cmdf "u")
                (setq *error* (car lst-var))))
 (list err (mapcar (function (lambda (x) (list x (getvar x)))) lst-var)));end
 (defun done-defun (lst-var / )
 (mapcar (function (lambda (x) (setvar (car x) (cadr x)))) (cadr lst-var))
 (setq *error* (car lst-var))
 (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
 (princ));

Mình copy mỗi nơi 1 tý góp thành, cứ dim như lệnh DAL nhưng sẽ cho ra dim như khi dim dli.

Thử cái này xem:

(defun c:tt  (/ adoc ent obj)
 (if (setq ent (car (entsel "\nChon 1 doi tuong: ")))
  (progn (setq adoc (vla-get-activedocument (vlax-get-acad-object))
               obj  (vlax-ename->vla-object ent))
         (mapcar...
>>

Thử cái này xem:

(defun c:tt  (/ adoc ent obj)
 (if (setq ent (car (entsel "\nChon 1 doi tuong: ")))
  (progn (setq adoc (vla-get-activedocument (vlax-get-acad-object))
               obj  (vlax-ename->vla-object ent))
         (mapcar 'setvar
                 '("CLAYER" "CELTYPE" "CECOLOR")
                 (mapcar '(lambda (x) (vl-princ-to-string (vlax-get obj x))) '("Layer" "Linetype" "Color")))
         (cond ((wcmatch (strcase (vla-get-ObjectName obj)) "*TEXT") (setvar 'TEXTSTYLE (vlax-get obj 'StyleName)))
               ((wcmatch (strcase (vla-get-ObjectName obj)) "*DIMENSION")
                (vla-put-activedimstyle adoc (vla-item (vla-get-dimstyles adoc) (vlax-get obj 'StyleName)))
                (setvar 'DIMSCALE (vlax-get obj 'ScaleFactor))))))
 (princ))

Em xin gửi bản vẽ. Nhờ các anh em giúp em sớm! Em xin cảm ơn!

 

 

http://www.cadviet.com/upfiles/6/147694_xref_tmb_pa1.dwg

Dùng lisp này:

(defun C:test ( / e i...
>>

Em xin gửi bản vẽ. Nhờ các anh em giúp em sớm! Em xin cảm ơn!

 

 

http://www.cadviet.com/upfiles/6/147694_xref_tmb_pa1.dwg

Dùng lisp này:

(defun C:test ( / e i ss)
(setq ss (ssget '((0 . "DIMENSION"))) i 0)
(repeat (sslength ss)
(setq e (entget (ssname ss i)) i (1+ i))
(entmod (subst (cons 51 0) (assoc 51 e) e)) )
)

Mấy hôm nay bận nên Rep bạn hơi muộn ^^

Chúc công việc suôn sẻ !

;lisp trai vai dia
;=================================
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)	
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))									
				(cons 48 (if LTScale LTScale...
>>

Mấy hôm nay bận nên Rep bạn hơi muộn ^^

Chúc công việc suôn sẻ !

;lisp trai vai dia
;=================================
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)	
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))									
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				'(100 . "AcDbPolyline")									
				(cons 90 (length listpoint))									
				(cons 70 (if closed 1 0))))	
(foreach PP listpoint	
	(setq Lst (append Lst (list (cons 10 PP))))
	)	
				(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))	
				(entmakex Lst)
)	;end
;===================================
(defun get_lst_vertex (PL / lst)
	(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget PL))))
	(if (< (car (car lst)) (car (last lst))) lst (reverse lst))
)
;=============================================================================================
(defun c:TRAI ( / cmd ss_coc ins_point ss lst_ver len i)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(prompt "\nQuet chon trac ngang: ")
(setq ss_coc (ssget '((0 . "TEXT") (8 . "entdauco") (1 . "C*c:*"))))
(if ss_coc 
	(progn
		(setq ss_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_coc))))
		(foreach coc ss_coc
			(setq ins_point (cdr (assoc 11 (entget coc)))
				  ss (ssget "_W" (list (- (car ins_point) 17) (- (cadr ins_point) 15)) (list (+ (car ins_point) 17) (cadr ins_point))
						(list (cons 8 "VetHuuCo,Danh cap"))))
			(if ss
				(progn
					(setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
						  ss (vl-sort ss '(lambda (x y)  (< (car (car (get_lst_vertex x))) (car (car (get_lst_vertex y))))))
					)
					(setq lst_ver (get_lst_vertex (car ss)))
					(cond 
						((> (setq len (length ss)) 1)
							(setq i 0)
							(repeat (- len 1)
								(setq lst_ver (reverse (cdr (reverse lst_ver)))
									lst_ver (append lst_ver (cdr (get_lst_vertex (nth (setq i (1+ i)) ss))))
								)
							)
						)
					)
					(setq lst_ver 
						(append 
							(list (list (1+ (car (car lst_ver))) (cadr (car lst_ver))))
							lst_ver 
							(list (list (1- (car (last lst_ver))) (cadr (last lst_ver))))
						))
					(MakeLWPolyline lst_ver nil nil nil "Vai_dia_KT" 4 nil)
				)
			)
		)
	)
)
(setvar 'cmdecho cmd)
(princ)
)

Bác giúp em cái này này! Lưu ý:

1/ Trong chữ phải có cụm "- L" (giữa - và L có dấu cách.

2/ Lsp không biết đổi đơn vị, cho nên các cụm từ muốn tính phải có cùng đơn vị (hoặc đều là m, dm, cm, mm)

(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj (ss1 MyType / ss2 i e)
(setq ss2...
>>

Bác giúp em cái này này! Lưu ý:

1/ Trong chữ phải có cụm "- L" (giữa - và L có dấu cách.

2/ Lsp không biết đổi đơn vị, cho nên các cụm từ muốn tính phải có cùng đơn vị (hoặc đều là m, dm, cm, mm)

(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 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)

Do trong file của bạn để units là meters khác với unitless nên giá trị bị sai, bạn chép lại lsp.

(defun c:dtc (/ v0 el en l tong oe nd un)
  (setq oe (getvar 'cmdecho)
un (getvar 'insunits))
  (setvar 'cmdecho 0)
  (setvar 'insunits 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
 nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 ""...
>>

Do trong file của bạn để units là meters khác với unitless nên giá trị bị sai, bạn chép lại lsp.

(defun c:dtc (/ v0 el en l tong oe nd un)
  (setq oe (getvar 'cmdecho)
un (getvar 'insunits))
  (setvar 'cmdecho 0)
  (setvar 'insunits 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
 nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
 l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
(setvar 'insunits un)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

Đặt nó vào trong 1 cái if.

(defun C:TLN()
;Viet ham tinh toan bo PL thuoc layer
 
;Chon doi tuong mau de layer tinh chieu dai
(command "UCS" "W")
(setq lay (cdr (assoc 8 (entget (car (entsel "\n Chon doi tuong lay layer tinh khoi luong:\n"))))))
(princ (strcat"\nDoi tuong lay layer tinh khoi luong la:" lay "\n"))
(setq txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau de dien khoi luong: "))))))
(princ (strcat"\nHang muc...
>>

Đặt nó vào trong 1 cái if.

(defun C:TLN()
;Viet ham tinh toan bo PL thuoc layer
 
;Chon doi tuong mau de layer tinh chieu dai
(command "UCS" "W")
(setq lay (cdr (assoc 8 (entget (car (entsel "\n Chon doi tuong lay layer tinh khoi luong:\n"))))))
(princ (strcat"\nDoi tuong lay layer tinh khoi luong la:" lay "\n"))
(setq txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau de dien khoi luong: "))))))
(princ (strcat"\nHang muc tinh khoi luong la:" txt))
(setq ss3 (ssget "_X" '((0 . "*POLYLINE")(8 . "PLINETNTN"))))
(setq ss4 (ssget "_X" '((0 . "*LINE")(8 . "ENTDAUCO"))))
(if (setq ss (ssget "_X" '((0 . "TEXT")(8 . "ENTDAUCO")(1 . "Cäc:*"))))
(progn
(setq n (sslength ss))
(setq i 0)
(while (< i n)
 (setq e (entget(ssname ss i)))
(setq p  (cdr (assoc 10 e)) 
x  (rtos (car p));Toa do X 
y  (rtos (cadr p)); Toa do Y
)
(Setq A (length1 (ssname ss3 1)))
(Setq A (/ A 2))
(Setq c (length1 (ssname ss4 1)))
(setq p1 (list (- (car p) A ) (- (cadr p) c)))
(setq p2 (list (+ A (car p)) (cadr p)))
(command "zoom" "w" p1 p2)
;------- Tinh tong cac doi tuong
(progn
      (setq l 0.0)
      (repeat (setq j (sslength ss2))
          (setq e1 (ssname ss2 (setq j (1- j)))
                l (+ l (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1)))
          )
      )
     (setq e1 (entget(ssname ss1 0)))
     (setq e1 (subst (cons 1 (rtos l 2 2)) (assoc 1 e1) e1))
     (entmod e1);; Thay noi dung cua doi tuong
)
   (setq i (1+ i))
);; while
)
)
(command "undo" "end")
(princ)
)

gửi bạn. lệnh là a1

Bạn xem rồi sửa lại các điều kiện biên cho đúng (bản vẽ điều kiện <, yêu cầu trên 4r lại là <= )

(defun c:a1( / k CV:ss-to-list)
  (defun CV:ss-to-list (ss vla / n e l)
    (if	ss
      (progn
	(setq n (sslength ss))
	(while (setq e (ssname ss (setq n (1- n))))
	  (setq	l (cons	(if vla
			  (vlax-ename->vla-object e)
			  e
			)
			l
		  )
	  )
	)
      )
    )
  )
  (command...
>>

gửi bạn. lệnh là a1

Bạn xem rồi sửa lại các điều kiện biên cho đúng (bản vẽ điều kiện <, yêu cầu trên 4r lại là <= )

(defun c:a1( / k CV:ss-to-list)
  (defun CV:ss-to-list (ss vla / n e l)
    (if	ss
      (progn
	(setq n (sslength ss))
	(while (setq e (ssname ss (setq n (1- n))))
	  (setq	l (cons	(if vla
			  (vlax-ename->vla-object e)
			  e
			)
			l
		  )
	  )
	)
      )
    )
  )
  (command ".undo" "be")
  (mapcar '(lambda (y)
	      (mapcar '(lambda (x)
			 (if (and (= (vla-get-tagstring x) "E")
				  (distof(setq k (vla-get-textstring x)))
				  )
			   (progn
			     (setq k (atof k))
			     (cond
			       ((<= k 40)(vla-put-textstring x "F07"))
			       ((<= k 95)(vla-put-textstring x "F12"))
			       ((<= k 150)(vla-put-textstring x "F18"))
			       ((<= k 200)(vla-put-textstring x "F23"))
			       )
			     )
			   )
			 
			 )(vlax-invoke y 'GetAttributes))
	      )
	   (CV:ss-to-list (SSGET (list (cons 0  "INSERT")(cons 2 "HABA")(cons 66 1))) t)
   )
  (command ".undo" "en")
  (princ)
  )

Chào các bạn trên diễn đàn cadviet.com, mình có sưu tầm được 1 lsp dùng để đóng mở ngoặc của text của bạn ketxu. Bây giờ mình muốn mọi người giúp mình sữa lại sao cho khi ta goi lệnh và chọn vào đối tượng thì đối tượng đươc đóng ngoặc, chọn đối tượng lần nữa thì bỏ đóng ngoặc(lsp đang dùng thì mỗi lần chọn thì nó cứ đóng ngoặc). Và lsp thì chọn đối...

Chào các bạn trên diễn đàn cadviet.com, mình có sưu tầm được 1 lsp dùng để đóng mở ngoặc của text của bạn ketxu. Bây giờ mình muốn mọi người giúp mình sữa lại sao cho khi ta goi lệnh và chọn vào đối tượng thì đối tượng đươc đóng ngoặc, chọn đối tượng lần nữa thì bỏ đóng ngoặc(lsp đang dùng thì mỗi lần chọn thì nó cứ đóng ngoặc). Và lsp thì chọn đối tượng text là tiếng việt thì bị lỗi font. Mong mọi người giúp đỡ.

(defun c:fg(/ s sd)
(vl-load-com)
(ssget '((0 . "*TEXT,*DIMENSION")))
(vlax-for o (setq s(vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
	(cond 
		(	(wcmatch (vla-get-ObjectName o) "*Text")
			(vla-put-Textstring o (strcat "(" (vla-get-Textstring o) ")"))
		)
		((vla-put-TextOverride o
			(strcat
"("
					(if (/= (setq sd (vla-get-TextOverride o)) "") sd "<>")
")"
			)
		))			
	)
)
(and s (vla-delete s))
)
 

(defun c:tt  (/ els pos ss str)
 (and (setq ss (ssget '((0 . "*TEXT"))))
      (foreach x  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq els (entget x))
       (setq str (cdr (assoc 1 els)))
       (if (vl-string-search (chr 40) (strcase...
>>

(defun c:tt  (/ els pos ss str)
 (and (setq ss (ssget '((0 . "*TEXT"))))
      (foreach x  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq els (entget x))
       (setq str (cdr (assoc 1 els)))
       (if (vl-string-search (chr 40) (strcase str))
        (while (setq pos (vl-string-search (chr 40) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat (chr 40) str)))
       (entmod (subst (cons 1 str) (assoc 1 els) els))
       (if (vl-string-search (chr 41) (strcase str))
        (while (setq pos (vl-string-search (chr 41) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat str (chr 41))))
       (entmod (subst (cons 1 str) (assoc 1 els) els))))
 (princ))

Bạn thử Lisp này: 

(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
  (setq i 0)
  (mapcar 'set '(find rep str icase) Lst)
  (while (setq i (vl-string-search (if icase (strcase find) find)
  (if icase (strcase str) str) i))
    (if icase
(setq str (vl-string-subst (strcase find) find str i)
  str (vl-string-subst rep (strcase find) str i))
   ...
>>

Bạn thử Lisp này: 

(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
  (setq i 0)
  (mapcar 'set '(find rep str icase) Lst)
  (while (setq i (vl-string-search (if icase (strcase find) find)
  (if icase (strcase str) str) i))
    (if icase
(setq str (vl-string-subst (strcase find) find str i)
  str (vl-string-subst rep (strcase find) str i))
        (setq str (vl-string-subst rep find str i))
    )
    (setq i (+ i (strlen rep) ) ) )
str)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
  (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 c:md()
  (if (setq ss (ssget '((0 . "*TEXT,*DIMENSION")))) (progn
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (if (and (wcmatch (setq nd (cdr(assoc 1 (entget e)))) "*(*")
    (wcmatch nd "*)*")
)
      (Tue-ent-mod 1 e (Tue-string-replace (list ")" "" (Tue-string-replace (list "(" "" nd)))))
      (Tue-ent-mod 1 e (strcat "(" nd ")"))
     )
   )
 ))
)