Jump to content
InfoFile
Tác giả: Tot77
Bài viết gốc: 404259
Tên lệnh: gc
Sửa Lisp Để Tương Thích Với Autocad Đời

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)
)
 

<<

Filename: 404259_gc.lsp
Tác giả: Tot77
Bài viết gốc: 404261
Tên lệnh: ton
Lisp tính tổng các text

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)
)

<<

Filename: 404261_ton.lsp
Tác giả: duy782006
Bài viết gốc: 404302
Tên lệnh: xt xmt xd sd
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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)

>>

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)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chon mot doi tuong bat ky
;;;Cu phap su dung (duy:c_doituong<m mdich)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:c_doituong<m (mdich / mdich dchon)
(princ (strcat "\nChon doi tuong " mdich " !"))
(setq dchon (car (entsel)))
(while
(null dchon)
(princ (strcat "\nChua chon duoc doi tuong. Chon doi tuong " mdich " !"))
(setq dchon (car (entsel)))
)
dchon)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:xt ()
(setq dtcd (duy:c_doituong<m "muon sua"))
(command ".erase" dtcd "")
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:xmt ()
(setq dtcd (duy:c_doituong<m "muon sua"))
(command ".erase" dtcd "")
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:xd ()
(setq dtcd (duy:c_doituong<m "muon sua"))
(command ".erase" dtcd "")
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:sd ()
(setq dtcd (duy:c_doituong<m "muon sua"))
(setq doituongs (entget dtcd))
(setq KIEUDOITUONG (cdr (assoc 0 doituongs)))

(Cond
((= KIEUDOITUONG "TEXT") (c:xt)  )
((= KIEUDOITUONG "MTEXT") (c:xmt)  )
((= KIEUDOITUONG "DIMENSION") (c:xd)  )
)
(Princ))




<<

Filename: 404302_xt_xmt_xd_sd.lsp
Tác giả: Tot77
Bài viết gốc: 404406
Tên lệnh: dtc
Lisp Tính Diện Tích Text, Số

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)
)

<<

Filename: 404406_dtc.lsp
Tác giả: vanngeonhuxua
Bài viết gốc: 404451
Tên lệnh: rdimension
Làm sao để cố định vị trí đường DIM ?
;; 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.


<<

Filename: 404451_rdimension.lsp
Tác giả: dunguss3581
Bài viết gốc: 196716
Tên lệnh: vgd
nút lệnh pick point từ bản vẽ.


Filename: 196716_vgd.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 404624
Tên lệnh: tt%C2%A0
Nhờ Chỉnh Sửa Lisp Chuyển Dim Về Dim Hiện Hành

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))

<<

Filename: 404624_tt%C2%A0.lsp
Tác giả: ndtnv
Bài viết gốc: 404745
Tên lệnh: test
Các Bác Giúp Em Bản Vẽ Này Với Ạ. Text Dim Bị Ngược Mặc Dù Em Đã Ucs/world

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)) )
)

<<

Filename: 404745_test.lsp
Tác giả: hiepttr
Bài viết gốc: 404887
Tên lệnh: trai
Vẽ Polyline Bám Theo Các Polyline Trước(Ý Tưởng Trải Vải Địa)

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)
)

<<

