- page 176

Info

File

Tác giả: Tot77
Bài viết gốc: 315518
Tên lệnh: geb

chuyển các đối tượng trong block về cùng 1 layer

thank b nhiều nha! bạn sữa giúp mình chút, cho mau của các đối tượng dề theo by layer dc ko bạn?

Bạn thử cái này, tôi cũng chưa test nhiều, bạn test trên block lồng nhau xem sao.

(defun c:Geb( / v)
  (defun geb(v lay / name en)
    (setq name (cdr (assoc 2 (entget v))))
    (if...
>>

thank b nhiều nha! bạn sữa giúp mình chút, cho mau của các đối tượng dề theo by layer dc ko bạn?

Bạn thử cái này, tôi cũng chưa test nhiều, bạn test trên block lồng nhau xem sao.

(defun c:Geb( / v)
  (defun geb(v lay / name en)
    (setq name (cdr (assoc 2 (entget v))))
    (if (setq en (tblobjname "BLOCK" name))
  (while (setq en (entnext en))
 (setq eg (entget en))
 (if (/= "INSERT" (cdr (assoc 0 eg)))
   (progn
     (entmod (subst (cons 8 lay) (assoc 8 eg) eg))
     (entmod (cons (cons 62 256) (vl-remove (assoc 62 eg) eg))))
   (geb en lay))))
  )   
  (geb (setq v (car (entsel "\nChon block:")))
       (cdr (assoc 8 (entget v))))
  (princ)
)

Download lisp

Filename: 315518_geb.lsp

Tác giả: hiepttr
Bài viết gốc: 316188
Tên lệnh: game

Chương 10.4 : Grread

Hôm nay rãnh, mần đc bài test hài hài tí, xin đc khoe hàng ^^

;;;Chuong 10.4
(defun c:GAME(/ e1 e2 input pt ss info)
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
;;=================================================
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "0")
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ (setq y (getvar "viewsize")) 25))
			'(1 . "KHI DOI BUNG THI BAN MUON...
>>

Hôm nay rãnh, mần đc bài test hài hài tí, xin đc khoe hàng ^^

;;;Chuong 10.4
(defun c:GAME(/ e1 e2 input pt ss info)
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
;;=================================================
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "0")
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ (setq y (getvar "viewsize")) 25))
			'(1 . "KHI DOI BUNG THI BAN MUON LAM GI ?") 
			(cons 72 1)
			(list 11 (car (setq tam (getvar "viewctr"))) (+ (cadr tam) (/ y 4))))
		) ;entmake
(setq hoi (entlast))
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "Layer1")
			'(62 . 1)
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ y  25))
			'(1 . "AN") 
			(cons 72 1)
			(list 11 (- (car tam) (/ (/(* y (car(setq tl (getvar"screensize")))) (cadr tl)) 4)) (- (cadr tam) (/ y 6))))
		)
(setq e3 (entlast))
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "Layer2")
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ y  25))
			'(1 . "DI VE SINH") 
			(cons 72 1)
			(list 11 (- (car tam) (/ (/(* y (car(setq tl (getvar"screensize")))) (cadr tl)) 4)) (- (cadr tam) (/ y 6))))
		)
(setq e1 (entlast))
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "Layer2")
			'(62 . 1)
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ y  25))
			'(1 . "AN")
			(cons 72 1)
			(list 11 (+ (car tam) (/ (/(* y (car(setq tl (getvar"screensize")))) (cadr tl)) 4)) (- (cadr tam) (/ y 6))))
		)
(setq e2 (entlast))
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			'(8 . "Layer1")
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 (/ y  25))
			'(1 . "NGU") 
			(cons 72 1)
			(list 11 (+ (car tam) (/ (/(* y (car(setq tl (getvar"screensize")))) (cadr tl)) 4)) (- (cadr tam) (/ y 6))))
		)
