Đến nội dung


Hình ảnh
- - - - -

[Nhờ chính sửa] Lisp tịnh tiến số + chữ


  • Please log in to reply
4 replies to this topic

#1 nhimret

nhimret

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 May 2015 - 09:57 AM

 Kính nhờ các bác chỉnh sửa hộ lisp này với :) cám ơn trước đã

 

Triệu chứng: Lisp hiện giờ tịnh tiến rất tốt, nhưng cứ ở hàng chục có số 0, thì lisp bỏ mất số 0 mà chỉ tịnh tiến số sau (VD: 01 tịnh tiến thành 2, 101 tịnh tiến thành 12)

 

Yêu cầu: nhờ các bác chỉnh lại hộ sao cho 01 --> 02 --> 03, 101 -> 102 -> 103 v.v...

 

Cám ơn các bác nhiều

 

p/s: lisp cũng lấy ở forum thời gian rất lâu rồi nên không nhớ được tác giả là ai, xin lỗi bác tác giả trước không ghi credit nhé <3

(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:44 ( / 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

;Note: bien toan cuc: textxl vitrilech

;****************************************

  • 0

#2 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 11 May 2015 - 10:49 AM

Mình nhanh cho Bạnhttp://www.cadviet.c...s/4/3202_44.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/128171-nha-cha-nh-sa-a-lisp-ta-nh-tia-n-sa-cha/
(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+ (read text)))
      (setq text (rtos luusokt 2 0))
			;|(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:44 (/ 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 
    (setq toi	    (getpoint "\nSelect next point: " goc))
	  (setq
	  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

;Note: bien toan cuc: textxl vitrilech

;****************************************


  • 0

#3 nhimret

nhimret

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 May 2015 - 11:47 AM

hoành tráng :) cám ơn tien2005 nhiều


  • 0

#4 kill.g4

kill.g4

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 May 2015 - 04:36 AM

@tien2005 bạn ơi mình sử dụng đến số 99 thì lại quay về số " 0 ", không tiến lên 100,101, ... Bạn edit lại giúp mình với nhé.

Cám ơn bạn rất nhiều!


  • 0

#5 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 16 May 2015 - 02:16 PM

lisp trên mình đã xủ lý vấn đề đó rồi mà


  • 0