Filename: 404887_trai.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 404891
Tên lệnh: tt
Tập sửa lisp rải thép
Đối tượng chấm tròn bạn dùng là loại đối tượng nào? Block, Donut ...?
Lisp này giải quyết vấn đề trên.
Với điều kiện:
1.  Đối tượng chấm tròn là Block.
2. Điểm insert của block nằm ở tâm hình tròn.
3. Block chọn để rải có điểm chèn lùi vào 1 khoảng = bán kính hình tròn theo...
>>
Đối tượng chấm tròn bạn dùng là loại đối tượng nào? Block, Donut ...?
Lisp này giải quyết vấn đề trên.
Với điều kiện:
1.  Đối tượng chấm tròn là Block.
2. Điểm insert của block nằm ở tâm hình tròn.
3. Block chọn để rải có điểm chèn lùi vào 1 khoảng = bán kính hình tròn theo hướng rải.
(defun c:tt (/ bdt dem dia dst ent ept goc len lst obj p10 pmax pmin pt1 slg spt)
(vl-load-com)
(or #kc_rai_tt# (setq #kc_rai_tt# 150))
(if (and (setq ent (car (entsel "\nPick chon Block: ")))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(setq spt (getpoint "\nStart point:"))
(setq ept (getpoint "\nEnd point:" spt))
(not (initget 6))
(setq #kc_rai_tt# (cond ((getdist (strcat "\nKhoang cach a <" (itoa #kc_rai_tt#) ">: ")))
(#kc_rai_tt#))))
(progn (setq lst (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10 330))) (entget ent))
p10 (cdr (assoc 10 (entget ent))))
(setq obj (vlax-ename->vla-object ent))
(or (eq (vlax-get obj 'Rotation) 0) (vlax-put obj 'Rotation 0))
(vla-getboundingbox obj 'pmin 'pmax)
(setq pmin (vlax-safearray->list pmin)
pmax (vlax-safearray->list pmax)
dia (abs (- (car pmin) (car pmax))))
(setq goc (angle spt ept)
dst (- (distance spt ept) dia)
slg (fix (+ (/ dst #kc_rai_tt#) 0.5))
len (/ dst slg)
dem 0)
(while (< dem slg)
(setq bdt (* (setq dem (1+ dem)) len)
pt1 (polar p10 goc bdt))
(entmakex (append lst (list (cons 10 pt1)))))))
(princ))
<<

Filename: 404891_tt.lsp
Tác giả: Tot77
Bài viết gốc: 404914
Tên lệnh: mul sum
Nhờ Các Bác Chỉnh Sửa Lại Lisp Cộng Tổng Text Cho Trường Hợp Của Em

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))
)

<<

Filename: 404914_mul_sum.lsp
Tác giả: Tot77
Bài viết gốc: 404952
Tên lệnh: dtc
Lisp Tính Diện Tích Text, Số

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)
)

<<

Filename: 404952_dtc.lsp
Tác giả: Tot77
Bài viết gốc: 339393
Tên lệnh: tln
sửa lỗi lisp

Đặ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)
)

<<

Filename: 339393_tln.lsp
Tác giả: tien2005
Bài viết gốc: 405215
Tên lệnh: a1
Lisp Thay Đổi Giá Trị Att Theo Điều Kiện

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)
  )

<<

Filename: 405215_a1.lsp
Tác giả: Han Tinh
Bài viết gốc: 405273
Tên lệnh: fg
Lisp Đóng Mở Ngoặc Text, Mtext, Dim

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))
)
 

<<

Filename: 405273_fg.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 53738
Tên lệnh: nl
Viết Lisp theo yêu cầu

Chào bạn ngocthinh84,
Sau một hồi, lần mò tìm cách, cuối cùng mình đã ra được cái lisp có thể giải quyết được yêu cầu của bạn. Chạy thử với cái bản vẽ bạn gửi thì Ok. Bạn xài thử xem và cho mình biết kết quả nhé.
Cái khó nhất với mình là việc phải sắp xếp lại các điểm đầu và cuối của mỗi đoạn thẳng sao cho nó có một trật tự nhất định. Còn trên bản vẽ...
>>

