Giúp mình Lisp đánh số bản vẽ này với!

Tháng 10 25, 2009

Mình tìm trên diễn đàn mình thấy rất nhiều các lisp đánh số tự động nhưng mình thấy chưa có cái nào làm hoàn thiện được bản vẽ của mình như thế này! (Xin xem bản vẽ đính kèm theo bài viết).

Xin bác Tue_NV, Nguyen Hoanh.......và các cao thủ giúp em viết cái lisp để hoàn thiện cách đánh số bản vẽ này với!

Em xin cảm ơn các bác và các bạn rất nhiều!

Ghi chú:

-Những số có cùng màu là cùng một loại (cách đánh số giống nhau)!

-File đính kèm:

http://www.mediafire.com/download.php?jivi2mdmtmz

(mình Upload lên cadviet nhưng không được nên upload qua mediafire)

Cảm ơn các Pro!

Tháng 10 25, 2009

Mình tìm trên diễn đàn mình thấy rất nhiều các lisp đánh số tự động nhưng mình thấy chưa có cái nào làm hoàn thiện được bản vẽ của mình như thế này! (Xin xem bản vẽ đính kèm theo bài viết).
Xin bác Tue_NV, Nguyen Hoanh.......và các cao thủ giúp em viết cái lisp để hoàn thiện cách đánh số bản vẽ này với!

Em xin cảm ơn các bác và các bạn rất nhiều!

Ghi chú:

-Những số có cùng màu là cùng một loại (cách đánh số giống nhau)!

-File đính kèm:

http://www.mediafire.com/download.php?jivi2mdmtmz

(mình Upload lên cadviet nhưng không được nên upload qua mediafire)

Cảm ơn các Pro!

Tue_NV muốn hỏi bạn mấy ý để viết Lisp khỏi mất thời gian :

1. Bạn muốn đánh số thứ tự như thế nào?

Trong bản vẽ của bạn có trường hợp như thế này :

1.1.1 -> 1.1.2 -> 1.1.3 ...=> theo mình hiểu là số cuối tăng dần

1a -> 2a -> 3a ...=> theo mình hiểu là số đầu tăng dần

- Liệu còn trường hợp nào nữa không? Bạn hãy suy nghĩ kỹ rồi reply nhé

Chào bạn.

Tháng 10 25, 2009

Tue_NV muốn hỏi bạn mấy ý để viết Lisp khỏi mất thời gian :
1. Bạn muốn đánh số thứ tự như thế nào?

Trong bản vẽ của bạn có trường hợp như thế này :

1.1.1 -> 1.1.2 -> 1.1.3 ...=> theo mình hiểu là số cuối tăng dần

1a -> 2a -> 3a ...=> theo mình hiểu là số đầu tăng dần

- Liệu còn trường hợp nào nữa không? Bạn hãy suy nghĩ kỹ rồi reply nhé

Chào bạn.

Tue_VN thân!

Đúng rồi Tue_NV ạ, ý mình là như thế! Nhưng có một điều mình muốn hỏi cho rõ nhé Tue_VN!

1. Còn trường hợpx 10a7.1->10a7.2-->10a7.3.....có giống với trường hợp 1.1.1-->1.1.2 không?

2. Câu này chắc mình hỏi hơi thừa một chút, nhưng cũng nên hỏi để Tue_NV giúp mình dễ dàng hơn.

Nếu như mình đánh số được 1.1.1-->1.1.2 thì mình sẽ đánh được số 1.1-->1.2-->1.3 chứ Tue_NV.

Cảm ơn Tue_NV nhé!

Tháng 10 25, 2009

Tue_VN thân!
Đúng rồi Tue_NV ạ, ý mình là như thế! Nhưng có một điều mình muốn hỏi cho rõ nhé Tue_VN!

1. Còn trường hợpx 10a7.1->10a7.2-->10a7.3.....có giống với trường hợp 1.1.1-->1.1.2 không?

2. Câu này chắc mình hỏi hơi thừa một chút, nhưng cũng nên hỏi để Tue_NV giúp mình dễ dàng hơn.

Nếu như mình đánh số được 1.1.1-->1.1.2 thì mình sẽ đánh được số 1.1-->1.2-->1.3 chứ Tue_NV.

Cảm ơn Tue_NV nhé!

Lisp đánh số theo thứ tự này Tue_NV viết đúng theo yêu cầu của bạn

gồm 2 trường hợp :

Nếu bạn chọn D : xảy ra trường hợp 1

Trường hợp 1. Số đầu tăng 1 đơn vị, chuỗi kí tự cuối cố định

Ví dụ : 1a ; 2a; 3a

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi : D

Danh so bat dau :1

Danh ki tu ket thuc :a

Nếu bạn chọn C : xảy ra trường hợp 2

Trường hợp 2. chuỗi kí tự đầu cố định, Số cuối tăng 1 đơn vị,

