Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
nhocbabi

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

Bởi nhocbabi , trong AutoLisp

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

nhocbabi    3

nhocbabi
Đã đăng

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

  • Vote giảm 2

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

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

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

nhocbabi    3

nhocbabi
Đã đăng

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

  • Vote giảm 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hiepttr    538

hiepttr
Đã đăng

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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhocbabi    3

nhocbabi
Đã đăng

 

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!

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

nhocbabi    3

nhocbabi
Đã đăng

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! 

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

hiepttr    538

hiepttr
Đã đăng (Đă chỉnh sửa)

Đâ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
;=================================
Chỉnh sửa theo hiepttr
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng

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.

  • Vote tăng 2

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

HoaVien    14

HoaVien
Đã đăng

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

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

nhocbabi    3

nhocbabi
Đã đăng

 

Đâ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 ạ!

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

hiepttr    538

hiepttr
Đã đăng

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

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

nhocbabi    3

nhocbabi
Đã đăng

 

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

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

ndtnv    481

ndtnv
Đã đăng

 

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

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

vanthangv    1

vanthangv
Đã đăng

 

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

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

hakumi    0

hakumi
Đã đăng

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

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

tklighting    0

tklighting
Đã đăng
Vào lúc 4/12/2015 tại 17:17, hiepttr đã nói:

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

Em cảm ơn bác ạ, đúng cái em đang cần.

 

Em có tổng hợp 1 số bản vẽ cột đèn tại đây, bác nào có mẫu nào thêm có thể gửi cho em để em public lên đây làm tài liệu chia sẻ miễn phí cho mọi người luôn ạ :D

Link: Bản vẽ cột đèn chiếu sáng 

---

Cột đèn chiếu sáng TK Lighting

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

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

Tạo tài khoản

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

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

Đăng nhập

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

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×