Đến nội dung


Hình ảnh
- - - - -

Nhờ Viết Lisp Đánh Số Cột Đèn Có Phân Pha!


  • Please log in to reply
16 replies to this topic

#1 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 04 December 2015 - 11:22 AM

Nhờ các bác trong diễn đàn giúp em việc này với ạ. Công việc của em đang làm là đánh số thứ thự cho cột đèn có kèm theo việc phân pha cho các cột đèn đó!

Ví dụ có 10 cột đèn trên 1 tuyến lấy từ tủ chiếu sáng số 1, lộ 1. Thì trên bản vẽ các cột đèn sẽ được đánh số thứ tự lần lượt là: TCS1/L1/1A-TCS1/L1/2B-TCS1/L1/3C-TCS1/L1/4A-TCS1/L1/5B-TCS1/L2/6C.... cứ như vậy đến hết (mỗi 1 vòng lặp có 3 pha A-B-C)

Hiện tại em đánh thủ công bằng sửa text nhưng việc này mất thời gian quá.

Các bác giúp em với nhé, em cảm ơn nhiều ạ!


  • -2

#2 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 04 December 2015 - 01:38 PM

Bác nào rảnh giúp em với nhé, em cần lắm ạ!


  • -2

#3 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 December 2015 - 02:51 PM

Bác nào rảnh giúp em với nhé, em cần lắm ạ!

Hề hề hề,

Rảnh cũng thua bởi chả hiểu bạn nói cái chi??? Bản vẽ không có? TCS1 là gì trên bản vẽ?? L1 là cái gì trên bản vẽ??? Giời hiểu nên chờ giời giúp nhé.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#4 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 04 December 2015 - 03:17 PM

Hề hề hề,

Rảnh cũng thua bởi chả hiểu bạn nói cái chi??? Bản vẽ không có? TCS1 là gì trên bản vẽ?? L1 là cái gì trên bản vẽ??? Giời hiểu nên chờ giời giúp nhé.

Xin lỗi vì em diễn đạt ko thoát ý. Em xin giải thích cụ thể hơn ạ. TCS1 là tủ chiếu sáng số 1, L1 là lộ số 1. 2 thông số đấy là cố định khi dùng lisp, còn thông số nhảy theo lisp là thứ tự các đèn được phân pha: 1A, 2B, 3C, 4A, 5B, 6C, 7A, 8B, 9C, 10A…. (nghĩa là khi click chuột vào đèn đầu tiên thì text hiển thị là  TCS1/L1/1A, click vào đèn thứ 2 thì text hiển thị là TCS1/L1/2B….). Trước em có dùng lisp đánh số cột đèn rồi, cũng xin trên diễn đàn mình, nhưng nó chỉ nhảy được ký tự cuối cùng là số thôi, và tăng đều theo cấp số cộng là 1. Còn cái này lại cần tăng đồng thời cả 2 ký tự cuối, phần số  thì tăng đều theo cấp số cộng , còn phần chữ thì tăng theo vòng lặp A-B-C-A-B-C….

Không biết em diễn đạt thế này bác có hiểu được ý em không, hichic


  • -1

#5 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 04 December 2015 - 04:30 PM

Rảnh nên làm thầy bói phát xem sao :D :D :D

