Lisp tăng số trong text nhưng chỉ được tối đa 100

Tháng 8 31, 2007

thứ nhất cái lệnh copy text chỉ tăng đến 100 là dừng, nhờ các thí chủ hiệu chỉnh lại hộ

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	100)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:cp ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"CP\" to start")
;Note: bien toan cuc: textxl vitrilech
thứ hai cai lisp cập nhất khoảng cách và góc quay cua bần tăng chỉ chạy đúng khi điểm cuối cùng phải click đến hai lần, còn click 1 lần thì nó ko nhận nhờ pác Nguyễn Hoành xem hộ và chỉ giáo nhé
(Defun C:ktd ()
(PROMPT "CHU Y, TY LE BAN VE LA 1M = 1000 DON VI")

 (SETQ FN1 (GETFILED "CHON TEN FILE GHI KHOANG CACH VA GOC QUAY MAT BANG" "" "xls" 1)) ; tao file
  ;(SETQ FN2 (GETFILED "CHON TEN FILE goc quay Y" "" "xls" 1)) ; tao file
 (IF (NULL FN1)
   (PRINC "CHUA CHON TEN"); eslse
   (PROGN
(SETQ PW1 (OPEN FN1 "a")) ; mo file
(SETQ ghichu "TENCOC K/C GOCQUAY")
(WRITE-line ghichu PW1)
;(SETQ PW2 (OPEN FN2 "a"))
(setq n (GETreal"\nCHON SO COC"))
;-******************************************************
(princ "chon diem so ")
   (princ n )
   (princ " (")
 (princ n)
(SETQ A (GETPOINT "\nth point)")) ; chon diem
(print)
 	(command "insert" "COC" A "" "" "" ) ; insert coc
(setq l1 0)
(setq n1 (rtos n 2 0))
(SETQ L4 (STRCAT n1 " " "0" " " "0"))
(WRITE-line l4 PW1)
(setq n (+ 1 n));2
;***********************************
(princ "chon diem so ")
   (princ n )
   (princ " (")
 (princ n)
 (SETQ b (GETPOINT "th point)"))
(print)
 (command "insert" "COC" b "" "" "" )
 (setq L3 (distance A :unsure:) 
(setq l4 (rtos (/ L3 1000) 2 2))
;(WRITE-line l4  PW1); k/c 1 -2 ok
;bat dau tinh goc 1 - 2
	(setq goc1 (angle a :unsure:)
(setq gocdo (cvunit goc1 "radians""degree"))
	(setq ghigoc (rtos gocdo 2 2))

	;(write-line ghigoc PW2)
;*********************************
(princ "chon diem so ")
   (princ (+ 1 n) )
   (princ " (")
 (princ (+ 1 n))
(SETQ c (GETPOINT "th point)"))
(print)
 (command "insert" "COC" c "" "" "" )
 	;(WRITE-line l4  PW1); k/c 1 -2 ok
;bat dau tinh goc 1 - 2
	(setq goc2 (angle b c))
	(setq goc (+ pi (- goc2 goc1)))
(setq gocdo (cvunit goc "radians""degree"))
(if (<= gocdo 180)
 	(setq ghigoc (rtos (abs gocdo) 2 2))
(progn
(setq doi (abs (- 360 gocdo)))
(setq ghigoc (rtos doi 2 2))
)
 )
(setq n1 (rtos n 2 0))
(SETQ L4 (STRCAT n1 " " l4 " " ghigoc))
(WRITE-line l4 PW1)

(setq L5 (distance b c)) 
(setq l6 (rtos (/ L5 1000) 2 2))
(setq n (+ 1 n));3
;**********************************************
(setq dk "t")
(WHILE	(= dk "t");bat dau while
 (princ "chon diem so ")
   (princ (+ 1 n))
   (princ " (")
 (princ (+ 1 n))
  (SETQ d (GETPOINT "th point)"));diem 3
	(print)
 	(command "insert" "COC" d "" "" "" )
;xong k/c 2-3 ok
;bat dau tinh goc 2 - 3
(setq goc3 (angle c d))
(setq goc (+ pi (- goc3 goc2)))
(setq gocdo (cvunit goc "radians""degree"))
(if (<= gocdo 180)
 	(setq ghigoc (rtos (abs gocdo) 2 2))
(progn
(setq doi (abs (- 360 gocdo)))
(setq ghigoc (rtos doi 2 2))
)
 )
 (setq n1 (rtos n 2 0))
(setq ghi (strcat n1 " " l6 " " ghigoc))
(write-line ghi PW1)
 	(setq L5 (distance c d)) 
(setq l6 (rtos (/ L5 1000) 2 2))
;xong goc2 - 3 ok
(setq goc2 goc3)
(setq c d)
(setq n (+ 1 n))

 )
;dong while
(setq n1 (rtos n 2 0))
(setq ghi (strcat n1 " " l6 " " "0"))
(write-line ghi PW1)
     (CLOSE PW1)
;(CLOSE PW2)
     )
  )
 )
   (print "type ktd to start")

Tháng 8 31, 2007

thứ nhất cái lệnh copy text chỉ tăng đến 100 là dừng, nhờ các thí chủ hiệu chỉnh lại hộ

Mình đã chỉnh lại, copy đến 999..

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	100)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

Tháng 8 31, 2007

Mình đã chỉnh lại, copy đến 999..

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	100)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

vẫn chưa đưoc pac thanhlamct oi, pac xem lại cho em cái

Tháng 8 31, 2007

vẫn chưa đưoc pac thanhlamct oi, pac xem lại cho em cái

sory, post nhầm

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	10000)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

Tháng 8 31, 2007

sory, post nhầm

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	10000)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

pác này chơi nhau quá

chỉ copy từ 99 đén 100 thôi, sau đó lại nhảy lên 11, 12 ....

pác post lại cái nữa nhé!

Đăng nhập

Lisp tăng số trong text nhưng chỉ được tối đa 100

Các bài được khuyến nghị

ainhandilac 5

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhlamct 70

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ainhandilac 5

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhlamct 70

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ainhandilac 5

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse