Chuyển đến nội dung
Diễn đàn CADViet
interwar1283

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

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

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

  • Vote tăng 14
  • Vote giảm 1

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

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

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?

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

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

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é!

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

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

  • Vote tăng 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

@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.

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
@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:

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

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ó!

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

  • Vote tăng 1

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

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ỉ.

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

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

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

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
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ụ"?

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

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

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!

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×