Đánh số thứ tự tăng dần

[interwar1283 216]

Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by Interwar1283
;*********************************************************************
(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

[thanhlamct 70]

Cảm ơn interwar1283 đã Share. Cái này mà dùng để đánh số thứ tự nút thì tuyệt vời. Thanhks!

[PLBang 0]

Cám ơn thật nhiều!

Rất tiện lợi.

[vta 0]

Cám ơn thật nhiều!

Rất tiện lợi.

bạn hướng dẫn cụ thể hơn đi

[interwar1283 216]

bạn hướng dẫn cụ thể hơn đi

Ví dụ bạn muốn đánh số thứ tự (cầu thang, hay trục, hay số thứ tự một bảng nào đấy...). Bạn đang có số giá trị bất kỳ (giả sử là số 2) chẳng hạn, bạn aploap lisp đó, rồi đánh lệnh CO, chọn số đầu tiên muốn copy (số 2), thì bạn copy sang vị trí mới sẽ được số 3, cứ mỗi lần pick sang vị trí tiếp theo là tăng 1 đơn vị. Với các text là chữ cái thì tăng theo thứ tự trong bảng chữ cái (A, B, C...).

[buratino1703 3]

Em ko biết về lisp nên em copy đoạn mã của bác interwar1283 về máy, mở 1 lisp khác rồi pasteốn vào sau đó save lại. Mở cad và load chúng báo successfully loaded, đánh các lệnh: MODAU, KETTHUC và XULYTEXT mà nó có hiện cái gì đâu bác?

[interwar1283 216]

Em ko biết về lisp nên em copy đoạn mã của bác interwar1283 về máy, mở 1 lisp khác rồi pasteốn vào sau đó save lại. Mở cad và load chúng báo successfully loaded, đánh các lệnh: MODAU, KETTHUC và XULYTEXT mà nó có hiện cái gì đâu bác?

Lệnh CO.

 

Command: co

 

Copy Inteligent...

 

Select objects:

[buratino1703 3]

Hi..hi..là tại vì em copy cái đoạn code trên về nhưng khi dán vào 1 lisp khác thì nó bị lộn xộn, không có lề lối gì cả(ko hiểu vì sao???). Mò mẫm save cả trang topic về, mở ra bằng microsoft word rồi mới copy, lần này dán vào lisp thì thẳng hàng, đánh lệnh CO là chạy băng băng. Cảm ơn bác nhé!

[Hoa Trang trắng 3]

Ví dụ bạn muốn đánh số thứ tự (cầu thang, hay trục, hay số thứ tự một bảng nào đấy...). Bạn đang có số giá trị bất kỳ (giả sử là số 2) chẳng hạn, bạn aploap lisp đó, rồi đánh lệnh CO, chọn số đầu tiên muốn copy (số 2), thì bạn copy sang vị trí mới sẽ được số 3, cứ mỗi lần pick sang vị trí tiếp theo là tăng 1 đơn vị. Với các text là chữ cái thì tăng theo thứ tự trong bảng chữ cái (A, B, C...).

Bác ơi thế giả sử nếu lên tất cả các số thì bản vẽ quá dày đặc , muốn cách mấy điểm mới lấy 1 giá trị thì làm thế nào ạ? (1, 4, 8...)

[ssg 1.102]

Bác ơi thế giả sử nếu lên tất cả các số thì bản vẽ quá dày đặc , muốn cách mấy điểm mới lấy 1 giá trị thì làm thế nào ạ? (1, 4, 8...)

Bạn dùng thử chương trình sau. Có 2 lệnh:

1) Lệnh OD: Ordinate number with any format. Đánh số thứ tự với bất kỳ định dạng nào: số, chữ, chữ và số. Ví dụ:

Command: od

Begin at <1>: HTT-01-03. Nếu không nhập số, bấm Enter sẽ mặc định từ 1

Increment <1>: 3. Nếu không nhập số, bấm Enter sẽ lấy mặc định là 1

Base point <exit>: chỉ điểm -> HTT-01-03

Base point <exit>: chỉ điểm -> HTT-01-06

Base point <exit>: chỉ điểm -> HTT-01-09

.........

Đến khi... chán thì:

Base point <exit>: Enter -> Thoát

 

2) Lệnh OC: Ordinate number, Copy from template. Đánh số thứ tự bằng cách copy mẫu có sẵn. Hoạt động giống như trên, nhưng thay vì "Begin at" thì chọn một mẫu có sẵn và 1 điểm tham chiếu làm chuẩn (tương tự như trình của bạn Lê Huy Hà nhưng có thêm tính năng tùy chọn Increment theo ý bạn).

Các bạn dùng nếu thấy có gì bất ổn thì phản hồi để mình sửa.

 