(setq e4 (entlast))
(LayOnOff "Layer1")
;========= xong tao text ===================================================
(while 
	(= (car (setq input (grread T))) 5)
	(setq pt (cadr input))
	(cond ((and
			(setq ss (ssget pt '((0 . "TEXT"))))
			(= (cdr (assoc 1 (setq info (entget (ssname ss 0))))) "AN")
			)
			(setq layer (cdr (assoc 8 info)))
			(hoan_doi layer))
	)
)
(alert "*** Chia buon cung ban ! Ban phai o lai dieu tri nua roi ! ^^ ***")
(laystt "Layer1" "ON")
(laystt "Layer2" "ON")
(command ".ERASE" e1 e2 e3 e4 hoi "")
(princ)
)
;========================================
(defun hoan_doi (layer)
(LayOnOff "Layer1")
(LayOnOff "Layer2")
)
;============== REUSE chuong 9 =============================
(defun LayOnOff (layer_name / info)
;chg 9
 (setq info (entget (tblobjname "layer" layer_name)))
 (entmod (subst (cons 62 (* -1 (cdr (assoc 62 info)))) (assoc 62 info) info))
 )
 ;============ REUSE chuong 9 ===============================
 ;Bai 6: Ham tong quat thay doi trang thai cua 1 layer: ON; OFF; LOCK; 
;UNLOCK; FREEZE; THAW, nguoi dung co the khai bao ON+LOCK hoac ON+LOCK+FREEZE
(defun laystt(layer_name stt)
(setq stt (strcase stt))
;Ham con 1: Chia stt boi dau "+" _VD: "ON+LOCK" --> '("ON" "LOCK")
(defun spl_stt(str / stt i)
(while (setq i (vl-string-search "+" str))
	(setq stt (append stt (list (substr str 1 i)))
		  str (substr str (+ i 2)))
)
(append stt (list str))
)
;==============
;Ham con 2: Xu ly cho sst don gian, VD: ON; OFF; LOCK...
(defun laystt_1(layer_name stt)
(setq info (entget (tblobjname "layer" layer_name)))
(cond
	((= stt "ON")
		(if (< (cdr (assoc 62 info)) 0) (LayOnOff layer_name)))		;reuse Ex.3
	((= stt "OFF")
		(if (> (cdr (assoc 62 info)) 0) (LayOnOff layer_name)))		;reuse Ex.3
	((= stt "LOCK")
		(if (< (cdr (assoc 70 info)) 4) (layLUL layer_name)))		;reuse Ex.4
	((= stt "UNLOCK")
		(if (> (cdr (assoc 70 info)) 3) (layLUL layer_name)))		;reuse Ex.4
	((= stt "FREEZE")
		(if (member (cdr (assoc 70 info)) '(0 2 4 6)) (layFT layer_name)))		;reuse Ex.5
	((= stt "THAW")
		(if (member (cdr (assoc 70 info)) '(1 3 5 7)) (layFT layer_name)))		;reuse Ex.5
)
)
;=================
;main:
(mapcar '(lambda (x) (laystt_1 layer_name x)) (spl_stt stt))
)

Suy luận:

Lisp bắt sự kiện liên tục ===> dùng while

Cần bắt điểm ===> track T (kết hợp cá hàm chương 9 để có trò vui)

Khi người dùng pick chọn chữ (hoặc ...) kết thúc while và đưa ra dòng thông báo "oái oăm" ka ka ^^ :D

Download lisp

Filename: 316188_game.lsp

Tác giả: hiepttr
Bài viết gốc: 316205
Tên lệnh: game

Chương 10.4 : Grread

xin được rút ngắn phần đầu theo "gạch đá" của bác Ha, còn phần sau xin bê nguyên from chương 9

;;;Chuong 10.4
(defun c:GAME(/ h tam y tl x1 y1 y2 a e1 e2 e3 e4 e5 input pt ss info)
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
;;=================================================
(tao_text 
	"0" 
	(setq h (/ (setq y (getvar "viewsize")) 25))
	"KHI DOI BUNG THI BAN MUON LAM GI ?" 
	(list...
>>

xin được rút ngắn phần đầu theo "gạch đá" của bác Ha, còn phần sau xin bê nguyên from chương 9

;;;Chuong 10.4
(defun c:GAME(/ h tam y tl x1 y1 y2 a e1 e2 e3 e4 e5 input pt ss info)
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
;;=================================================
(tao_text 
	"0" 
	(setq h (/ (setq y (getvar "viewsize")) 25))
	"KHI DOI BUNG THI BAN MUON LAM GI ?" 
	(list (setq x1 (car (setq tam (getvar "viewctr")))) (+ (setq y1 (cadr tam)) (/ y 4)))
	)
(setq e1 (entlast))
(tao_text 
	"Layer1" 
	h
	"AN" 
	(list (- x1 (setq a (/ (/(* y (car(setq tl (getvar"screensize")))) (cadr tl)) 4))) (setq y2 (- y1 (/ y 6))))
	)
(setq e2 (entlast))
(tao_text 
	"Layer2" 
	h 
	"DI VE SINH" 
	(list (- x1 a) y2)
	)
(setq e3 (entlast))
(tao_text 
	"Layer2" 
	h 
	"AN" 
	(list (+ x1 a) y2)
	)
(setq e4 (entlast))
(tao_text 
	"Layer1" 
	h 
	"NGU" 
	(list (+ x1 a) y2)
	)
(setq e5 (entlast))
(LayOnOff "Layer1")
;========= xong tao text ===================================================
(while 
	(= (car (setq input (grread T))) 5)
	(setq pt (cadr input))
	(cond ((and
			(setq ss (ssget pt '((0 . "TEXT"))))
			(= (cdr (assoc 1 (setq info (entget (ssname ss 0))))) "AN")
			)
			(setq layer (cdr (assoc 8 info)))
			(hoan_doi layer))
	)
)
(alert "*** Chia buon cung ban ! Ban phai o lai dieu tri mua roi ! ^^ ***")
(laystt "Layer1" "ON")
(laystt "Layer2" "ON")
(command ".ERASE" e1 e2 e3 e4 e5 "")
(princ)
)
;========================================
(defun hoan_doi (layer)
(LayOnOff "Layer1")
(LayOnOff "Layer2")
)
;============== REUSE chuong 9 =============================
(defun LayOnOff (layer_name / info)
;chg 9
 (setq info (entget (tblobjname "layer" layer_name)))
 (entmod (subst (cons 62 (* -1 (cdr (assoc 62 info)))) (assoc 62 info) info))
 )
 ;============ REUSE chuong 9 ===============================
 ;Bai 6: Ham tong quat thay doi trang thai cua 1 layer: ON; OFF; LOCK; 
;UNLOCK; FREEZE; THAW, nguoi dung co the khai bao ON+LOCK hoac ON+LOCK+FREEZE
(defun laystt(layer_name stt)
(setq stt (strcase stt))
;Ham con 1: Chia stt boi dau "+" _VD: "ON+LOCK" --> '("ON" "LOCK")
(defun spl_stt(str / stt i)
(while (setq i (vl-string-search "+" str))
	(setq stt (append stt (list (substr str 1 i)))
		  str (substr str (+ i 2)))
)
(append stt (list str))
)
;==============
;Ham con 2: Xu ly cho sst don gian, VD: ON; OFF; LOCK...
(defun laystt_1(layer_name stt)
(setq info (entget (tblobjname "layer" layer_name)))
(cond
	((= stt "ON")
		(if (< (cdr (assoc 62 info)) 0) (LayOnOff layer_name)))		;reuse Ex.3
	((= stt "OFF")
		(if (> (cdr (assoc 62 info)) 0) (LayOnOff layer_name)))		;reuse Ex.3
	((= stt "LOCK")
		(if (< (cdr (assoc 70 info)) 4) (layLUL layer_name)))		;reuse Ex.4
	((= stt "UNLOCK")
		(if (> (cdr (assoc 70 info)) 3) (layLUL layer_name)))		;reuse Ex.4
	((= stt "FREEZE")
		(if (member (cdr (assoc 70 info)) '(0 2 4 6)) (layFT layer_name)))		;reuse Ex.5
	((= stt "THAW")
		(if (member (cdr (assoc 70 info)) '(1 3 5 7)) (layFT layer_name)))		;reuse Ex.5
)
)
;=================
;main:
(mapcar '(lambda (x) (laystt_1 layer_name x)) (spl_stt stt))
)
;==============================================
(defun tao_text(layer h cont cen_pt)
(entmake (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 
			(cons 8  layer)
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 h)
			(cons 1 cont) 
			(cons 72 1)
			(cons 11 cen_pt)
		))
)

Download lisp

Filename: 316205_game.lsp

Tác giả: nhoclangbat
Bài viết gốc: 316213
Tên lệnh: cp thaythe cp thaythes maudo

[Li] Chương 7.2,3 : Bài Tập

- hi nhoc nhờ bạn Hiep ngâm nga truoc C7 bao lâu nay, nay đã đc set lên lv7, nhoc xin nộp BT C7 - 1 tới 3, anh Ket và các bạn các anh vô chém nhoc có sai sót gì không ^^

;;;bt ham SSGET
;1- tu chon tat ca doi tuong
(ssget "X")
;2- chon het line tru line thuoc layer khoa
(ssget ":L" '((0 . "LINE")))
;3- chi chon 1 doi tuong
(ssget ":S") or (entsel "\nChon 1 doi tuong:")
;4- chi chon 1 doi tuong la line
(ssget ":S" '((0 ....
>>

- hi nhoc nhờ bạn Hiep ngâm nga truoc C7 bao lâu nay, nay đã đc set lên lv7, nhoc xin nộp BT C7 - 1 tới 3, anh Ket và các bạn các anh vô chém nhoc có sai sót gì không ^^

;;;bt ham SSGET
;1- tu chon tat ca doi tuong
(ssget "X")
;2- chon het line tru line thuoc layer khoa
(ssget ":L" '((0 . "LINE")))
;3- chi chon 1 doi tuong
(ssget ":S") or (entsel "\nChon 1 doi tuong:")
;4- chi chon 1 doi tuong la line
(ssget ":S" '((0 . "LINE")))
;5- chon duong tron r=50
(ssget '((0 . "CIRCLE") (40 . 50)))
;6- chi nhan line va duong tron
(ssget '((0 . "LINE,CIRCLE")))
;7- chon text co chieu cao nhap vao
(ssget (list (cons 0  "TEXT") (cons 40  (getreal "\nnhap chieu cao text:"))))
;8- chon dim thuoc layer 0 or text thuoc layer text
(ssget '((-4 . "<OR") (-4 . "<AND") (0 . "DIMENSION") (8 . "DIM") (-4 . "AND>")
                     (-4 . "AND") (0 . "TEXT") (8 . "TEXT") (-4 . "AND>")
		(-4 . "OR>")))
;9- chon dim layer 0 ot text thuoc layer text có style la standard
(ssget '((-4 . "<OR") (-4 . "<AND") (0 . "DIMENSION") (8 . "0") (-4 . "AND>")
					  (-4 . "<AND") (0 . "TEXT") (8 . "TEXT") (7 . "STANDARD") (-4 . "AND>")
		 (-4 . "OR>")))
;10- chon block co thuoc tinh att
(Nentsel "\nchon 1 doi tuong trong block att :")
;11- tu chon cac duong tron trong ban ve co duong kinh nho hon 5
(ssget "X" '((0 . "CIRCLE") (-4 . "<") (40 . 5)))
;12- chon het cac text trong ban ve la dang so nguyen
(ssget "X" '((0 . "TEXT") (-4 . "<AND") (1 . "~*@*") (1 . "~*.*") (-4 . "AND>")))
;13- chon het cac text co noi dung ko chua so
(ssget "X" '((0 . "TEXT") (1 . "~*#*")))
;17- Chon cac text thuoc layer "text" co noi dung chua chu "test" hoac cac cung tron co layer "circle" tam co toa do X=0: 
(ssget '((-4 . "<OR") (-4 . "<AND") (0 . "TEXT") (1 . "*test*") (8 . "text") (-4 . "AND>")
					  (-4 . "<AND") (0 . "ARC") (8 . "circle") (-4 . "=,*") (10 0.0 0.0) (-4 . "AND>")
		 (-4 . "OR>")))
;14- chon doi tuong theo dang duong cat qua doi tuong
(setq lstp nil
       ss (ssget "_F" (while (setq pt (getpoint "\nChon cac diem tao duong cat dt:")) (setq lstp (append lstp (list pt))))))
;15-...nguoi dung pick cac diem, chon cac doi tuong ma duong noi cac diem do bao tron (WP):
(setq lp nil
	ss (ssget "WP" (while (setq pt (getpoint "\nChon diem thuoc duong bao tron: ")) (setq lp (append lp (list pt))))))
;16-...nguoi dung pick cac diem, chon cac doi tuong ma duong noi cac diem do cham vao (CP):
(setq lp nil
	ss (ssget "CP" (while (setq pt (getpoint "\nChon diem thuoc duong bao cham: ")) (setq lp (append lp (list pt))))))
;;;;;;;;;;;;;;;;;;;;;;==============================================
;============================================= Het BT C7-1 =========================================================================
;============================================= Bat Dau BT C7-2,3 ===================================================================
;1- ham doc 1 ma dxf cua 1 doi tuong
(defun dxf (ten ma)
(cdr (assoc ma (entget ten)))
)
;2----------thay doi 1 thuoc tinh ma dxf cua 1 doi tuong
(defun doidxf (ten ma valu / info)
(entmod (subst (cons ma valu) (assoc ma (setq info (entget ten))) info))
)
;3-----------thay doi layer 1 doi tuong
(defun doilayer (ten laydich)
(doidxf ten 8 laydich)
)
;4-----------thay doi noi dung cua text
(defun doitext (ten str)
(doidxf ten 1 str)
)
;5----------copy noi dung text tu text cu sang text moi
(defun copytext (tennguon tendich)
(doidxf tendich 1 (dxf tennguon 1))
)
;6----------thay doi danh sach dxf 1 or nhieu danh sach dxf cua doi tuong
(defun khoi (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
;;;;;;;
;7---------------------------------
(defun c:CP_thaythe (/ ss1 ss2 ma1)
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
(if ss1 
   (progn
     (prompt "chon cac text can past noi dung")
	 (while (setq ss2 (ssget "_+.:E:S" '((0 . "TEXT"))))
            (prompt "chon cac text can past noi dung")
			(copytext (ssname ss1 0) (ssname ss2 0))
	  )
	)
	(alert "chua chon dc text lay noi dung")
)
(princ)
)
;;;;--
;8-=======================================
(defun c:Cp_thaythes (/ ss1 ss2  i)
(setq ss1 (ssget "_+.:E:S" '((0 . "TEXT"))))
(if ss1
 (progn
     (prompt " quet chon cac text can past noi dung")
	 (setq ss2 (ssget '((0 . "TEXT"))))
	 (setq i 0)
	        (if ss2
	             (progn
	                  (repeat (sslength ss2)
	                          (copytext (ssname ss1 0) (ssname ss2 i))
	                          (setq i (1+ i))
	                   )
	              )
			  (alert "chua chon dc text can past noi dung")
	        )
  )
  (alert "chua chon dc text can lay noi dung")
 )
 (princ)
)
;;;;;;;;;
;9-====================================
(defun c:maudo (/ e1)
(while
(setq e1 (car (entsel "\nChon doi tuong mun chuyen thanh mau do:")))
(khoi e1 (list (cons 62 1)))
)
(princ)
)

Download lisp

Filename: 316213_cp_thaythe_cp_thaythes_maudo.lsp

Tác giả: mrphuocvie
Bài viết gốc: 316245
Tên lệnh: dtb

Lisp stretch nhóm đối tượng 2 phía vào giữa và xung quanh vào tâm

(defun C:DTB()
	(if (not rea) (setq rea 100))
	(setq rea1 (getreal (strcat "\nInput distance of bulong <" (itoa rea) ">:"))) 
	(if rea1 (setq rea rea1))
	(while
		(if (setq net (nentsel "\nSelect  text of dimension!"))
			(setq
				etname (car net)
				etlist (entget...
>>

(defun C:DTB()
	(if (not rea) (setq rea 100))
	(setq rea1 (getreal (strcat "\nInput distance of bulong <" (itoa rea) ">:"))) 
	(if rea1 (setq rea rea1))
	(while
		(if (setq net (nentsel "\nSelect  text of dimension!"))
			(setq
				etname (car net)
				etlist (entget etname)
				ettype (cdr (assoc 0 etlist))
				newtext (cdr (assoc 1 etlist))
			)
		)
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
		(if (= (substr newtext (-(strlen newtext) 3) 1) ",")(setq newtext (strcat (substr newtext 1 (-(strlen newtext) 4)) (substr newtext (-(strlen newtext) 2) (-(strlen newtext) 2)))))
		(setq bl (rtos(/ (atof newtext) rea)))
		(setq reat (rtos rea))
		(princ "\nSelect dimension to add text override!")
		(setq dim_obj (ssget(list(cons 0 "DIMENSION"))))
		(command ".Dim1" "New" (strcat "<>(" bl "x" reat ")") dim_obj "")
	)
	(princ)
)

(defun C:DTB()

(if (not rea) (setq rea 100))

(setq rea1 (getreal (strcat "\nInput distance of bulong <" (itoa rea) ">:")))

(if rea1 (setq rea rea1))

(while

(if (setq net (nentsel "\nSelect text of dimension!"))

(setq

etname (car net)

etlist (entget etname)

ettype (cdr (assoc 0 etlist))

newtext (cdr (assoc 1 etlist))

)

(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))

(if (= (substr newtext (-(strlen newtext) 3) 1) ",")(setq newtext (strcat (substr newtext 1 (-(strlen newtext) 4)) (substr newtext (-(strlen newtext) 2) (-(strlen newtext) 2)))))

(setq bl (rtos(/ (atof newtext) rea)))

(setq reat (rtos rea))

(princ "\nSelect dimension to add text override!")

(setq dim_obj (ssget(list(cons 0 "DIMENSION"))))

(command ".Dim1" "New" (strcat "<>(" bl "x" reat ")") dim_obj "")

)

(princ)

)

1. Cho em hỏi: lỗi này là thế nào?

Command: DTB
; error: bad argument type: fixnump: 21.0

và nhờ các anh chị sửa giúp!

2. tại sao có lỗi ra nhiều số 0 như thế! bây giờ muốn bỏ các số 0 không có nghĩa đi, ta sẽ sửa lại đoạn code thế nào ah!

Command: DTB

; error: bad argument type: fixnump: 21.0

Download lisp

Filename: 316245_dtb.lsp

Tác giả: ssg
Bài viết gốc: 82906
Tên lệnh: sci

Viết lisp theo yêu cầu [phần 2]

Xin phép anh Bình, ssg giúp bạn ấy 1 tay nhé.

@pbelth
Bạn "chơi" thử cái SCI (SCale at Intersections) này xem sao. Cảnh báo: nếu có 1 pline giao với n pline khác, nó sẽ bị scale n lần. Chương trình không kiểm tra việc đó, bạn phải tự chịu trách nhiệm lấy.

Download lisp

Filename: 82906_sci.lsp

Tác giả: Phiphi-
Bài viết gốc: 82903
Tên lệnh: repstring

Viết lisp theo yêu cầu [phần 2]

Cám ơn bác Thiệp sưu tầm Lisp trên.
Để tự động tìm và thay text, thí dụ tìm thay 2009 thành 2010, PP sửa lại Lisp trên như dưới đây rồi thêm vào cuối 1 Lisp nào đó đang dùng trước khi cần Find & Replace. nó làm việc OK.

Download lisp

Filename: 82903_repstring.lsp

Tác giả: hiepttr
Bài viết gốc: 316453
Tên lệnh: game2

Chương 10.4 : Grread

Bài 2:

Để xem mọi người có thể nòi gì về thầy Ket ! ^^

:D :D :D

Chỉ là code ngắn gọn, xin phép được bỏ qua phần phân tích code !

(defun c:game2()
(prompt "Answer the following question: Is Ketxu a handsome man ? ")
(while (not(equal (grread nil 2) '(2 121)))
	(alert "Not correct ! Please try again !")
	(prompt "\nIs Ketxu a handsome man ? ")
	)
	(alert "You have passed the test ! Good luck !")
)

Download lisp

Filename: 316453_game2.lsp

Tác giả: Tot77
Bài viết gốc: 316481
Tên lệnh: test

đếm block tuy chọn

Có phải cái này không?

(defun c:test(/ lten lsoluong ss diem diem1 n cao)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  
  (princ "\nChon Block:")
  (setq lten nil)  
  (mapcar '(lambda(x) (if (not (member (setq tm (vla-get-Effectivename (vlax-ename->vla-object x))) lten))
      (setq lten (cons tm lten))))
 (acet-ss-to-list (ssget (list '(0 . "INSERT")))))
 
  (princ "\nTrong cac doi tuong:")
  (setq ss...
>>

Có phải cái này không?

(defun c:test(/ lten lsoluong ss diem diem1 n cao)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  
  (princ "\nChon Block:")
  (setq lten nil)  
  (mapcar '(lambda(x) (if (not (member (setq tm (vla-get-Effectivename (vlax-ename->vla-object x))) lten))
      (setq lten (cons tm lten))))
 (acet-ss-to-list (ssget (list '(0 . "INSERT")))))
 
  (princ "\nTrong cac doi tuong:")
  (setq ss (acet-ss-to-list (ssget (list '(0 . "INSERT"))))
lsoluong (mapcar '(lambda(y)
  (length (vl-remove nil (mapcar '(lambda(x)
(if (= y (vla-get-Effectivename (vlax-ename->vla-object x))) x nil)) ss)))) lten))
 
  (if (not textmau) (setq textmau (car (entsel "Chon Text mau:"))))
 
  (setq diem (getpoint "\nDiem dat text so luong:")
n -1
cao (dxf 40 textmau))
  (foreach v lten
    (entmakex (list (cons 0  "TEXT") (cons 10 (setq diem1 (polar diem (* -0.5 pi) (* 2 cao (setq n (1+ n))))))
   (cons 11 diem1) (cons 40 cao) (cons 7 (dxf 7 textmau)) (cons 71 (dxf 71 textmau)) (cons 72 (dxf 72 textmau))
   (cons 1 (strcat (nth n lten) " : " (itoa (nth n lsoluong))))))
  )
  (princ)  
)

Download lisp

Filename: 316481_test.lsp

Tác giả: luhaivinh
Bài viết gốc: 310570
Tên lệnh: c55 c66 c77 c88 c99 c100 c111

Chương 3 - Các hàm nhập liệu

thank bạn nhoc nhé.

Em nộp bài tập nha anh ket.

 ;chuong 3.2

(defun c:c55(/ d1 d2);cau 5 dientichvanhkhannhap
  (defun dtvk(d1 d2)
  (- (* pi d1 d1 ) (* pi d2 d2 ))
   )
  (setq d1 (getreal "\nNhap ban kinh lon:"))
  (setq d2 (getreal "\nNhap ban kinh nho:"))
  (dtvk d1 d2)
)

(defun c:c66(/ a b c p);cau 6 dientichtamgiaccanh
  (defun dttgc(a b c p)
  (sqrt (* p (- p a) (- p b) (- p c)))
    )
  (setq dtvk nil)
  (setq a (getreal...
>>

thank bạn nhoc nhé.

Em nộp bài tập nha anh ket.

 ;chuong 3.2

(defun c:c55(/ d1 d2);cau 5 dientichvanhkhannhap
  (defun dtvk(d1 d2)
  (- (* pi d1 d1 ) (* pi d2 d2 ))
   )
  (setq d1 (getreal "\nNhap ban kinh lon:"))
  (setq d2 (getreal "\nNhap ban kinh nho:"))
  (dtvk d1 d2)
)

(defun c:c66(/ a b c p);cau 6 dientichtamgiaccanh
  (defun dttgc(a b c p)
  (sqrt (* p (- p a) (- p b) (- p c)))
    )
  (setq dtvk nil)
  (setq a (getreal "\nNhap canh thu nhat:"))
  (setq b (getreal "\nNhap canh thu hai:"))
  (setq c (getreal "\nNhap canh thu ba:"))
  (setq p (* (+ a b c) 0.5))
  (dttgc a b c p)
  )

(defun c:c77(/ dtmt d);cau 7 dientichmatthep
  (defun dtmt(d)
    (* pi d d 0.5 0.5)
    )
  (setq dttgc nil)
  (setq d (getreal "\nNhap duong kinh thep:"))
  (dtmt d)
  )
(defun c:c88(/ klt d);cau 8 khoiluongthep
  (defun klt(d)
    (* pi d d 0.5 0.5 11.7 7850 )
    )
  (setq d (getreal "\nNhap duong kinh thep:"))
  (klt d)
  )
(defun c:c99(/ kltd a th);cau 9 khoiluongthepvungd
  (defun kltd(a th)
    (* (- (* a a) (* (- a th) (- a th))) 11.7 7850)
    )
  (setq a (getreal "\nNhap chieu dai canh ngoai:"))
  (setq th (getreal "\nNhap be day thep:"))
  (kltd a th)
  )
(defun c:c100(/ kltc a1 a2);cau 10 khoiluongthepvungc
  (defun kltc(a1 a2)
    (* (- (* a1 a1) (* a2 a2)) 11.7 7850)
    )
  (setq a1 (getreal "\nNhap chieu dai canh ngoai:"))
  (setq a2 (getreal "\nNhap chieu dai canh trong:"))
  (kltc a1 a2)
  
  )

(defun c:c111(/ doi a);cau 11 doi don vi
  (defun doi (a)
    (/ a 1000)
   )
  (setq a (getreal "\nNhap gia tri (mm):"))
  (doi a)
  )

Bài tập 3.2

theo em để khử hàm con khỏi thủ tục có 2 cách.

-cách 1: ta xem nó như một biến cục bộ và liệt kê sau dấu /

-cách 2: ta setq nó = nil và đặt nó ở thủ tục phía sau, giông như khử biến ketqua mà ở chương trước ta đã làm

---> so sánh thiệt hơn của 2 cách:

- cách 1: gọn hơn và biến sẽ khử hàm con ngay sau khi thủ tục kết thúc.nhưng chỉ có tác dụng riêng lẽ với từng thủ tục.

- cách 2: muốn khử được hàm con ta phải chạy thủ tục ma ta đặt ham con= nil mới khủ được. nhưng cách nay ta có thể khử được các biến hàng loạt không cần biến biên hay hàm con hàng loạt mà không cần biết chúng đang nàm ở thủ tục nào, chỉ cần biết chúng đang hiện hữu mà ta muốn khử chúng đi.

Download lisp

Filename: 310570_c55_c66_c77_c88_c99_c100_c111.lsp

Tác giả: ketxu
Bài viết gốc: 316475
Tên lệnh: game

Chương 10.4 : Grread

@Hiepttr : 2 bài tốt rồi. Riêng bài thay đổi text mình gợi ý tham khảo là tạo rồi chỉnh sửa nội dung sẽ gọn hơn.

Code tham khảo :

(defun c:GAME(/) ;.....
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
(defun _etext(h cont cen_pt)
(entmakex (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 			
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 h)
			(cons 1 cont) 
			(cons 72...
>>

@Hiepttr : 2 bài tốt rồi. Riêng bài thay đổi text mình gợi ý tham khảo là tạo rồi chỉnh sửa nội dung sẽ gọn hơn.

Code tham khảo :

(defun c:GAME(/) ;.....
(alert "Trong vai la benh nhan tam than ^^\nHoan thanh bai test de duoc ra vien ^^")
(defun _etext(h cont cen_pt)
(entmakex (list
			'(0 . "TEXT") 
			'(100 . "AcDbEntity") 			
			'(100 . "AcDbText") 
			'(10 0 0) 
			(cons 40 h)
			(cons 1 cont) 
			(cons 72 1)
			(cons 11 cen_pt)
		))
)
(defun _cDxf (e id v)(entmod (subst (cons id v)(assoc id (setq e (entget e))) e)))
(defun _cPos(l)(nth (setq n (if (= n (1- (length l))) 0  (1+ n))) l))
;;=================================================
(setq 
	l	'("NGU" "DI VE SINH" "DI CHOI" "DANH DIEN TU") n 0
	e1	(_etext 	(setq h (/ (setq y (getvar "viewsize")) 25))
					"KHI DOI BUNG THI BAN MUON LAM GI ?" 
					(list (setq x1 (car (setq tam (getvar "viewctr")))) (+ (setq y1 (cadr tam)) (/ y 4)))
		)
	e2	(_etext 	h
					"AN"
					(list (- x1 (setq a (/ (/(* y (car(setq tl (getvar "screensize")))) (cadr tl)) 4))) (setq y2 (- y1 (/ y 6))))
		)
		
	e3	(_etext 	h "DI VE SINH" 
					(list (+ x1 a) y2)
		)
	lE (list e2 e3)
)
;========= xong tao text ===================================================
(while 
	(= (car (setq input (grread T))) 5)
		(setq pt (cadr input))
		(cond 	((setq ss (ssget pt '((0 . "TEXT")(1 . "AN"))))
					(_cDxf (setq e (ssname ss 0)) 1 (_cpos l))
					(_cDxf (car (vl-remove e lE)) 1 "AN")
				)
		)
)
(alert "*** Chia buon cung ban ! Ban phai o lai dieu tri mua roi ! ^^ ***")
(mapcar 'entdel (list e1 e2 e3))
(princ)
)

Download lisp

Filename: 316475_game.lsp

Tác giả: Tot77
Bài viết gốc: 300705
Tên lệnh: nhan

Lisp tính toán trong các attribute của block

Lisp phân biệt att qua tag thôi, chẳng biết att thứ mấy.

Lisp copy giá trị att này qua att khác thì có nhiều trên forum, bạn search thử xem.

Còn lisp nhân att thì chắc chưa có. Bạn thử lisp dưới đây.

Chọn số hạng nhân (có thể nhiều hơn 2) rồi chọn att ghi kết quả, sau đó quét chọn tât cả block muốn nhân.

(defun c:nhan()
  (defun laysohang(ent l tm...
>>

Lisp phân biệt att qua tag thôi, chẳng biết att thứ mấy.

Lisp copy giá trị att này qua att khác thì có nhiều trên forum, bạn search thử xem.

Còn lisp nhân att thì chắc chưa có. Bạn thử lisp dưới đây.

Chọn số hạng nhân (có thể nhiều hơn 2) rồi chọn att ghi kết quả, sau đó quét chọn tât cả block muốn nhân.

(defun c:nhan()
  (defun laysohang(ent l tm / l1 obj kq)
    (setq l1 nil)
     (while (and (setq ent (entnext ent))
   (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
       (if (vlax-property-available-p (setq obj (vlax-ename->vla-object ent)) 'TagString) 
(cond ((member (vla-get-TagString obj) l)
(setq l1 (cons (atof (vla-get-TextString obj)) l1)))
      ((= tm (vla-get-TagString obj))
(setq kq ent))))
     )
     (vla-put-Textstring (vlax-ename->vla-object kq) (apply '* l1))
  )
  ;;;
  (setq l1 nil)
  (while (setq tm (car (nentsel "\nChon Attribute so hang:")))
    (setq l1 (cons (cdr (assoc 2 (entget tm))) l1)))
  (setq tm (cdr (assoc 2 (entget (car (nentsel "\nChon Attribute ket qua:")))))
ss (ssget '((0 . "INSERT") (66 . 1))))
  (mapcar '(lambda(v) (laysohang v l1 tm))  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (princ)
)

Download lisp

Filename: 300705_nhan.lsp

Tác giả: ceddtu
Bài viết gốc: 316577
Tên lệnh: setup ac tca sa sa ta ca cda kca movet ss

lisp cộng trừ nhân chia text

;----------------------------------------------------
;--------Nguyen The Anh-Road No2-RECO-TEDI-----------
;--------Standard command for edit section-----------
;----------------------------------------------------
(setq #tyle 0.001)
(setq tle 1)
(setq #height 0.34)
(setq #widthfactor 1)
(setvar "dimzin" 0)
;----------------------------------------------------
(defun c:setup()
        (if (not (and (/= #tyle 0) (/= #tyle nil))) (setq #tyle n1))
    (setq xau...
>>

;----------------------------------------------------
;--------Nguyen The Anh-Road No2-RECO-TEDI-----------
;--------Standard command for edit section-----------
;----------------------------------------------------
(setq #tyle 0.001)
(setq tle 1)
(setq #height 0.34)
(setq #widthfactor 1)
(setvar "dimzin" 0)
;----------------------------------------------------
(defun c:setup()
        (if (not (and (/= #tyle 0) (/= #tyle nil))) (setq #tyle n1))
    (setq xau (strcat "New Scale (1/<" (rtos (/ 1 #tyle) 2 0) ">): "))
    (setq h1 (getreal xau))
    (if h1 (setq #tyle h1) (setq h1 #tyle))
(if (null #tyle) (setq #tyle (getreal "\Ty le (1/<1000>) :")))
 (if (null #tyle) (setq #tyle 0.001)) 
    (setq tle (/ 1 #tyle))
    (setq tle (/ tle 1000))
(setq #height (entsel "\nText lam mau:"))
    (if (null #height) (princ)
     (progn
      (setq ds (entget (car #height)))
      (setq #height (cdr (assoc 40 ds)))
      (setq #widthfactor (/ (distance (cdr (assoc 10 ds)) (cdr (assoc 11 ds)) ) 2)) 
     ) 
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;------------------------==================
;=====Area for scale================================
;==========================================
(defun c:Ac ( / po ent dt dtc tle1)  
   (Start)
   (setq osmd1 (getvar "osmode"))
   (setvar "osmode" 0)
    (setq po (getpoint "/Chon 1 diem trong:") 
          dtc 0)
    (setvar "osmode" osmd1)
    (while po
       (command"bpoly" po "")
       (setq ent (entlast))
       (command"area" "e" ent)
       (setq dt (getvar "area")
	     dtc (+ dtc dt))
       (command "erase" ent "")
       (setvar "osmode" 0)
       (setq po (getpoint "/Diem trong tiep/<Enter> de ket thuc: "))
       (setvar "osmode" osmd1)       
    )
(setvar "osmode" 0)   
(setq dc (getpoint "/Diem dat Text:"))
(setq dt (rtos (* dtc tle tle) 2 2))
(setq dt1 dt)
(command ".text" dc #height "0" dt1)
(setvar "osmode" osmd1)
    (kthuc)
    (princ)
)
;------------------------------------------
;--------------==========------------------
;-------------Lenght for grow grass -----------
;==========================================
;-----------------------------------------=
(defun c:tca ()
 (start)
 (setvar "osmode" 33)
 (setq tco 0)
 (setq poo (getpoint "\<Start Point>:"))
 (setvar "osmode" 0)
(while poo
  (setq p1 poo)
  (setvar "osmode" 33)
  (setq p2 (getpoint "\<Second Point>:"))
  (setq kca (distance p1 p2))
  (setq tco (+ kca tco))
  (setq poo (getpoint "\<Enter> Stop/<Next Point>:"))
)
;*** End while ***
 (setq tco (* tco tle))
 (setq text1 (rtos tco 2 2))
 (setq dc (getpoint "\<Insert>:"))
 (command ".text" dc #height "0" text1)
 (kthuc)
 (princ)
)
;--------------------------------------
;======================================
;--------------------------------------
(defun laygiatri (  ds1  / gt1  gt) 
(setq 	gt1 (cdr (assoc 1 (entget ds1)))
	gt	(rtos (read gt1) 2 2)
)
)
;------------------------------------------------
(defun laygiatritru (  ds1 ds2  / gt1 gt2 gt) 
(setq 	gt1 (cdr (assoc 1 (entget ds1)))
	gt2  (cdr (assoc 1 (entget ds2)))
	gt	(rtos (- (read gt1 ) (read gt2)) 2 2)
)
)
;-------------------------------------------------
(defun laygiatritong (  ds1 ds2  / gt1 gt2 gt) 
(setq 	gt1 (cdr (assoc 1 (entget ds1)))
	gt2  (cdr (assoc 1 (entget ds2)))
	gt	(rtos (+ (read gt1 ) (read gt2)) 2 2)
)
)
;--------------------------------------------------
(defun layso ( thongbao / gtri a kq)
(setq a (entsel thongbao))
(and
	(/= a  nil)
	(= (type (setq gtri (assoc  1 (entget (car a))))) 'STR)
	(= (type (read gtri)) 'REAL)
)
 (setq kq gtri)
)
;---------------------------------------------------
;---------------------------------------------------
;---------------------------------------------------
;-------Thay Text cho Text--------------------------
;---------------------------------------------------
;---------------------------------------------------
;(defun c:sa ( / ds1 ds3 gt ds dsach)
;(setq
;	ds1 (car (entsel "\n Chi Text gia tri: "))
;	ds3 (car (entsel "\n Chi Text muon thay: " ))
;	ds  (entget ds3)
;	gt  (cons 1 (laygiatri ds1 )) 
;)
;	(entdel ds3)
;		(foreach tam 	ds
;			(if (/= (car tam)	1)	(setq dsach 	(append dsach (list tam)))
;						(setq dsach 	(append dsach (list gt)))
;			)
;		)
;	(entmake dsach)
;(princ)
;)
;------------------------------------------
(defun c:sa ()
 (setvar "Cmdecho" 0)
 (prompt "\n<<   Select Data             >>")
 (setq sstcong (entsel))
        (setq sdk (entget (car sstcong)))
        (if (= (cdr (assoc 0 sdk)) "TEXT")
            (setq tckl (cdr (assoc 1 sdk)))
            (prompt "\n<< ERROR : Nothing Text Selected. >>")
        )
 (prompt "\n<<   Select Text To Copy.  >>")
 (setq tcong (ssget))
 (setq sslen (sslength tcong))
      (while (> sslen 0)
        (setq stc (entget (ssname tcong (setq sslen (1- sslen)))))
        (if (= (cdr (assoc 0 stc)) "TEXT")
            (entmod (subst (cons 1 tckl) (assoc 1 Stc) Stc))
            (prompt "\n<< ERROR : Nothing Text Selected. >>")
        )
      )
  (setvar "Cmdecho" 1)
)
;------------------------------------------
;------------------------------------------
;------------------------------------------
;--------Tru 2 Text va thay Text-----------
;==========================================
;==========================================
;------------------------------------------
(defun c:Ta ( / ds1 ds2 ds3 gt ds dsach)
(setq
	ds1 (car (entsel "\nGia tri bi tru: "))
	ds2 (car (entsel "\nLuong can tru: " ))
	ds3 (car (entsel "\n Thay Text: " ))
	ds  (entget ds3)
	gt  (cons 1 (laygiatritru ds1 ds2))
)
	(entdel ds3)
		(foreach tam 	ds
			(if (/= (car tam)	1)	(setq dsach 	(append dsach (list tam)))
						(setq dsach 	(append dsach (list gt)))
			)
		)
	(entmake dsach)
(princ)
)
;----------------------------------------------------------
;----------------------------------------------------------
;----------------------------------------------------------
;--------------Sum value text---------------------------
;----------------------------------------------------------
;==========================================================
(defun c:ca ( / ds1 ds2 ds3 gt ds dsach)
(setq
	ds1 (car (entsel "\n Gia tri 1: "))
	ds2 (car (entsel "\n Gia tri 2: " ))
	ds3 (car (entsel "\n Thay Text/Gia tri: " ))
	ds  (entget ds3)
	gt  (cons 1 (laygiatritong ds1 ds2))
)
	(entdel ds3)
		(foreach tam 	ds
			(if (/= (car tam)	1)	(setq dsach 	(append dsach (list tam)))
						(setq dsach 	(append dsach (list gt)))
			)
		)
	(entmake dsach)
(princ)
)
;---------------Ham goc----------------------
(defun start ()
 (setq osmd (getvar "osmode"))
 (setq tex (getvar "texteval"))
 (setq cmd (getvar "cmdecho"))
 (setq angb (getvar "angbase"))
 (setq angd (getvar "angdir"))
 (setvar "texteval" 1)
)
(defun kthuc ()
 (setvar "osmode" osmd)
 (setvar "texteval" tex)
 (setvar "cmdecho" cmd)
 (setvar "angbase" angb)
 (setvar "angdir" angd)
 (princ)
)
;---------------------------------------------
;-----Evelation - Edit from "SuaTN.lsp"----
;----------------------------------------------
(defun c:cda ()
   (start)
   (setvar "osmode" 33)
   (setq p111 (getpoint "\nChon diem chuan :"))
   (setq c1 "caodo")
   (while (not (numberp c1))
   (setq c1 (car (entsel "\nChi cho text cao do cua diem chuan:")))
   (if (null c1) (princ)
     (if (/= (assoc 1 (entget c1)) nil)
      (setq c1 (read (cdr (assoc 1 (entget c1)))))
     )
   )
   )
  (setvar "osmode" 33)  
  (setq p211 (getpoint p111 "\nDiem can tinh : "))
   (while p211
    (setq px (* (- (cadr p211) (cadr p111)) tle))  
    (setq tet (+ c1 px))
    (setq tet (rtos tet 2 2))
    (setvar "osmode" 0)
    (setq dc (getpoint p211 "\nDiem chen : "))
    ;(setq dc (mapcar '- dc (list 0.0 #widthfactor)))
    ;(setq dc1 (mapcar '+ dc (list 0.0 (* #widthfactor 2.0)) ))
    (command "text" dc #height 90 tet "" "")
    (setvar "osmode" 33)  
    (setq p211 (getpoint p111 "\nDiem can tinh/<Enter> for End: "))
   );End While
  (setvar "osmode" 0)
 (kthuc)
 (princ)
)
;--------------------------------------------
;-----------Khoang cach le------------------
;--------------------------------------------
(defun c:kca ()
 (start)
 (setvar "osmode" 1)
 (setq p3 (getpoint "\nChon diem thu nhat : ")) 
 (while p3
  (setq p4 (getpoint p3 "\nChon diem thu hai : "))
  (setvar "osmode" 0)
  (setq kca (abs (- (car p3) (car p4))))
  (setq kca2 (abs (* kca tle)))
  (setq text (rtos kca2 2 2)) 
  (setq dc (getpoint "\nDiem chen : "))
 (if (>= kca2 1.0) (princ) 
                   (progn 
                   (if (>= kca 2.23)
                                  (setq height 2)
                                  (setq height (* kca 0.78))  
                   )                
                   (setq ddtext1 (list (+ (car dc) (/ height 2)) (- (cadr dc) 2.0)))
                   (setq ddtext2 (list (+ (car dc) (/ height 2)) (+ (cadr dc) 2.0)))
                   (command "text" dc #height 90 text "" "")
                   );end progn
  );end if
  (if (< kca2 1.0) (princ)
        (progn
        (setq ddtext1 (list (- (car dc) (/ kca 2.1)) (- (cadr dc) 1.0))); ***Tu 1m den 1.5m ***
        (setq ddtext2 (list (+ (car dc) (/ kca 2.1)) (- (cadr dc) 1.0)))
        (if (>= kca 7.5) (setq ddtext1 (list (- (car dc) 3.4) (- (cadr dc) 1.0))))
        (if (>= kca 7.5) (setq ddtext2 (list (+ (car dc) 3.4) (- (cadr dc) 1.0))))
        (command "text" dc #height 0 text "" "")
        )
  );end if
  (setvar "osmode" 1)
  (setq p3 (getpoint "\nChon diem thu nhat/<Enter> for End: ")) 
 );end while
 (setvar "osmode" 0)
  (kthuc)
 (princ)
)
;-------------------------------------
;--------------Nang Text 3D for SDSK---------------
;------------------------------------
(defun c:movet (/ ss ee e l k cd p)
   (command "UNDO" "begin")
   (setq ss (ssget))
   (if ss (progn
      (setq l (sslength ss))
      (setq k 0)
      (repeat l
         (setq e (ssname  ss k))
         (setq k (+ k 1))
         (setq ee (entget e))
         (if (= (cdr (assoc 0 ee) ) "TEXT")
             (progn
                (setq p (cdr (assoc 10 ee) ))
                (setq cd (cdr (assoc 1 ee)))
                (setq cd (atof cd))
                (setq p (list (car p) (cadr p) cd ))
                (setq ee (subst (cons 10 p) (assoc 10 ee) ee))
                (entmod ee)
                (entupd e)
             ) 
         ) 
      )  
   ))
   (command "UNDO" "end")   
)
;-------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;
;;;;Tinh cong don;;;;;
;;;;;;;;;;;;;;;;;;;;;;
(defun c:ss()
 (setvar "CMDECHO" 0)
 (setvar "DIMZIN" 0)
 ;(setq pre (getint "\nSo chu so sau dau phay?"))
 (command "luprec" 2)  
 (setq co (getreal "\nGia tri can cong them:"))
 (SETQ TH (SSGET))
 (SETQ QUANT (SSLENGTH TH))
  (SETQ INDEX 0)
  (WHILE (< INDEX QUANT)
  (IF 
	  (AND(= "TEXT" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME TH INDEX)))))))      
     (PROGN
		 (setq s (entget (SSNAME TH INDEX)))
		   (setq otext (assoc 1 s))
		   (setq ot (cdr otext))
		   (setq ot (read (substr ot 1 )))
		   (setq nt (cons 1 (rtos (+ ot co) 2 2)))  
		   (setq s (subst nt otext s))
		   (entmod s)
     )
  	)
  (setq index (+ index 1))
 )
)

- bạn up code dạng này ko tải để xem đc, nhưng nhoc đoán mò là, bạn xem trong lsp dòng nào có hàm (rtos (.....) 2 2) thì cứ chuyển số 2 cuối thành 3 là đc =>

(rtos (....) 2 3)

Cảm ơn bạn nhé, lisp như thế này ạ. vì nó nhiều lệnh quá.

Download lisp

Filename: 316577_setup_ac_tca_sa_sa_ta_ca_cda_kca_movet_ss.lsp

Tác giả: hiepttr
Bài viết gốc: 316623
Tên lệnh: test

Chương 7.2,3 : Bài Tập

@Nhóc: Nếu muốn so sánh về tốc độ của hàm (setq n (1+n)) với (ssdel ent ss) có thể làm như sau:

(lụm đc của bác GiaBach thì phải :D )

(defun c:test()
(setq n 0 start1 (getvar 'millisecs))
(repeat (expt 10 7)
	(setq n (1+ n)))
(setq end1 (getvar 'millisecs))
(princ (strcat "\nThoi gian chay ham 1: " (rtos (/ (- end1 start1) 1000.) 2 3) " giay !"))
(setq ss (ssget)
	  ent (ssname ss 0)
	  start2 (getvar...
>>

@Nhóc: Nếu muốn so sánh về tốc độ của hàm (setq n (1+n)) với (ssdel ent ss) có thể làm như sau:

(lụm đc của bác GiaBach thì phải :D )

(defun c:test()
(setq n 0 start1 (getvar 'millisecs))
(repeat (expt 10 7)
	(setq n (1+ n)))
(setq end1 (getvar 'millisecs))
(princ (strcat "\nThoi gian chay ham 1: " (rtos (/ (- end1 start1) 1000.) 2 3) " giay !"))
(setq ss (ssget)
	  ent (ssname ss 0)
	  start2 (getvar 'millisecs))
(repeat (expt 10 7)
	(ssdel ent ss))
(setq end2 (getvar 'millisecs))
(princ (strcat "\nThoi gian chay ham 2: " (rtos (/ (- end2 start2) 1000.) 2 3) " giay !"))
(princ)
)

Tuy nhiên, trong code của Nhóc có đoạn:

(repeat (sslength ss2)
     (copytext (ssname ss1 0) (ssname ss2 i))
     (setq i (1+ i))
     )

Hàm (ssname ss1 0) cứ lặp lại và luôn cho cùng 1 kết quả >>> Nếu xét về tốc độ thì cần đặt biến phụ cho thằng này ^^

Hoặc lấy luôn cont như mình có lẻ nhanh hơn !

Tuy nhiên, với level của tụi mình hiện tại thì việc cải thiện tốc độ vẫn còn là viễn cảnh của 1 ngày đẹp trời Nhóc ah ! :D :D :D

Chúc cho Nhoc "đạp mạnh chân" để cùng học 1 bài với mình cho vui !!!

Download lisp

Filename: 316623_test.lsp

Tác giả: VUVUZELA
Bài viết gốc: 124846
Tên lệnh: thu

Lựa chọn đối tượng sau khi boundary

Bạn có thể làm như thế này
Tạo boundnảy tính diện tich xong thì xoá nó đi

Download lisp

Filename: 124846_thu.lsp

Tác giả: gia_bach
Bài viết gốc: 96537
Tên lệnh: ha

Viết lisp theo yêu cầu [phần 2]

Cách khác để chuyển Hatch từ associative -> Non-associative

Download lisp

Filename: 96537_ha.lsp

Tác giả: Tue_NV
Bài viết gốc: 103895
Tên lệnh: ttoa

Viết lisp theo yêu cầu [phần 2]

Chào bác Bình
Chổ bí của bác đã được Tue_NV giải đáp ở đây :
Lissp ttoa - Bai viet so 2432 và chổ bí của bác cũng được Tue_NV viết ngay trong bài viết này.
Bạn tnmpc, bác Bình thử nhé :
Đây là code :

code có 1 điểm nhỏ chưa hoàn thiện. Các bác sử dụng xong sẽ thấy . Và vì không có thời gian rãnh nên Tue_NV chưa giải quyết nốt. Các bác ráng chờ vậy
Chúc...

Download lisp

Filename: 103895_ttoa.lsp

Tác giả: qh2qa06
Bài viết gốc: 314541
Tên lệnh: cca

tính chênh cao cho mắt lưới

Gõ lệnh một phát là có kết quả luôn, kỳ diệu quá!

Thì sửa cái lsp trên 1 chút, nhưng ở đây thấy có 3 số lẻ và không nhân 100.

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
    (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (setq ss (vl-remove-if 'listp (mapcar...
>>

Gõ lệnh một phát là có kết quả luôn, kỳ diệu quá!

Thì sửa cái lsp trên 1 chút, nhưng ở đây thấy có 3 số lẻ và không nhân 100.

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
    (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" '((0 . "TEXT") (8 . "CDTN,CDTK,CC"))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTK")) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTN")) ss)
        sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CC")) ss))
  (while sstk
    (setq v (car sstk)
 sstk (cdr sstk)
 cdtk (atof (dxf 1 v))
 tm  (gan v sstn)
 cc  (gan v sscc))
    (if (and tm cc)
       (setq cdtn (atof (dxf 1 tm))
    sstn (vl-remove tm sstn)
    sscc (vl-remove cc sscc)
    tm1 (entmod (subst (cons 1 (rtos (abs  (- cdtn cdtk)) 2 3)) (assoc 1 (entget cc)) (entget cc)))
    )
    )
  )
  (princ)
)

Nhưng layer để tính sẽ phải là CDTK, CDTN và CC đúng không ạ?

Em cảm ơn bác!

Bác ơi giá trị CC = CDTK-CDTN. Lisp của bác đang tính là lấy số lớn trừ số nhỏ nên kết quả tính không đúng trên toàn bộ mặt bằng. Kết quả Chênh cao của em có cả giá trị âm (-), dương (+) và 0. Âm là đào, dương là đắp.

Download lisp

Filename: 314541_cca.lsp

Tác giả: nhoclangbat
Bài viết gốc: 316699
Tên lệnh: ttl

Xin lisp tính chiều dài trung bình và DL của thanh thép biến thiên

- hi hi lâu lâu nhóc thử tự viết lsp theo y/c ko chỉnh sửa lsp cũ xem thế nào, bạn dùng thử cho nhoc ý kiến hen ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1...
>>

- hi hi lâu lâu nhóc thử tự viết lsp theo y/c ko chỉnh sửa lsp cũ xem thế nào, bạn dùng thử cho nhoc ý kiến hen ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1)))
	 )
  )
)  
 ;=========================================================
(prompt "Chon thanh co chieu dai lon nhat:")
(setq lmax (ssget "+.:E:S" '((0 . "LINE"))))
(if lmax
 (progn
    (setq ename2 (ssname lmax 0)
	      info2 (entget ename2)
		  dai2 (distance (cdr (assoc 10 info2)) (cdr (assoc 11 info2)))
	 )
  )
)  
;===========================================================
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq ltb (* (/ (+ dai1 dai2) 2.0) 1000))
(setq ldelta (* (/ (- dai2 dai1) (- sl 1)) 1000))
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(entmod (subst (cons 1 (strcat (itoa (- sl 1)) ",L = " (rtos ltb 2 0))) (assoc 1 e1) e1))
;===============================================================
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(entmod (subst (cons 1 (strcat (rtos (* dai1 1000) 2 0) "~" (rtos (* dai2 1000) 2 0) ", \U+0394L=" (rtos ldelta 2 0))) (assoc 1 e2) e2))
(setvar "osmode" old)
(princ "\n")
(princ)
)

Download lisp

Filename: 316699_ttl.lsp

Tác giả: hiepttr
Bài viết gốc: 316748
Tên lệnh: game2

Chương 10.4 : Grread

- Cái Lsp đầu bạn không dùng biến input -> ok

- Cái Lsp sau bạn viết sao cho chỉ sử dụng hàm grread chỉ có 1 lần nhưng không sử dụng biến input

Túm lại, Lsp bạn viết sẽ không có sử dụng biến nào cả

Chắc bạn xử được! :)

Hôm qua đang hứng...