Chào bạn ngocthinh84,
Sau một hồi, lần mò tìm cách, cuối cùng mình đã ra được cái lisp có thể giải quyết được yêu cầu của bạn. Chạy thử với cái bản vẽ bạn gửi thì Ok. Bạn xài thử xem và cho mình biết kết quả nhé.
Cái khó nhất với mình là việc phải sắp xếp lại các điểm đầu và cuối của mỗi đoạn thẳng sao cho nó có một trật tự nhất định. Còn trên bản vẽ của bạn nó lung tung quá, cái trước cái sau nó tèm lem cả. Trong lisp này mình phải dùng một mẹo nhỏ mới sắp xếp nổi nó theo tọa độ x của điểm. Sau khi sắp xếp được rồi thì chỉ cần chọn hai điểm có tọa độ y lớn nhất và nhỏ nhất trong mỗi cụm điểm cùng x là vẽ được đường thẳng cần thiết ngay.
Rất mong bạn thông cảm vì phải chờ lâu do trình độ lisp của mình còn hạn chế.
Lisp đây:


Chúc bạn vui và hãy chia xẻ với mọi người. Rất cám ơn bạn về những điều bạn đã chia xẻ cùng mọi người
<<

Filename: 53738_nl.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 405275
Tên lệnh: tt%C2%A0
Lisp Đóng Mở Ngoặc Text, Mtext, Dim
Bạn dùng Lisp này cho Text và Mtext:
(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...
>>
Bạn dùng Lisp này cho Text và Mtext:
(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))

<<

Filename: 405275_tt%C2%A0.lsp
Tác giả: Tue_NV
Bài viết gốc: 405276
Tên lệnh: md
Lisp Đóng Mở Ngoặc Text, Mtext, Dim

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 ")"))
     )
   )
 ))
)

<<