;;;lisp danh so cot den
(defun c:SCD( / st str p chu str1)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
(while
	(setq p (getpoint "\nPick: "))
	(setq chu (nth (rem st 3) '("A" "B" "C"))
		  st (1+ st)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 2.5 0 "L" nil nil 2 nil)
)
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#6 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 04 December 2015 - 04:52 PM

 

Rảnh nên làm thầy bói phát xem sao :D :D :D

;;;lisp danh so cot den
(defun c:SCD( / st str p chu str1)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
(while
	(setq p (getpoint "\nPick: "))
	(setq chu (nth (rem st 3) '("A" "B" "C"))
		  st (1+ st)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 2.5 0 "L" nil nil 2 nil)
)
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

Quá là tuyệt bác ạ, còn hơn cả mong đợi của em ấy, vì có thể lựa chọn tại bất kỳ điểm nào, và có thể lựa chọn được các thông số bắt đầu trong chuỗi text. Em chỉ nhờ bác xíu nữa thôi là hoàn hảo, đó là bác có thể thêm lựa chọn cho thông số cuối cùng được không ạ, nghĩa là sau khi hỏi “stt cột đầu tiên” - gõ thông số,  thì sẽ hỏi thêm “pha đầu tiên” ý ạ!

Một lần nữa cảm ơn bác rất rất nhiều!


  • 0

#7 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 04 December 2015 - 04:55 PM

Nghĩa là không nhất thiết pha A la: 1 4 7 10 13 ... ?


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#8 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 04 December 2015 - 05:01 PM

Nghĩa là không nhất thiết pha A la: 1 4 7 10 13 ... ?

Đúng rồi đấy bạn, các thông số cho điểm đầu tiên thì mình có thể lựa chọn, nhưng sau đó sẽ tịnh tiến theo quy luật! 


  • 0

#9 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 04 December 2015 - 05:17 PM

Đây bạn:

;;;lisp danh so cot den
(defun c:SCD( / st str i p chu str1)
(setq    #tu (NGT #tu "1" getstring "Tu chieu sang so")
        #lo (NGT #lo "1" getstring "Lo so")
        #st (NGT #st 1 getint "STT cot dau tien")
        st (1- #st)
        str (strcat "TCS" #tu "/L" #lo "/")
        )
(initget "A B C")
(setq #pha (NGT #pha "A" getkword "Pha dau tien [A/B/C]"))
(cond ((= (strcase #pha) "A")
        (setq i -1)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
    ((= (strcase #pha) "B")
        (setq i 0)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
    ((= (strcase #pha) "C")
        (setq i 1)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
)
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
    ((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
    (modul)
    (a)
    )
    )
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial    
(setq Lst (list '(0 . "TEXT")
                (cons 8 (if Layer Layer (getvar "Clayer")))                                    
                (cons 62 (if Color Color 256))                                    
                (cons 10 point)                                    
                (cons 40 Height)                                    
                (cons 1 string)                                    
                (if Ang (cons 50 Ang))                                    
                (cons 7 (if Style Style (getvar "Textstyle")))                                    
                (cons -3 (if xdata (list xdata) nil)))                
                justify (strcase justify))    
                (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))                
                      ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))                
                      ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))                
                      ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))                
                      ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))                
                      ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))                    
                      ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))                
                      ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))                
                      ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))                
                      ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))                
                      ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))                
                      ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
                      )    
                      (entmakex Lst)
);end
;=================================

Bài viết đã được chỉnh sửa nội dung bởi hiepttr: 04 December 2015 - 05:32 PM

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#10 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 04 December 2015 - 07:18 PM

Với LISP này thì tôi góp ý về tối ưu chiều dài code

Nhiều người (trong đó có cả cử nhân tin học hệ chính quy) hay lập trình kiểu copy - paste.

Lập trình kiểu này có ưu điểm là ít phải đầu tư chất xám, nhưng có 2 nhược điểm chính:

- Code dài

- Khi phát hiện lỗi, phải sửa nhiều chỗ => dễ sửa thiếu, type nhầm.

Nhầm lẫn này đôi khi khó phát hiện vì khi test không xảy ra trường hợp đó.

Ở bài này, nếu đặt biến phụ thì có thể chỉ dùng 1 vòng while ngoài cond.

Ngoài ra, nếu có nhiều trường hợp theo quy luật, có thể dùng hàm khác thay cho cond.

VD trong bài này là A, B, C không nhiều lắm, nhưng nếu từ A - Z thì cond quá dài.


  • 2

#11 HoaVien

HoaVien

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 04 December 2015 - 09:45 PM

Với LISP này thì tôi góp ý về tối ưu chiều dài code

Nhiều người (trong đó có cả cử nhân tin học hệ chính quy) hay lập trình kiểu copy - paste.

Lập trình kiểu này có ưu điểm là ít phải đầu tư chất xám, nhưng có 2 nhược điểm chính:

- Code dài

- Khi phát hiện lỗi, phải sửa nhiều chỗ => dễ sửa thiếu, type nhầm.

Nhầm lẫn này đôi khi khó phát hiện vì khi test không xảy ra trường hợp đó.

Ở bài này, nếu đặt biến phụ thì có thể chỉ dùng 1 vòng while ngoài cond.

Ngoài ra, nếu có nhiều trường hợp theo quy luật, có thể dùng hàm khác thay cho cond.

VD trong bài này là A, B, C không nhiều lắm, nhưng nếu từ A - Z thì cond quá dài.

Ý, nhột quá, Bác đừng "châm chọc" hàng xóm của bác nhé.


  • 0

#12 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 05 December 2015 - 08:18 AM

 

Đây bạn:

;;;lisp danh so cot den
(defun c:SCD( / st str i p chu str1)
(setq    #tu (NGT #tu "1" getstring "Tu chieu sang so")
        #lo (NGT #lo "1" getstring "Lo so")
        #st (NGT #st 1 getint "STT cot dau tien")
        st (1- #st)
        str (strcat "TCS" #tu "/L" #lo "/")
        )
(initget "A B C")
(setq #pha (NGT #pha "A" getkword "Pha dau tien [A/B/C]"))
(cond ((= (strcase #pha) "A")
        (setq i -1)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
    ((= (strcase #pha) "B")
        (setq i 0)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
    ((= (strcase #pha) "C")
        (setq i 1)
    (while
        (setq p (getpoint "\nPick: "))
        (setq i (1+ i))
        (setq chu (nth (rem i 3) '("A" "B" "C"))
            st (1+ st)
            str1 (strcat str (itoa st) chu)
            )
        (MakeText p str1 2.5 0 "L" nil nil 2 nil)
    )
    )
)
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
    ((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
    (modul)
    (a)
    )
    )
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial    
(setq Lst (list '(0 . "TEXT")
                (cons 8 (if Layer Layer (getvar "Clayer")))                                    
                (cons 62 (if Color Color 256))                                    
                (cons 10 point)                                    
                (cons 40 Height)                                    
                (cons 1 string)                                    
                (if Ang (cons 50 Ang))                                    
                (cons 7 (if Style Style (getvar "Textstyle")))                                    
                (cons -3 (if xdata (list xdata) nil)))                
                justify (strcase justify))    
                (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))                
                      ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))                
                      ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))                
                      ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))                
                      ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))                
                      ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))                    
                      ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))                
                      ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))                
                      ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))                
                      ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))                
                      ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))                
                      ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
                      )    
                      (entmakex Lst)
);end
;=================================

Cảm ơn bạn đã rất nhiệt tình giúp đỡ mình, lisp này là đúng như những gì mình mong muốn

Được voi đòi tiên, mình nhờ bạn thêm việc này được không ạ. Với lisp này thì text không được xác định chiều cao nên có thể không theo text quy định của bản vẽ.  Bạn có thể phát triển thêm lựa chọn cao độ text không ạ!


  • 0

#13 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 05 December 2015 - 08:28 AM

OK ! :D

Đã update lisp theo ý bạn và sự chỉ điểm của bác ndtnv

 

p/s:

Dẫu biết bạn chỉ có tối đa điện 3 pha A B C.

Nhưng mình đang luyện bài nên nếu bạn muốn thì code trên có thể nâng lên thành n pha :D

 

>>> Cảm ơn bác ndtnv đã chỉ điểm, mình học được khá nhiều từ bác !