Ví dụ : 1.1.1-->1.1.2

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi :C

Danh ki tu bat dau : 1.1.

Danh so ket thuc :1

Các trường hợp khác của bạn tự suy luận sẽ ra cách đánh số thứ tự (không có vấn đề gì cả) vì Lisp trên Tue_NV đã viết theo trường hợp tổng quát rồi

Bạn chú ý rằng TextStyle lấy theo style hiện hành đấy nhé :

Code đây :

;; copyright by Tue_NV
(defun c:dstt(/ ans dau cuoi po po1 ent i)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi  :"))
(if (= ans "D")
   (progn
(setq dau (getint "\n Danh so bat dau  :") i 1)
(setq cuoi (getstring 5"\n Danh ki tu ket thuc :"))
(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi)))		
(wtxt (strcat (itoa dau) cuoi) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)

(if (= ans "C")
   (progn
(setq dau (getstring 5"\n Danh ki tu bat dau :"))
(setq cuoi (getint "\n Danh so ket thuc  :") i 1)	
(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi))))		
(wtxt (strcat dau (itoa cuoi)) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

Trường hợp bạn sử dụng chức năng download Lisp file của DD mà không được thì hãy nhấn nút Reply bài viết này của Tue_NV -> chép hết code về sử dụng nhé.

Tháng 10 25, 2009

Cảm ơn Tue_NV nhé! Mình thấy rất vui vì được bạn giúp đỡ nhiệt tình như vậy đấy! Thật sự mình rất vui. Mình không biết bao gờ mới giỏi như Tue_NV và các bạn để giúp đỡ mọi người như Tue_VN!

Chúc Tue_NV và các bạn luôn mạnh khỏe để giúp đỡ mọi người!

(Mình sẽ thử và mình sẽ thông báo kết quả cho Tue_VN nhé!)

Tháng 10 25, 2009

Lisp đánh số theo thứ tự này Tue_NV viết đúng theo yêu cầu của bạn
gồm 2 trường hợp :

Nếu bạn chọn D : xảy ra trường hợp 1

Trường hợp 1. Số đầu tăng 1 đơn vị, chuỗi kí tự cuối cố định

Ví dụ : 1a ; 2a; 3a

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi : D

Danh so bat dau :1

Danh ki tu ket thuc :a

Nếu bạn chọn C : xảy ra trường hợp 2

Trường hợp 2. chuỗi kí tự đầu cố định, Số cuối tăng 1 đơn vị,

Ví dụ : 1.1.1-->1.1.2

Command: dstt

Ban muon danh so tang dan o vi tri dau hay cuoi :C

Danh ki tu bat dau : 1.1.

Danh so ket thuc :1

Các trường hợp khác của bạn tự suy luận sẽ ra cách đánh số thứ tự (không có vấn đề gì cả) vì Lisp trên Tue_NV đã viết theo trường hợp tổng quát rồi

Bạn chú ý rằng TextStyle lấy theo style hiện hành đấy nhé :

Code đây :
;; copyright by Tue_NV
(defun c:dstt(/ ans dau cuoi po po1 ent i)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi  :"))
(if (= ans "D")
   (progn
(setq dau (getint "\n Danh so bat dau  :") i 1)
(setq cuoi (getstring 5"\n Danh ki tu ket thuc :"))
(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi)))		
(wtxt (strcat (itoa dau) cuoi) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)

(if (= ans "C")
   (progn
(setq dau (getstring 5"\n Danh ki tu bat dau :"))
(setq cuoi (getint "\n Danh so ket thuc  :") i 1)	
(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi))))		
(wtxt (strcat dau (itoa cuoi)) po)
     (while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
     );while
   )
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
Trường hợp bạn sử dụng chức năng download Lisp file của DD mà không được thì hãy nhấn nút Reply bài viết này của Tue_NV -> chép hết code về sử dụng nhé.

Mình đã test thử và kết quả ----> có vài điều này mình muốn góp ý để hoàn Tue_NV hoàn thiện hơn.

-Sau khi thực hiện lệnh nó không thay số cũ (vốn có) mà nó đè luôn lên, mình lại phải mất công xóa cái cũ đi.

-Để thực hiện được mình lại phải copy một cái vòng tròn có sẵn một số bất kỳ trước, sau đó mới thực hiện được lệnh!

-Tue_NV có thể viết thêm cái vòng tròn vào để cho tiện hơn được không?

Vậy Tue_NV có thể phát triển để cho nó dễ sử dụng hơn không?

Hi vọng, Tue_NV sẽ phát triển cái lisp này để nó được hoàn thiện một cách Tuyệt vời hơn!

Cảm ơn Tue_Vn nhiều nhiều!

Tháng 10 25, 2009

Mình đã test thử và kết quả ----> có vài điều này mình muốn góp ý để hoàn Tue_NV hoàn thiện hơn.
-Sau khi thực hiện lệnh nó không thay số cũ (vốn có) mà nó đè luôn lên, mình lại phải mất công xóa cái cũ đi.