Filename: 405276_md.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 405334
Tên lệnh: tt
Lisp Đóng Mở Ngoặc Text, Mtext, Dim
Cái này áp dụng cho cả Dim và *TEXT
(vl-load-com)(defun c:tt (/ repentmod els ss str)
(defun repentmod (cha text_str lst flag / pos dim_dec)
(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))
(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))
text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))
(if (vl-string-search cha (strcase text_str))
(while (setq pos (vl-string-search cha (strcase text_str)))
(setq text_str...
>>
Cái này áp dụng cho cả Dim và *TEXT
(vl-load-com)(defun c:tt (/ repentmod els ss str)
(defun repentmod (cha text_str lst flag / pos dim_dec)
(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))
(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))
text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))
(if (vl-string-search cha (strcase text_str))
(while (setq pos (vl-string-search cha (strcase text_str)))
(setq text_str (strcat (substr text_str 1 pos) (substr text_str (+ 2 pos)))))
(cond ((eq flag 1) (setq text_str (strcat cha text_str)))
((eq flag 0) (setq text_str (strcat text_str cha)))))
(entmod (subst (cons 1 text_str) (assoc 1 lst) lst)))
(and (setq ss (ssget '((0 . "*TEXT,*DIMENSION"))))
(mapcar '(lambda (x) (repentmod (chr 40) (cdr (assoc 1 (entget x))) (entget x) 1))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(mapcar '(lambda (x) (repentmod (chr 41) (cdr (assoc 1 (entget x))) (entget x) 0))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(princ))
<<

Filename: 405334_tt.lsp
Tác giả: Thaistreetz
Bài viết gốc: 199681
Tên lệnh: var1+nil+%3B+lenh+nay+chay+o+ban+ve+thu+nhat%3Cbr%3E var2
- Lisp so sánh sự khác nhau giữa các biến hệ thống của 2 bản vẽ
Đôi khi chúng ta có nhu cầu cần so sánh các thiết lập biến hệ thống giữa 2 bản vẽ xem chúng khác nhau những gì. Đây là lisp mình fát triển từ lisp của bác Doan Van Ha trong bài viết số 2 topic Lisp theo dõi sự thay đổi biến hệ thống trong quá trình vẽ (Topic này cũng do mình lập - em kể công tí :D)
>>
Đôi khi chúng ta có nhu cầu cần so sánh các thiết lập biến hệ thống giữa 2 bản vẽ xem chúng khác nhau những gì. Đây là lisp mình fát triển từ lisp của bác Doan Van Ha trong bài viết số 2 topic Lisp theo dõi sự thay đổi biến hệ thống trong quá trình vẽ (Topic này cũng do mình lập - em kể công tí :D)
Hướng dẫn sử dụng:
- Bạn cần tải lisp này vào cả 2 bản vẽ cần thực hiện so sánh
- Bản vẽ thứ nhất bạn gọi lệnh Var1. kết quả: nó báo cho bạn "Đã lấy được toàn bộ danh sách và giá trị biến hệ thống của bản vẽ thứ nhất"
- Chuyển sang bản vẽ thứ 2 bạn gõ lệnh Var2. lệnh này làm công việc tương tự như của lệnh var1 là lấy toàn bộ giá trị biến hệ thống của bản vẽ thứ 2. Đồng thời nó thực hiện công việc so sánh với giá trị của các biến hệ thống bản vẽ thứ nhất. Nếu biến nào có giá trị khác nó sẽ thống kê ra màn hình cho bạn.

;Chu y: mot so System Variables khong can quan tam, nhu: "CDATE" "DATE" "LASTPROMPT" "TDINDWG" "TDUSRTIMER" "UNDOCTL"...
;;; Edit by Thaistreetz - Cadviet.com
(defun C:var1 nil ; Lenh nay chay o ban ve thu nhat
(setq lstvar1 nil)
(foreach var lstvar
(if (getvar var) (setq lstvar1 (cons (cons var (getvar var)) lstvar1))))
(setq lstvar1 (reverse lstvar1))
(vl-propagate 'lstvar1)
(prompt "\nDa lay duoc toan bo thong tin bien he thong ban ve thu nhat")
(princ))
(defun C:var2 (/ lstvar2 lv1 lv2 x) ; Lenh nay chay o ban ve thu 2
(if lstvar1
(progn
(princ "\n")
(foreach var lstvar (if (getvar var) (setq lstvar2 (cons (cons var (getvar var)) lstvar2))))
(setq lv1 (list-exclusive lstvar1 lstvar2) lv2 (list-exclusive lstvar2 lstvar1))
(foreach var lv1
(if (setq x (assoc (car var) lv2))
(progn (princ (car var)) (princ "\t") (princ (cdr var)) (princ "\t") (princ (cdr x)) (princ "\n") (setq lv2 (vl-remove x lv2)))
(progn (princ (car var)) (princ "\t") (princ (cdr var)) (princ "\t") (princ "nil") (princ "\n"))))
(foreach var lv2 (princ (car var)) (princ "\t") (princ (cdr var)) (princ "\t") (princ "nil") (princ "\n")))
(prompt "khong co danh sach bien he thong cua ban ve thu nhat de so sanh"))
(princ))
; lay cac phan tu khong thuoc giao cua 2 danh sach
(defun list-exclusive (lst1 lst2) (if lst1 (if (member (car lst1) lst2) (list-exclusive (cdr lst1) lst2) (cons (car lst1) (list-exclusive (cdr lst1) lst2)))))
;----- System Variables of Cad2007.
(setq lstvar (list
"3DDWFPREC"
"ACADLSPASDOC"
"ACADPREFIX"
"ACADVER"
"ACISOUTVER"
"ADCSTATE"
"AFLAGS"
"ANGBASE"
"ANGDIR"
"APBOX"
"APERTURE"
"APSTATE"
"AREA"
"ASSISTSTATE"
"ATTDIA"
"ATTMODE"
"ATTREQ"
"AUDITCTL"
"AUNITS"
"AUPREC"
"AUTOSNAP"
"BACKGROUNDPLOT"
"BACKZ"
"BACTIONCOLOR"
"BDEPENDENCYHIGHLIGHT"
"BGRIPOBJCOLOR"
"BGRIPOBJSIZE"
"BINDTYPE"
"BLIPMODE"
"BLOCKEDITLOCK"
"BLOCKEDITOR"
"BPARAMETERCOLOR"
"BPARAMETERFONT"
"BPARAMETERSIZE"
"BTMARKDISPLAY"
"BVMODE"
"CALCINPUT"
"CAMERADISPLAY"
"CAMERAHEIGHT"
"CDATE"
"CECOLOR"
"CELTSCALE"
"CELTYPE"
"CELWEIGHT"
"CENTERMT"
"CHAMFERA"
"CHAMFERB"
"CHAMFERC"
"CHAMFERD"
"CHAMMODE"
"CIRCLERAD"
"CLAYER"
"CLEANSCREENSTATE"
"CLISTATE"
"CMATERIAL"
"CMDACTIVE"
"CMDDIA"
"CMDECHO"
"CMDINPUTHISTORYMAX"
"CMDNAMES"
"CMLJUST"
"CMLSCALE"
"CMLSTYLE"
"COMPASS"
"COORDS"
"CPLOTSTYLE"
"CPROFILE"
"CROSSINGAREACOLOR"
"CSHADOW"
"CTAB"
"CTABLESTYLE"
"CURSORSIZE"
"CVPORT"
"DASHBOARDSTATE"
"DATE"
"DBCSTATE"
"DBLCLKEDIT"
"DBMOD"
"DCTCUST"
"DCTMAIN"
"DEFAULTLIGHTING"
"DEFAULTLIGHTINGTYPE"
"DEFLPLSTYLE"
"DEFPLSTYLE"
"DELOBJ"
"DEMANDLOAD"
"DIASTAT"
"DIMADEC"
"DIMALT"
"DIMALTD"
"DIMALTF"
"DIMALTRND"
"DIMALTTD"
"DIMALTTZ"
"DIMALTU"
"DIMALTZ"
"DIMAPOST"
"DIMARCSYM"
"DIMASO"
"DIMASSOC"
"DIMASZ"
"DIMATFIT"
"DIMAUNIT"
"DIMAZIN"
"DIMBLK"
"DIMBLK1"
"DIMBLK2"
"DIMCEN"
"DIMCLRD"
"DIMCLRE"
"DIMCLRT"
"DIMDEC"
"DIMDLE"
"DIMDLI"
"DIMDSEP"
"DIMEXE"
"DIMEXO"
"DIMFIT"
"DIMFRAC"
"DIMFXL"
"DIMFXLON"
"DIMGAP"
"DIMJOGANG"
"DIMJUST"
"DIMLDRBLK"
"DIMLFAC"
"DIMLIM"
"DIMLTYPE"
"DIMLTEX1"
"DIMLTEX2"
"DIMLUNIT"
"DIMLWD"
"DIMLWE"
"DIMPOST"
"DIMRND"
"DIMSAH"
"DIMSCALE"
"DIMSD1"
"DIMSD2"
"DIMSE1"
"DIMSE2"
"DIMSHO"
"DIMSOXD"
"DIMSTYLE"
"DIMTAD"
"DIMTDEC"
"DIMTFAC"
"DIMTFILL"
"DIMTFILLCLR"
"DIMTIH"
"DIMTIX"
"DIMTM"
"DIMTMOVE"
"DIMTOFL"
"DIMTOH"
"DIMTOL"
"DIMTOLJ"
"DIMTP"
"DIMTSZ"
"DIMTVP"
"DIMTXSTY"
"DIMTXT"
"DIMTZIN"
"DIMUNIT"
"DIMUPT"
"DIMZIN"
"DISPSILH"
"DISTANCE"
"DONUTID"
"DONUTOD"
"DRAGMODE"
"DRAGP1"
"DRAGP2"
"DRAGVS"
"DRAWORDERCTL"
"DRSTATE"
"DTEXTED"
"DWFFRAME"
"DWFOSNAP"
"DWGCHECK"
"DWGCODEPAGE"
"DWGNAME"
"DWGPREFIX"
"DWGTITLED"
"DYNDIGRIP"
"DYNDIVIS"
"DYNMODE"
"DYNPICOORDS"
"DYNPIFORMAT"
"DYNPIVIS"
"DYNPROMPT"
"DYNTOOLTIPS"
"EDGEMODE"
"ELEVATION"
"ENTERPRISEMENU"
"ERRNO"
"ERSTATE"
"EXPERT"
"EXPLMODE"
"EXTMAX"
"EXTMIN"
"EXTNAMES"
"FACETRATIO"
"FACETRES"
"FIELDDISPLAY"
"FIELDEVAL"
"FILEDIA"
"FILLETRAD"
"FILLMODE"
"FONTALT"
"FONTMAP"
"FRONTZ"
"FULLOPEN"
"FULLPLOTPATH"
"GRIDDISPLAY"
"GRIDMAJOR"
"GRIDMODE"
"GRIDUNIT"
"GRIPBLOCK"
"GRIPCOLOR"
"GRIPDYNCOLOR"
"GRIPHOT"
"GRIPHOVER"
"GRIPOBJLIMIT"
"GRIPS"
"GRIPSIZE"
"GRIPTIPS"
"GTAUTO"
"GTDEFAULT"
"GTLOCATION"
"HALOGAP"
"HANDLES"
"HIDEPRECISION"
"HIDETEXT"
"HIGHLIGHT"
"HPANG"
"HPASSOC"
"HPBOUND"
"HPDOUBLE"
"HPDRAWORDER"
"HPGAPTOL"
"HPINHERIT"
"HPNAME"
"HPOBJWARNING"
"HPORIGIN"
"HPORIGINMODE"
"HPSCALE"
"HPSEPARATE"
"HPSPACE"
"HYPERLINKBASE"
"IMAGEHLT"
"IMPLIEDFACE"
"INDEXCTL"
"INETLOCATION"
"INPUTHISTORYMODE"
"INSBASE"
"INSNAME"
"INSUNITS"
"INSUNITSDEFSOURCE"
"INSUNITSDEFTARGET"
"INTELLIGENTUPDATE"
"INTERFERECOLOR"
"INTERFEREOBJVS"
"INTERFEREVPVS"
"INTERSECTIONCOLOR"
"INTERSECTIONDISPLAY"
"ISAVEBAK"
"ISAVEPERCENT"
"LASTANGLE"
"LASTPOINT"
"LASTPROMPT"
"LATITUDE"
"LAYERFILTERALERT"
"LAYOUTREGENCTL"
"LEGACYCTRLPICK"
"LENSLENGTH"
"LIGHTGLYPHDISPLAY"
"LIGHTLISTSTATE"
"LIMCHECK"
"LIMMAX"
"LIMMIN"
"LISPINIT"
"LOCALE"
"LOCALROOTPREFIX"
"LOCKUI"
"LOFTANG1"
"LOFTANG2"
"LOFTMAG1"
"LOFTMAG2"
"LOFTNORMALS"
"LOFTPARAM"
"LOGFILEMODE"
"LOGFILENAME"
"LOGFILEPATH"
"LOGINNAME"
"LONGITUDE"
"LTSCALE"
"LUNITS"
"LUPREC"
"LWDEFAULT"
"LWDISPLAY"
"LWUNITS"
"ISOLINES"
"MATSTATE"
"MAXACTVP"
"MAXSORT"
"MBUTTONPAN"
"MEASUREINIT"
"MEASUREMENT"
"MENUCTL"
"MENUECHO"
"MENUNAME"
"MIRRTEXT"
"MODEMACRO"
"MSMSTATE"
"MSOLESCALE"
"MTEXTED"
"MTEXTFIXED"
"MTJIGSTRING"
"MYDOCUMENTSPREFIX"
"NOMUTT"
"NORTHDIRECTION"
"OBSCUREDCOLOR"
"OBSCUREDLTYPE"
"OFFSETDIST"
"OFFSETGAPTYPE"
"OLEFRAME"
"OLEHIDE"
"OLEQUALITY"
"OLESTARTUP"
"OPMSTATE"
"ORTHOMODE"
"OSMODE"
"OSNAPCOORD"
"OSNAPHATCH"
"OSNAPZ"
"OSOPTIONS"
"PALETTEOPAQUE"
"PAPERUPDATE"
"PDMODE"
"PDSIZE"
"PEDITACCEPT"
"PELLIPSE"
"PERIMETER"
"PERSPECTIVE"
"PFACEVMAX"
"PICKADD"
"PICKAUTO"
"PICKBOX"
"PICKDRAG"
"PICKFIRST"
"PICKSTYLE"
"PLATFORM"
"PLINEGEN"
"PLINETYPE"
"PLINEWID"
"PLOTOFFSET"
"PLOTROTMODE"
"PLQUIET"
"POLARADDANG"
"POLARANG"
"POLARDIST"
"POLARMODE"
"POLYSIDES"
"POPUPS"
"PREVIEWEFFECT"
"PREVIEWFILTER"
"PRODUCT"
"PROGRAM"
"PROJECTNAME"
"PROJMODE"
"PROXYGRAPHICS"
"PROXYNOTICE"
"PROXYSHOW"
"PROXYWEBSEARCH"
"PSLTSCALE"
"PSOLHEIGHT"
"PSOLWIDTH"
"PSTYLEMODE"
"PSTYLEPOLICY"
"PSVPSCALE"
"PUBLISHALLSHEETS"
"PUCSBASE"
"QCSTATE"
"QTEXTMODE"
"RASTERDPI"
"RASTERPREVIEW"
"RECOVERYMODE"
"REFEDITNAME"
"REGENMODE"
"RE-INIT"
"REMEMBERFOLDERS"
"RENDERPREFSSTATE"
"REPORTERROR"
"ROAMABLEROOTPREFIX"
"RTDISPLAY"
"SAVEFILE"
"SAVEFILEPATH"
"SAVENAME"
"SAVETIME"
"SCREENBOXES"
"SCREENMODE"
"SCREENSIZE"
"SDI"
"SELECTIONAREA"
"SELECTIONAREAOPACITY"
"SELECTIONPREVIEW"
"SHADEDGE"
"SHADEDIF"
"SHADOWPLANELOCATION"
"SHORTCUTMENU"
"SHOWHIST"
"SHOWLAYERUSAGE"
"SHPNAME"
"SIGWARN"
"SKETCHINC"
"SKPOLY"
"SNAPANG"
"SNAPBASE"
"SNAPISOPAIR"
"SNAPMODE"
"SNAPSTYL"
"SNAPTYPE"
"SNAPUNIT"
"SOLIDCHECK"
"SOLIDHIST"
"SPLFRAME"
"SPLINESEGS"
"SPLINETYPE"
"SSFOUND"
"SSLOCATE"
"SSMAUTOOPEN"
"SSMPOLLTIME"
"SSMSHEETSTATUS"
"SSMSTATE"
"STANDARDSVIOLATION"
"STARTUP"
"STEPSIZE"
"STEPSPERSEC"
"SUNPROPERTIESSTATE"
"SUNSTATUS"
"SURFTAB1"
"SURFTAB2"
"SURFU"
"SURFTYPE"
"SURFV"
"SYSCODEPAGE"
"TABLEINDICATOR"
"TABMODE"
"TARGET"
"TBCUSTOMIZE"
"TDCREATE"
"TDINDWG"
"TDUCREATE"
"TDUPDATE"
"TDUSRTIMER"
"TDUUPDATE"
"TEMPOVERRIDES"
"TEMPPREFIX"
"TEXTEVAL"
"TEXTFILL"
"TEXTQLTY"
"TEXTSIZE"
"TEXTSTYLE"
"THICKNESS"
"TILEMODE"
"TIMEZONE"
"TOOLTIPMERGE"
"TOOLTIPS"
"TPSTATE"
"TRACEWID"
"TRACKPATH"
"TRAYICONS"
"TRAYNOTIFY"
"TRAYTIMEOUT"
"TREEDEPTH"
"TREEMAX"
"TRIMMODE"
"TSPACEFAC"
"TSPACETYPE"
"TSTACKALIGN"
"TSTACKSIZE"
"UCSAXISANG"
"UCSBASE"
"UCSDETECT"
"UCSFOLLOW"
"UCSICON"
"UCSNAME"
"UCSORG"
"UCSORTHO"
"UCSVIEW"
"UCSVP"
"UCSXDIR"
"UCSYDIR"
"UNDOCTL"
"UNDOMARKS"
"UNITMODE"
"UPDATETHUMBNAIL"
"USERI1-5"
"USERR1-5"
"USERS1-5"
"VIEWCTR"
"VIEWDIR"
"VIEWMODE"
"VIEWSIZE"
"VIEWTWIST"
"VISRETAIN"
"VPMAXIMIZEDSTATE"
"VSBACKGROUNDS"
"VSEDGECOLOR"
"VSEDGEJITTER"
"VSEDGEOVERHANG"
"VSEDGES"
"VSEDGESMOOTH"
"VSFACECOLORMODE"
"VSFACEHIGHLIGHT"
"VSFACEOPACITY"
"VSFACESTYLE"
"VSHALOGAP"
"VSHIDEPRECISION"
"VSINTERSECTIONCOLOR"
"VSINTERSECTIONEDGES"
"VSINTERSECTIONLTYPE"
"VSISOONTOP"
"VSLIGHTINGQUALITY"
"VSMATERIALMODE"
"VSMAX"
"VSMIN"
"VSMONOCOLOR"
"VSOBSCUREDCOLOR"
"VSOBSCUREDEDGES"
"VSOBSCUREDLTYPE"
"VSSHADOWS"
"VSSILHEDGES"
"VSSILHWIDTH"
"VSSTATE"
"VTDURATION"
"VTENABLE"
"VTFPS"
"WHIPARC"
"WHIPTHREAD"
"WINDOWAREACOLOR"
"WMFBKGND"
"WMFFOREGND"
"WORLDUCS"
"WORLDVIEW"
"WRITESTAT"
"WSCURRENT"
"XCLIPFRAME"
"XEDIT"
"XFADECTL"
"XLOADCTL"
"XLOADPATH"
"XREFCTL"
"XREFNOTIFY"
"XREFTYPE"
"ZOOMFACTOR"
"ZOOMWHEEL"))

Mình lưu ý luôn 1 vài nhược điểm của lisp này:
- Do danh sách biến hệ thống được thống kê thủ công, nên có thể sót 1 vài biến không được kiểm tra. Đồng thời 1 vài biến chúng ta không quan tâm vì nó luôn thay đổi tại mỗi thời điểm cũng không được đưa vào so sánh.
- Danh sách này bác DVH lấy dựa vào danh sách các biến hệ thống của cad 2007, nó chạy tốt với các bản cad 2007-2010. từ bản 2011 trở lên autodesk đã có 1 số thay đổi lớn về giao diện và cách thức autocad tương tác với người dùng nên một số biến hệ thống liên quan có thể không còn tồn tại ở các bản cad này. bạn cần remove nó khỏi danh sách trong lisp để tránh lỗi có thể sảy ra. tương tự với các bản cad đời thấp. sẽ không có 1 số biến của cad 2007 cũng cần fải remove đi mới chạy được.
- code mình viết sơ bộ, chủ yếu để triển khai ý tưởng nên chỉ thông báo kết quả ra cửa sổ command của cad. tốt nhất các bạn nên sửa lại để thống kê ra file text giúp kiểm tra sự khác nhau được dễ dàng hơn.
<<

Filename: 199681_var1+nil+%3B+lenh+nay+chay+o+ban+ve+thu+nhat%3Cbr%3E_var2.lsp

Trang 208/304

208