;;;lisp danh so cot den
(defun c:SCD( / st str lst_pha i p vi_tri chu str1)
(vl-load-com)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
;;;========+++++++++++
;Thay doi, them bot lst_pha o day:
(setq lst_pha '("A" "B" "C"))
;;;=======++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
(defun add_space (str) (strcat str " "))
(defun add_solidus (str) (strcat str "/"))
(initget 1 (strcat (apply 'strcat (mapcar 'add_space (reverse (cdr (reverse lst_pha))))) (last lst_pha)))
(setq #pha (NGT #pha "A" getkword (strcat "Pha dau tien [" (apply 'strcat (mapcar 'add_solidus (reverse (cdr (reverse lst_pha))))) (last lst_pha) "]")))
;;;========
(setq #text_h (NGT #text_h 2.5 getint "Chieu cao chu"))
(setq i -1)
(while (setq p (getpoint "\nPick: "))
	(setq i (1+ i)
		  st (1+ st)
		  vi_tri (vl-position (strcase #pha) lst_pha)
		  chu (nth (rem (+ i vi_tri) (length lst_pha)) lst_pha)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 #text_h 0 "L" nil nil 2 nil)
)	;while
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

  • 2

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#14 nhocbabi

nhocbabi

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 05 December 2015 - 08:49 AM

 

OK ! :D

Đã update lisp theo ý bạn và sự chỉ điểm của bác ndtnv

 

p/s:

Dẫu biết bạn chỉ có tối đa điện 3 pha A B C.

Nhưng mình đang luyện bài nên nếu bạn muốn thì code trên có thể nâng lên thành n pha :D

 

>>> Cảm ơn bác ndtnv đã chỉ điểm, mình học được khá nhiều từ bác !

;;;lisp danh so cot den
(defun c:SCD( / st str lst_pha i p vi_tri chu str1)
(vl-load-com)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
;;;========+++++++++++
;Thay doi, them bot lst_pha o day:
(setq lst_pha '("A" "B" "C"))
;;;=======++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
(defun add_space (str) (strcat str " "))
(defun add_solidus (str) (strcat str "/"))
(initget 1 (strcat (apply 'strcat (mapcar 'add_space (reverse (cdr (reverse lst_pha))))) (last lst_pha)))
(setq #pha (NGT #pha "A" getkword (strcat "Pha dau tien [" (apply 'strcat (mapcar 'add_solidus (reverse (cdr (reverse lst_pha))))) (last lst_pha) "]")))
;;;========
(setq #text_h (NGT #text_h 2.5 getint "Chieu cao chu"))
(setq i -1)
(while (setq p (getpoint "\nPick: "))
	(setq i (1+ i)
		  st (1+ st)
		  vi_tri (vl-position (strcase #pha) lst_pha)
		  chu (nth (rem (+ i vi_tri) (length lst_pha)) lst_pha)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 #text_h 0 "L" nil nil 2 nil)
)	;while
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

Cám ơn bạn, về mặt ứng dụng, đối với  mình như này là quá ổn rồi! Mặc dù pha mình chỉ sử dụng chỉ là A, B, C, không bao giờ hơn, nên nếu bạn muốn tối ưu hóa lisp như góp ý của bạn ndtnv thì bạn có thể nghiên cứu thêm nhé J


  • 0

#15 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 05 December 2015 - 10:36 AM

 

OK ! :D

Đã update lisp theo ý bạn và sự chỉ điểm của bác ndtnv

 

p/s:

Dẫu biết bạn chỉ có tối đa điện 3 pha A B C.

Nhưng mình đang luyện bài nên nếu bạn muốn thì code trên có thể nâng lên thành n pha :D

 

>>> Cảm ơn bác ndtnv đã chỉ điểm, mình học được khá nhiều từ bác !

1 like cho ý tưởng: Lập trình có dự trù đến sự phát triển nâng cấp về sau.

Bài này có thể không dùng đến, nhưng các hàm này có thể ứng dụng cho các bài tương tự mà chỉ cần vài sửa đổi nhỏ.


  • 0

#16 vanthangv

vanthangv

    biết pan

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

Đã gửi 04 March 2016 - 01:40 PM

 

OK ! :D

Đã update lisp theo ý bạn và sự chỉ điểm của bác ndtnv

 

p/s:

Dẫu biết bạn chỉ có tối đa điện 3 pha A B C.

Nhưng mình đang luyện bài nên nếu bạn muốn thì code trên có thể nâng lên thành n pha :D

 

>>> Cảm ơn bác ndtnv đã chỉ điểm, mình học được khá nhiều từ bác !

;;;lisp danh so cot den
(defun c:SCD( / st str lst_pha i p vi_tri chu str1)
(vl-load-com)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
;;;========+++++++++++
;Thay doi, them bot lst_pha o day:
(setq lst_pha '("A" "B" "C"))
;;;=======++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
(defun add_space (str) (strcat str " "))
(defun add_solidus (str) (strcat str "/"))
(initget 1 (strcat (apply 'strcat (mapcar 'add_space (reverse (cdr (reverse lst_pha))))) (last lst_pha)))
(setq #pha (NGT #pha "A" getkword (strcat "Pha dau tien [" (apply 'strcat (mapcar 'add_solidus (reverse (cdr (reverse lst_pha))))) (last lst_pha) "]")))
;;;========
(setq #text_h (NGT #text_h 2.5 getint "Chieu cao chu"))
(setq i -1)
(while (setq p (getpoint "\nPick: "))
	(setq i (1+ i)
		  st (1+ st)
		  vi_tri (vl-position (strcase #pha) lst_pha)
		  chu (nth (rem (+ i vi_tri) (length lst_pha)) lst_pha)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 #text_h 0 "L" nil nil 2 nil)
)	;while
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

Mình đã giùng thử Lisp của bạn nhưng mình thấy có 1 chỗ chưa được tốt cho lắm là chữ không nằm sát với đối tượng được đánh thư tự hy vọng bạn chỉ lỗi này cho đẹp hơn


  • 0

#17 hakumi

hakumi

    Chưa sử dụng CAD

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

Đã gửi 08 May 2016 - 03:49 PM

mình cũng đang cần 1 lip đánh số nhưng đơn giản hơn bác trên, chỉ toàn số. dạng 1.3.5

 khi bắt đầu cũng gõ 2 số đầu còn số sau cùng tự nhảy dân lên n lần, và khi picsk có thể xoay được, nhờ các bạn giúp mình vs


  • 0