-Để thực hiện được mình lại phải copy một cái vòng tròn có sẵn một số bất kỳ trước, sau đó mới thực hiện được lệnh!

-Tue_NV có thể viết thêm cái vòng tròn vào để cho tiện hơn được không?

Vậy Tue_NV có thể phát triển để cho nó dễ sử dụng hơn không?

Hi vọng, Tue_NV sẽ phát triển cái lisp này để nó được hoàn thiện một cách Tuyệt vời hơn!

Cảm ơn Tue_Vn nhiều nhiều!

Lệnh CV trong LISP (của TRAN LE PHUONG) dưới đây cho phép bạn copy tất cả những gỉ đi kèm với Text rồi tăng số/chữ theo yêu cầu.

Tuy nhiên Lisp chỉ thay đổi chử số cuối và tối đa đến 100 mà thôi.

Nhờ Tue_NV bổ xung thêm để hoàn thiện theo yêu cầu đánh chử số đầu của minhphuong_humg. Thank you.

(DEFUN C:XX (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
               PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT13I (POLAR PT13 GOCY 2))
	(SETQ PT14I (POLAR PT14 GOCY 2))
	(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
	(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
	(SETQ O13 (ASSOC 13 DS))
	(SETQ O14 (ASSOC 14 DS))
	(SETQ N13 (CONS 13 PT13N))
	(SETQ N14 (CONS 14 PT14N))
	(SETQ DS (SUBST N13 O13 DS))
	(SETQ DS (SUBST N14 O14 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:YY (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
               PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT10I (POLAR PT10 GOCY 2))
	(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
	(SETQ KC (DISTANCE PT10 PT10N))
	(SETQ O10 (ASSOC 10 DS))
	(SETQ N10 (CONS 10 PT10N))
	(SETQ DS (SUBST N10 O10 DS))
	(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
	(SETQ O11 (ASSOC 11 DS))
	(SETQ N11 (CONS 11 PT11N))
	(SETQ DS (SUBST N11 O11 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;-----------------------
(defun c:cd (/ A B C D)
 (setvar "CMDECHO" 0)
 (prompt "\nFor rotated copy")
 (ssget)
 (setq A (getpoint "\nBase point: "))
 (command "ID" A)
 (setq B (getpoint "\nNew point  if same as Base point> "))
 (if (= B nil) (setq B A))
;  (setq D (/ (* (getangle B "\nRotation angle <0>: ") 180.0) pi))
 (command "COPY" "P" "" A A)
 (command "MOVE" "P" "" A :bigsmile:
 (command "ROTATE" "P" "" B pause)
 (setvar "CMDECHO" 1)
)
;COP THONG MINH
(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

;COPY THONG MINH
(defun c:CV ( / 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 "TRAN LE PHUONG KSXD")
;Note: bien toan cuc: textxl vitrilech

Bode box có lổi, xin sửa như sau:

----------(command "MOVE" "P" "" A :bigsmile:---------------

Tháng 10 25, 2009

Hình như Code box có lổi, chử B và dấu ) viết liền thì cho ra hình mặt:

Thử post lại, nếu vẩn lổi thì xin CADVIET xem lại nhé:

(DEFUN C:XX (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
               PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT13I (POLAR PT13 GOCY 2))
	(SETQ PT14I (POLAR PT14 GOCY 2))
	(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
	(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
	(SETQ O13 (ASSOC 13 DS))
	(SETQ O14 (ASSOC 14 DS))
	(SETQ N13 (CONS 13 PT13N))
	(SETQ N14 (CONS 14 PT14N))
	(SETQ DS (SUBST N13 O13 DS))
	(SETQ DS (SUBST N14 O14 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:YY (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
               PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT10I (POLAR PT10 GOCY 2))
	(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
	(SETQ KC (DISTANCE PT10 PT10N))
	(SETQ O10 (ASSOC 10 DS))
	(SETQ N10 (CONS 10 PT10N))
	(SETQ DS (SUBST N10 O10 DS))
	(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
	(SETQ O11 (ASSOC 11 DS))
	(SETQ N11 (CONS 11 PT11N))
	(SETQ DS (SUBST N11 O11 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;-----------------------
(defun c:cd (/ A B C D)
 (setvar "CMDECHO" 0)
 (prompt "\nFor rotated copy")
 (ssget)
 (setq A (getpoint "\nBase point: "))
 (command "ID" A)
 (setq B (getpoint "\nNew point  if same as Base point> "))
 (if (= B nil) (setq B A))
;  (setq D (/ (* (getangle B "\nRotation angle <0>: ") 180.0) pi))
 (command "COPY" "P" "" A A)
 (command "MOVE" "P" "" A :bigsmile:
 (command "ROTATE" "P" "" B pause)
 (setvar "CMDECHO" 1)
)
;COP THONG MINH
(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

;COPY THONG MINH
(defun c:CV ( / 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 "TRAN LE PHUONG KSXD")
;Note: bien toan cuc: textxl vitrilech

Tháng 10 25, 2009

Hình như Code box có lổi, chử B và dấu ) viết liền thì cho ra hình mặt:

Thử post lại, nếu vẩn lổi thì xin CADVIET xem lại nhé:

(DEFUN C:XX (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
               PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT13I (POLAR PT13 GOCY 2))
	(SETQ PT14I (POLAR PT14 GOCY 2))
	(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
	(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
	(SETQ O13 (ASSOC 13 DS))
	(SETQ O14 (ASSOC 14 DS))
	(SETQ N13 (CONS 13 PT13N))
	(SETQ N14 (CONS 14 PT14N))
	(SETQ DS (SUBST N13 O13 DS))
	(SETQ DS (SUBST N14 O14 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:YY (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
               PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT10I (POLAR PT10 GOCY 2))
	(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
	(SETQ KC (DISTANCE PT10 PT10N))
	(SETQ O10 (ASSOC 10 DS))
	(SETQ N10 (CONS 10 PT10N))
	(SETQ DS (SUBST N10 O10 DS))
	(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
	(SETQ O11 (ASSOC 11 DS))
	(SETQ N11 (CONS 11 PT11N))
	(SETQ DS (SUBST N11 O11 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;-----------------------
(defun c:cd (/ A B C D)
 (setvar "CMDECHO" 0)
 (prompt "\nFor rotated copy")
 (ssget)
 (setq A (getpoint "\nBase point: "))
 (command "ID" A)
 (setq B (getpoint "\nNew point  if same as Base point> "))
 (if (= B nil) (setq B A))
;  (setq D (/ (* (getangle B "\nRotation angle <0>: ") 180.0) pi))
 (command "COPY" "P" "" A A)
 (command "MOVE" "P" "" A :bigsmile:
 (command "ROTATE" "P" "" B pause)
 (setvar "CMDECHO" 1)
)
;COP THONG MINH
(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

;COPY THONG MINH
(defun c:CV ( / 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 "TRAN LE PHUONG KSXD")
;Note: bien toan cuc: textxl vitrilech

Mình không rành về khoản Autolisp này lắm! Mong Tue_NV và các Pro giúp đỡ mình để mình có thể hoàn thiện đưọc những bản vẽ tiếp theo!

Xin cảm ơn!

Tháng 10 25, 2009

Tue_Vn ơi, sau khi thử đi thử lại mình thấy lisp ở trên còn một lỗi nữa (ngoài những hạn chế trên) đó là: Khi đánh số theo thứ tự tăng dần ví dụ: 1a-->2a-->3a. Khi ta muốn kết thúc ở 3a, mình nhấn phím cách (hoặc Enter) thì nó lại nhảy lên 1 đơn vị là 4a. Như vậy chuỗi mới lại trở thành 1a-->2a-->4a. Mong Tue_NV khắc phục thêm hạn chế đó nữa để lisp hoàn thiện hơn!

Cảm ơn

Tháng 10 25, 2009

Mình đã test thử và kết quả ----> có vài điều này mình muốn góp ý để hoàn Tue_NV hoàn thiện hơn.
-Sau khi thực hiện lệnh nó không thay số cũ (vốn có) mà nó đè luôn lên, mình lại phải mất công xóa cái cũ đi.

-Để thực hiện được mình lại phải copy một cái vòng tròn có sẵn một số bất kỳ trước, sau đó mới thực hiện được lệnh!

-Tue_NV có thể viết thêm cái vòng tròn vào để cho tiện hơn được không?

Vậy Tue_NV có thể phát triển để cho nó dễ sử dụng hơn không?

Hi vọng, Tue_NV sẽ phát triển cái lisp này để nó được hoàn thiện một cách Tuyệt vời hơn!

Cảm ơn Tue_Vn nhiều nhiều!

Tue_NV chưa thực hiện yêu cầu ở dòng màu đỏ vì bạn chưa nói rõ từ đầu

Bạn sử dụng Lisp này cho hoàn thiện đã, có gì rồi Tue_NV sẽ hoàn thiện thêm :

(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi :"))
(if (= ans "D")
(progn
(setq dau (getint "\n Danh so bat dau :") i 1)
(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu  :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu  :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi))) 
(wtxt (strcat (itoa dau) cuoi) po cao r)
(setq eL (entlast))
(command "circle" po (* 1.1 cao))

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "circle" po1 (* 1.1 cao))

(setq po po1)
);while
)
)

(if (= ans "C")
(progn
(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)
(setq cuoi (getint "\n Danh so ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu  :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu  :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) ))) 
(wtxt (strcat dau (itoa cuoi)) po cao r)
(setq eL (entlast))
(command "circle" po (* 1.1 cao))

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "circle" po1 (* 1.1 cao))

(setq po po1)
);while
)
)

(princ)
)
;
(defun wtxt (txt p h w / sty d)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)
(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)
(cons 72 1) (cons 73 2) 
)
)
)

Tháng 10 25, 2009

Tue_NV chưa thực hiện yêu cầu ở dòng màu đỏ vì bạn chưa nói rõ từ đầu

Bạn sử dụng Lisp này cho hoàn thiện đã, có gì rồi Tue_NV sẽ hoàn thiện thêm :

(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi < D / C >:"))
(if (= ans "D")
(progn
(setq dau (getint "\n Danh so bat dau :") i 1)
(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi))) 
(wtxt (strcat (itoa dau) cuoi) po cao r)
(setq eL (entlast))
(command "circle" po (* 1.1 cao))

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "circle" po1 (* 1.1 cao))

(setq po po1)
);while
)
)

(if (= ans "C")
(progn
(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)
(setq cuoi (getint "\n Danh so ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) ))) 
(wtxt (strcat dau (itoa cuoi)) po cao r)
(setq eL (entlast))
(command "circle" po (* 1.1 cao))

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "circle" po1 (* 1.1 cao))

(setq po po1)
);while
)
)

(princ)
)
;
(defun wtxt (txt p h w / sty d)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)
(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)
(cons 72 1) (cons 73 2) 
)
)
)

Cảm ơn Tue_NV. Mình đã chạy thử và thấy nó chạy rất ổn, theo đúng ý mình. Cảm ơn Tue_NV nhiều nhiều. Hi vọng là Tue_NV sẽ sớm hoàn thành nốt phần còn lại!

Chúc Tue_NV và các bạn trong Diễn đàn luôn mạnh khỏe! Mình sẽ rất mong chờ Version tiếp theo của lisp này!

Tháng 10 25, 2009

Cảm ơn Tue_NV, nhưng mình vừa chạy lại lisp đó mà đã thấy nó chạy sai rồi.
Ban muon danh so tang dan o vi tri dau hay cuoi :bigsmile:

Danh so bat dau :1

Danh chuoi ki tu ket thuc :a

Nhap chieu cao chu :0.5

Nhap do rong chu :0.5

(Mình còn thử cho trường hợp chiều cao:1, chieu rong: 2).

Nhưng ngay cái thứ 2 thì số nó đã bị bật ra khỏi vòng tròn rồi. Không biết nó là bị làm sao rồi Tue_VN. Tue_NV xem xét giúp mình!

Xin cảm ơn!

Bạn nhấn nút Reply Bài viết trên của Tue_NV (bài viết số 11) (gửi vào #11)

-> chép hết code (không sót nhé) về chạy là được. Trong Lisp có bổ sung nhập chiều cao và độ rộng chữ cho lần sau

Vì hiện nay chức năng download Lisp file của Diễn đàn bị lỗi

Tháng 10 25, 2009

Bạn nhấn nút Reply Bài viết trên của Tue_NV (bài viết số 11) (gửi vào #11)
-> chép hết code (không sót nhé) về chạy là được. Trong Lisp có bổ sung nhập chiều cao và độ rộng chữ cho lần sau

Vì hiện nay chức năng download Lisp file của Diễn đàn bị lỗi

Cảm ơn Tue_NV. Mình đã chạy thử và thấy nó chạy rất ổn, theo đúng ý mình. Cảm ơn Tue_NV nhiều nhiều. Hi vọng là Tue_NV sẽ sớm hoàn thành nốt phần còn lại!

Chúc Tue_NV và các bạn trong Diễn đàn luôn mạnh khỏe!

Mình sẽ rất mong chờ Version tiếp theo của lisp này!

Cảm ơn rất nhiều!

Tháng 10 25, 2009

Cảm ơn Tue_NV. Mình đã chạy thử và thấy nó chạy rất ổn, theo đúng ý mình. Cảm ơn Tue_NV nhiều nhiều. Hi vọng là Tue_NV sẽ sớm hoàn thành nốt phần còn lại!
Chúc Tue_NV và các bạn trong Diễn đàn luôn mạnh khỏe!

Mình sẽ rất mong chờ Version tiếp theo của lisp này!

Cảm ơn rất nhiều!

Bạn không cần khách sáo như vậy.

Bạn thấy bài viết nào hay hoặc bạn muốn cảm ơn ai thì cứ tick Thanks phía dưới là được,

tránh những bài viết để cảm ơn như thế này nhé.

Chúc một ngày Chủ Nhật vui vẻ

Tháng 4 6, 2012

Tue_NV chưa thực hiện yêu cầu ở dòng màu đỏ vì bạn chưa nói rõ từ đầu

Bạn sử dụng Lisp này cho hoàn thiện đã, có gì rồi Tue_NV sẽ hoàn thiện thêm :

(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)(setvar "cmdecho" 0)(initget "D C")(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi < D / C >:"))(if (= ans "D")(progn(setq dau (getint "\n Danh so bat dau :") i 1)(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))(if (not caoo) (setq caoo 5))(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))(if (not cao) (setq cao caoo) (setq caoo cao))(if (not ro) (setq ro 1))(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))(if (not r) (setq r ro) (setq ro r))(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi))) (wtxt (strcat (itoa dau) cuoi) po cao r)(setq eL (entlast))(command "circle" po (* 1.1 cao))(while po(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))(command "copy" eL "" po po1) (setq eL (entlast))(setq ent (entget eL))(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))(entmod ent)(setq i (1+ i))(command "circle" po1 (* 1.1 cao))(setq po po1));while))(if (= ans "C")(progn(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)(setq cuoi (getint "\n Danh so ket thuc :"))(if (not caoo) (setq caoo 5))(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))(if (not cao) (setq cao caoo) (setq caoo cao))(if (not ro) (setq ro 1))(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))(if (not r) (setq r ro) (setq ro r))(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) ))) (wtxt (strcat dau (itoa cuoi)) po cao r)(setq eL (entlast))(command "circle" po (* 1.1 cao))(while po(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))(command "copy" eL "" po po1) (setq eL (entlast))(setq ent (entget eL))(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))(entmod ent)(setq i (1+ i))(command "circle" po1 (* 1.1 cao))(setq po po1));while))(princ));(defun wtxt (txt p h w / sty d)(setq sty (getvar "textstyle")d (tblsearch "style" sty))(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)(cons 72 1) (cons 73 2) )))

Em chào bác Tuệ, trước đây em dùng chưa "va" phải trường hợp đó nên chưa biết. Nay dùng lại lisp này mới thấy có một điều Xin bác giúp đỡ. Đó là cái "vòng tròn" đó nó không "che, đè" lên được đối tượng khác (Polyline, text....) để khi mình in ra cho bản vẽ nó đẹp hơn ấy ạ. Mong bác giúp đỡ em chức năng đó với ạ.

Trân trọng cảm ơn bác.

Tháng 4 6, 2012

Tue_VN thân!

Đúng rồi Tue_NV ạ, ý mình là như thế! Nhưng có một điều mình muốn hỏi cho rõ nhé Tue_VN!

1. Còn trường hợpx 10a7.1->10a7.2-->10a7.3.....có giống với trường hợp 1.1.1-->1.1.2 không?

2. Câu này chắc mình hỏi hơi thừa một chút, nhưng cũng nên hỏi để Tue_NV giúp mình dễ dàng hơn.

Nếu như mình đánh số được 1.1.1-->1.1.2 thì mình sẽ đánh được số 1.1-->1.2-->1.3 chứ Tue_NV.

Cảm ơn Tue_NV nhé!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=51710
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=34029
;; free lisp from cadviet.com
;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************

;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(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>: "))
(wtxt 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
(command "undo" "be")
(setq
e (car (entsel "\nSelect template text:"))
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
k (strlen cn)
i (getint "\n Nhap so ky tu can giu trong suffix: ")
cn0 (substr cn 1 (- k i))
cn1 (substr cn (1+ (- k i)))
)
(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" cn0)
n (vl-string-subst "" c cn0)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
(command "copy" e "" p1 p2)
(if (= n "")
   	(setq cn0 (incC cn0))
   	(setq cn0 (strcat c (incN (vl-string-subst "" c cn0) dn)))      
)
(setq
   	dat (entget (entlast))
   	dat (subst (cons 1 (strcat cn0 cn1)) (assoc 1 dat) dat)
)
(entmod dat)  
)
(command "undo" "e")
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0 (car (entsel "\nSelect attribute block:"))
e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
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" e0 "" p1 p2)
(if (= n "")
   	(setq cn (incC cn))
   	(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))      
)
(setq
   	dat (entget (entnext (entlast)))
   	dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
(command "regen")
)
(princ)
)
;;;============================

Mình góp vui tí nhé. Trên diễn đàn đã có lisp này có thể đáp ứng được yêu cầu copy tăng dần của bạn nè.

Lệnh: OC

Tháng 4 6, 2012

Cảm ơn bach212, nhưng ý mình không xin thêm cái lisp đánh số nữa! Mà cái lisp bácTue_NV viết kia đã chuẩn rồi. Nhưng trước đây mình đánh trên bản vẽ mà chưa để ý xem nó đè lên các PL, TXT chưa. Giờ cần in bản vẽ ra thì nó lại chưa đè được các cái đó. Nếu mà wipeout từng cái một thì lâu quá. Giờ mình mong anh Tue_NV chỉnh giúp cái chức năng đó đè lên các đối tượng khác để khi in ra nó không bị lẫn ở trong.

Xin góp ý thêm lisp bạn chia sẻ file: od_oc_oca.lsp mình thấy nó không chuyên nghiệp như của bác Tue_NV lắm. Điển hình là mình dùng lệnh OC, OCA khi chọn đối tượng của mình (gồm một vòng tròn, và chữ số bên trong (1, 1.1, 1/1, 1.1.a, 1.1.1.....) thì nó không thể chọn được 2 đối tượng đó, nhưng của bác Tue_NV thì làm được điều đó. Mình chưa có thời gian thử hết nên mình có góp ý nhỏ nhỏ thế. Mong bạn thông cảm cho mình nếu mình nói chưa chính xác nha. Rất mong bạn chia sẻ những kiến thức tiếp theo.

Trân trọng cảm ơn.

Tháng 4 6, 2012

Em chào bác Tuệ, trước đây em dùng chưa "va" phải trường hợp đó nên chưa biết. Nay dùng lại lisp này mới thấy có một điều Xin bác giúp đỡ. Đó là cái "vòng tròn" đó nó không "che, đè" lên được đối tượng khác (Polyline, text....) để khi mình in ra cho bản vẽ nó đẹp hơn ấy ạ. Mong bác giúp đỡ em chức năng đó với ạ.

Trân trọng cảm ơn bác.

Tue_NV viết thêm cho bạn đây :


(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi < D / C >:"))
(if (= ans "D")
(progn
(setq dau (getint "\n Danh so bat dau :") i 1)
(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi))) 
(command "polygon" "360" po "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(wtxt (strcat (itoa dau) cuoi) po cao r)
(setq eL (entlast))

(command "DRAWORDER" el "" "F")

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "polygon" "360" po1 "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(command "DRAWORDER" el "" "F")

(setq po po1)
);while
)
)

(if (= ans "C")
(progn
(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)
(setq cuoi (getint "\n Danh so ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) ))) 
(command "polygon" "360" po "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(wtxt (strcat dau (itoa cuoi)) po cao r)
(setq eL (entlast))

(command "DRAWORDER" el "" "F")

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" eL "" po po1) 
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "polygon" "360" po1 "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(command "DRAWORDER" el "" "F")

(setq po po1)
);while
)
)

(princ)
)
;
(defun wtxt (txt p h w / sty d)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)
(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)
(cons 72 1) (cons 73 2) 
)
)
)

Tháng 4 8, 2012

Hi các bạn, nhân tien với slip đánh số tăng dần. Các bạn có thể viết giúp mình slip chèn leader đánh số tự động tăng dần với. Mình cần để đánh số mối hàn trên bản vẽ đường ống.

Yêu cầu:

- Chọn được chiều cao text

- Điểm thứ nhất là vị trí chèn leader(truy bắt điểm là endpoint và nearest, đầu mũi tên của leader co dạng dotmall)

- Điểm thừ hai là vị trí cúa điểm chèn text( text đặt trong vong tròn của circle-leader)

- Lệnh được thực hiện liên tục với các text được đánh theo thứ tự tang dần.(vd: số đầu tiên được chèn vào là 2 thì các số kế tiếp sẽ được chọn tăng dần)

File đính kèm:

http://www.cadviet.com/upfiles/3/19201_file_mau.dwg

Tháng 4 8, 2012

File đính kèm!

Tháng 4 8, 2012

Tue_NV viết thêm cho bạn đây :


(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)
(setvar "cmdecho" 0)
(initget "D C")
(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi < D / C >:"))
(if (= ans "D")
(progn
(setq dau (getint "\n Danh so bat dau :") i 1)
(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi)))
(command "polygon" "360" po "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(wtxt (strcat (itoa dau) cuoi) po cao r)
(setq eL (entlast))

(command "DRAWORDER" el "" "F")

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))
(command "copy" eL "" po po1)
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "polygon" "360" po1 "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(command "DRAWORDER" el "" "F")

(setq po po1)
);while
)
)

(if (= ans "C")
(progn
(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)
(setq cuoi (getint "\n Danh so ket thuc :"))
(if (not caoo) (setq caoo 5))
(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(if (not ro) (setq ro 1))
(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))
(if (not r) (setq r ro) (setq ro r))

(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) )))
(command "polygon" "360" po "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(wtxt (strcat dau (itoa cuoi)) po cao r)
(setq eL (entlast))

(command "DRAWORDER" el "" "F")

(while po
(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))
(command "copy" eL "" po po1)
(setq eL (entlast))
(setq ent (entget eL))
(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(command "polygon" "360" po1 "I" (* 1.15 cao)
"wipeout" "p" "L" "y")
(command "DRAWORDER" el "" "F")

(setq po po1)
);while
)
)

(princ)
)
;
(defun wtxt (txt p h w / sty d)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)
(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)
(cons 72 1) (cons 73 2)
)
)
)

Cảm ơn bác Tue_NV rất nhiều ạ. Em thấy rất tuyệt bác ạ. Nhưng em có một điều xin được hỏi bác là em đang đánh số, nếu em cứ thay đối Zoom liên tục (lúc to, lúc nhỏ) thì số em đang đánh sẽ bị "bật" khỏi vòng tròn bác ạ. Còn nếu cứ để cùng một chế độ Zoom thì ok. Xin bác chỉ dẫn cho em với ạ. Trân trọng cảm ơn bác.

Tháng 4 8, 2012

Hi các bạn, nhân tien với slip đánh số tăng dần. Các bạn có thể viết giúp mình slip chèn leader đánh số tự động tăng dần với. Mình cần để đánh số mối hàn trên bản vẽ đường ống.

Yêu cầu:

- Chọn được chiều cao text

- Điểm thứ nhất là vị trí chèn leader(truy bắt điểm là endpoint và nearest, đầu mũi tên của leader co dạng dotmall)

- Điểm thừ hai là vị trí cúa điểm chèn text( text đặt trong vong tròn của circle-leader)

- Lệnh được thực hiện liên tục với các text được đánh theo thứ tự tang dần.(vd: số đầu tiên được chèn vào là 2 thì các số kế tiếp sẽ được chọn tăng dần)

File đính kèm:

http://www.cadviet.c...01_file_mau.dwg

Co ai giup minh voi!

Tháng 4 9, 2012

Hi các bạn, nhân tien với slip đánh số tăng dần. Các bạn có thể viết giúp mình slip chèn leader đánh số tự động tăng dần với. Mình cần để đánh số mối hàn trên bản vẽ đường ống.

Yêu cầu:

- Chọn được chiều cao text

- Điểm thứ nhất là vị trí chèn leader(truy bắt điểm là endpoint và nearest, đầu mũi tên của leader co dạng dotmall)

- Điểm thừ hai là vị trí cúa điểm chèn text( text đặt trong vong tròn của circle-leader)

- Lệnh được thực hiện liên tục với các text được đánh theo thứ tự tang dần.(vd: số đầu tiên được chèn vào là 2 thì các số kế tiếp sẽ được chọn tăng dần)

File đính kèm:

http://www.cadviet.c...01_file_mau.dwg

Bạn Tue_NV giúp mình với. Công việc mình đang rất cần :blush: :blush: !

Tháng 7 4, 2012

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=51710
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=34029
;; free lisp from cadviet.com
;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************

;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(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>: "))
(wtxt 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
(command "undo" "be")
(setq
e (car (entsel "\nSelect template text:"))
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
k (strlen cn)
i (getint "\n Nhap so ky tu can giu trong suffix: ")
cn0 (substr cn 1 (- k i))
cn1 (substr cn (1+ (- k i)))
)
(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" cn0)
n (vl-string-subst "" c cn0)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
(command "copy" e "" p1 p2)
(if (= n "")
   	(setq cn0 (incC cn0))
   	(setq cn0 (strcat c (incN (vl-string-subst "" c cn0) dn)))      
)
(setq
   	dat (entget (entlast))
   	dat (subst (cons 1 (strcat cn0 cn1)) (assoc 1 dat) dat)
)
(entmod dat)  
)
(command "undo" "e")
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0 (car (entsel "\nSelect attribute block:"))
e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
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" e0 "" p1 p2)
(if (= n "")
   	(setq cn (incC cn))
   	(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))      
)
(setq
   	dat (entget (entnext (entlast)))
   	dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
(command "regen")
)
(princ)
)
;;;============================

Mình góp vui tí nhé. Trên diễn đàn đã có lisp này có thể đáp ứng được yêu cầu copy tăng dần của bạn nè.

Lệnh: OC

Chào các bác: Em thấy đoạn lisp này rất phù hợp với việc đánh số bản vẽ của em. Nhưng em muốn nhờ bác sửa thêm theo một số ý sau với ạ:

1- Đoạn lisp OD:

- Có thêm phần hỏi nhập chiều cao chữ là bao nhiêu nữa ạ.

2- Đoạn lisp OC:

- Chọn Template text xong, Lisp sẽ hỏi số hàng cần array, khoảng cách Array (gõ số hoặc click 2 điểm)

Em Upload File cã kiểu đánh số thứ tự mà em hay phải đánh. Mong các bác giúp đỡ.

Em xin cám ơn nhiều ạ!

http://www.cadviet.com/upfiles/3/110072_reinf.dwg

Đăng nhập

Giúp mình Lisp đánh số bản vẽ này với!

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

minhphuong_humg 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

Tue_NV 3.912

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

minhphuong_humg 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

Tue_NV 3.912

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

minhphuong_humg 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

minhphuong_humg 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

Phiphi- 176

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

Phiphi- 176

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

minhphuong_humg 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

minhphuong_humg 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

Tue_NV 3.912

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

minhphuong_humg 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

Tue_NV 3.912

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

minhphuong_humg 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

Tue_NV 3.912

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

minhphuong_humg 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

bach1212 4

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

minhphuong_humg 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

Tue_NV 3.912

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

loiphong 0