;;;------------------------------------------------------------------------------------
(defun getTw() ;;;Get textstyle
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th) ;;;Get textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p) ;;;Entmake text S at p
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
    (cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;------------------------------------------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;==============================================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
   (emkT cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;==============================================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(princ)
)
;;;==============================================

[pooh_21 0]

@ssg Lisp của bác rất hay nhưng bác có thể cải tiến nó lên một chút được không. Cụ thể là không phải nhập Begin at <1>: mà chọn một text có sẵn trên màn hình rồi thực hiện mấy bước tiếp theo. Thanks ssg.

[duy782006 1.518]

@ssg Lisp của bác rất hay nhưng bác có thể cải tiến nó lên một chút được không. Cụ thể là không phải nhập Begin at <1>: mà chọn một text có sẵn trên màn hình rồi thực hiện mấy bước tiếp theo. Thanks ssg.

 

Bạn này hỏi rất hăng nhưng không chịu đọc bài của người ta gì cả

Lệnh OC: Ordinate number, Copy from template. Đánh số thứ tự bằng cách copy mẫu có sẵn

Phụ lòng người ta chết. :bigsmile:

[ssg 1.102]

Cám ơn các bạn đã quan tâm. Thật ra, tự mình biết chương trình có chỗ còn chưa ưng ý lắm ở phần xử lý chữ (do mới bổ sung tính năng increment). Chờ ý kiến các bạn mình sẽ sửa luôn thể. Đừng khen, cái mình cần là sự phát hiện của các bạn về nhược điểm của nó!

[Hoa Trang trắng 3]

Cám ơn các bạn đã quan tâm. Thật ra, tự mình biết chương trình có chỗ còn chưa ưng ý lắm ở phần xử lý chữ (do mới bổ sung tính năng increment). Chờ ý kiến các bạn mình sẽ sửa luôn thể. Đừng khen, cái mình cần là sự phát hiện của các bạn về nhược điểm của nó!

Cám ơn bạn, mình dùng thấy OK mà, đợi khi nào phát hiện ra nhược điểm thì chê sau có được kg? Bi giờ khen trước đã :bigsmile:

[gp14 1.134]

Cái này cũng hay thật nhưng mà lisp của Tớ bị liệt rồi không thêm, cũng không sửa được lệnh, bác nào biết nguyên nhân chỉ cho mình với nhỉ.

[buratino1703 3]

Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by Interwar1283
;*********************************************************************
(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

Lệnh của bác đến 100 thì die, vì khi đánh số đến 101 thì nó hiện 1, 102 hiện 2(quay vòng)! Khắc phục bằng cách nào vậy bác?

[alpha 3]

Cái này hay đấy!

Thanks pác nha!

[sumi 55]

Cám ơn các bạn đã quan tâm. Thật ra, tự mình biết chương trình có chỗ còn chưa ưng ý lắm ở phần xử lý chữ (do mới bổ sung tính năng increment). Chờ ý kiến các bạn mình sẽ sửa luôn thể. Đừng khen, cái mình cần là sự phát hiện của các bạn về nhược điểm của nó!

mình dùng thầy rất tốt,tạm thời chưa thấy j hết ,nếu có thì mình nhắn liền,nó hay lắm lắm,cảm ơn ssq nhìu nhìu

[vinataba 3]

Cám ơn các bạn đã quan tâm. Thật ra, tự mình biết chương trình có chỗ còn chưa ưng ý lắm ở phần xử lý chữ (do mới bổ sung tính năng increment). Chờ ý kiến các bạn mình sẽ sửa luôn thể. Đừng khen, cái mình cần là sự phát hiện của các bạn về nhược điểm của nó!

Bác SSG ơi, bác có thể sửa thêm lệnh "OC" được không. Tức là có 1 điểm text nằm trong 1 hình tròn, mình muốn copy luôn cả hình tròn theo và text thì tăng dần.(cái này dùng để đánh trục)

[vinataba 3]

bác SSG dạo này đi đâu thế nhỉ.

[ssg 1.102]

bác SSG dạo này đi đâu thế nhỉ.

Ssg vẫn quanh quẩn đây, đã xem yêu cầu của bạn nhưng bận quá chưa rờ tới được. Nói thật tình, thời gian ssg có thể dành cho CadViet không được nhiều lắm và biến động thất thường. Nếu các bạn thấy ssg "mất tích" trong khoảng thời gian khá dài thì có nghĩa là cơ quan của ssg đang vào một "chiến dịch" khẩn nào đó.

Yêu cầu của bạn đơn giản thôi, không có vấn đề gì. Mình định sẽ đưa vào mục tiện ích chung của dự án LandCadViet Utility:

 

http://www.cadviet.com/forum/index.php?sho...c=2691&st=0

 

Có vẻ công việc của bạn cũng có liên quan đến cái này. Bạn có thể tham gia đóng góp ý kiến cùng anh em cho thêm phần "xôm tụ"?

[ngayve324 270]

Bác SSG ơi, bác có thể sửa thêm lệnh "OC" được không. Tức là có 1 điểm text nằm trong 1 hình tròn, mình muốn copy luôn cả hình tròn theo và text thì tăng dần.(cái này dùng để đánh trục)

hình như cái này ban cú vẽ vòng tròng rồi ghi text bình thường trong hình tròn, swr dụng lệnh CO trên cũng được mà

[vtq 1]

mình chả hiểu cách chạy các code này như thế nào cả.mong cả nhà chỉ dùm!!!

[Nguyen Hoanh 4.663]

mình chả hiểu cách chạy các code này như thế nào cả.mong cả nhà chỉ dùm!!!

Bạn xem ở đây: http://www.cadviet.com/sub/tips/showtip.php?t=14

[meohoang 344]

Bạn xem ở đây: http://www.cadviet.com/sub/tips/showtip.php?t=14

Anh Hoành xin làm ơn gởi cho file acad.lin hay acadío.lin có linetype ký hiệu cỏ , cây , lá...

trước đây tôi có down trên 4rum rồi nhưng máy bị hỏng mất file này . Mấy ngày nay tìm đường link của Duy788 đều die cả

Mong giúp mình tí, đang rất cần. Cảm ơn trước!