Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
whatcholingon

[Yêu cầu]Lisp cộng trừ text độ, phút, giây...

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

Theo chủ thớt thì là độ.phútgiây mà

 

 

(defun c:demo (/ e e1 e2 key #func)
(defun s2d (str / ret)
 (setq ret
 (vl-list->string
(vl-remove-if
 	'(lambda (x) (or (< x 48) (> x 57)))
 	(reverse (vl-string->list str))
)
 )
 )
 (angtof
(vl-list->string
 	(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
   	)
 	)
)
 )
)
(defun format (value fm / lst mm ss)
(setq ss (vl-list->string (cdr (member 39 (vl-string->list value))))) 
(if (= (strlen ss) 2) (setq value (strcat (substr value 1 (- (strlen value) 2)) "0" ss)))
(setq mm (vl-list->string (cdr (member 100 (vl-string->list value)))))
(if (= (strlen mm) 5) (setq value (strcat (substr value 1 (- (strlen value) 5)) "0" mm)))

 (setq lst '(("Space" . 32)
  	("dOt" . 46)
  	("Comma" . 44)
  	("dAsh" . 45)
 	)
 )
 (setq fm (cdr (assoc fm lst)))
 (cond
((member fm '(32 45))
(vl-list->string
 	(subst fm
 	100
 	(subst fm 39 (vl-remove 34 (vl-string->list value)))
 	)
))
((member fm '(44 46))
(vl-list->string
 	(subst fm
 	100
 	(vl-remove 39 (vl-remove 34 (vl-string->list value)))
 	)
))
(T value)
 )
)

(if (null func) (setq func +))
(if (null fm) (setq fm "Degress"))
(setq key T)
(while (not (member key '("-" "+" nil)))
(setq #func  (chr (cadr (reverse (vl-string->list (vl-princ-to-string func))))))
(initget "Degress Space dOt Comma dAsh + -")
(setq key (getkword (strcat "\nEnter an option [Degress/Space/dOt/Comma/dAsh/+/-]<Default: "#func"/"fm">:")))
(cond
  ((member key '("-" "+")) (setq func (eval (read key))) nil)
  (T (setq fm key))
)
)

(while
 (and 

(setq se1 (ssget '((0 . "TEXT")))) 
(setq e2 (car (entsel (strcat "\nSelect Text 2 ["  #func "]<Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nInsert Column Point <exit>:"))
)
  (setq i 0)
   	(while (setq e1 (ssname se1 i))
 (setq p (list (car p) (caddr (assoc 10 (entget e1)))))
   (setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))   
  	  (setq e (subst (cons 10 p) (assoc 10 e) e))
  	  (setq e (subst (cons 1  (format (angtos (func e2 e1) 1 4) fm)) (assoc 1 e) e))
  	  (entmake e)
   (setq i (1+ i))
  )
 )
 (princ)
)

  • 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

Theo chủ thớt thì là độ.phútgiây mà

 


(defun c:demo (/ e e1 e2 key #func)
(defun s2d (str / ret)
 (setq ret
 (vl-list->string
(vl-remove-if
 	'(lambda (x) (or (< x 48) (> x 57)))
 	(reverse (vl-string->list str))
)
 )
 )
 (angtof
(vl-list->string
 	(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
   	)
 	)
)
 )
)
(defun format (value fm / lst mm ss)
(setq ss (vl-list->string (cdr (member 39 (vl-string->list value)))))
(if (= (strlen ss) 2) (setq value (strcat (substr value 1 (- (strlen value) 2)) "0" ss)))
(setq mm (vl-list->string (cdr (member 100 (vl-string->list value)))))
(if (= (strlen mm) 5) (setq value (strcat (substr value 1 (- (strlen value) 5)) "0" mm)))

 (setq lst '(("Space" . 32)
  	("dOt" . 46)
  	("Comma" . 44)
  	("dAsh" . 45)
 	)
 )
 (setq fm (cdr (assoc fm lst)))
 (cond
((member fm '(32 45))
(vl-list->string
 	(subst fm
 	100
 	(subst fm 39 (vl-remove 34 (vl-string->list value)))
 	)
))
((member fm '(44 46))
(vl-list->string
 	(subst fm
 	100
 	(vl-remove 39 (vl-remove 34 (vl-string->list value)))
 	)
))
(T value)
 )
)

(if (null func) (setq func +))
(if (null fm) (setq fm "Degress"))
(setq key T)
(while (not (member key '("-" "+" nil)))
(setq #func  (chr (cadr (reverse (vl-string->list (vl-princ-to-string func))))))
(initget "Degress Space dOt Comma dAsh + -")
(setq key (getkword (strcat "\nEnter an option [Degress/Space/dOt/Comma/dAsh/+/-]<Default: "#func"/"fm">:")))
(cond
  ((member key '("-" "+")) (setq func (eval (read key))) nil)
  (T (setq fm key))
)
)

(while
 (and

(setq se1 (ssget '((0 . "TEXT"))))
(setq e2 (car (entsel (strcat "\nSelect Text 2 ["  #func "]<Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nInsert Column Point <exit>:"))
)
  (setq i 0)
   	(while (setq e1 (ssname se1 i))
    (setq p (list (car p) (caddr (assoc 10 (entget e1)))))
   (setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))  
    	(setq e (subst (cons 10 p) (assoc 10 e) e))
    	(setq e (subst (cons 1  (format (angtos (func e2 e1) 1 4) fm)) (assoc 1 e) e))
    	(entmake e)
   (setq i (1+ i))
  )
 )
 (princ)
)

 

Bạn xem lại hộ mình với:

dps.jpg

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

THì mình hỏi bạn rồi mà, cái màu xanh = đỏ - trắng, cái của bạn là trắng-đỏ nên khác nhau là phải rồi

 

Bây giờ trong lisp bạn sửa (func e2 e1) Thành (func e1 e2) rồi xem sao nhé

 

Chúc bạn lên lương :D

  • 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

THì mình hỏi bạn rồi mà, cái màu xanh = đỏ - trắng, cái của bạn là trắng-đỏ nên khác nhau là phải rồi

 

Bây giờ trong lisp bạn sửa (func e2 e1) Thành (func e1 e2) rồi xem sao nhé

 

Chúc bạn lên lương :D

 

Tài thật. chỉ đơn giản vậy thui. thế mà mình lại chẳng bít tý gì về lisp cả. đọc mấy bài dạy viết lisp mà cứ như "nước đổ đầu vịt nước đổ lá khoai thui"

chẳng hiểu cái gì cả.

Khi nào tăng lương có dịp mình sẽ mời bạn vài chầu say xỉn thì thui hỉ

Thanks bạn nhìu,,.

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


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

 

Ý định của mình là đưa ra đoạn code tham khảo, sau đó bạn có thể chỉnh sửa theo ý mình.

Mình làm lại cái theo đề nghị của bạn:

 

- Nhập tóan tử (+/-), mặc định là lần nhập trước nếu bỏ qua.

- Nhập text 1

- Nhập text 2

- Nhập điểm chèn kết quả

- Quay lại nhập text1 ... cho đến khi bỏ qua 1 bước nào đó.

 

à quên, cái này xuất ra dạng 00d00'00", nếu yêu cầu phải đúng định dạng như đầu vào thì phải thêm 1 đoạn nữa. Bác thấy có nhất thiết phải thế không?

 

 
(defun c:demo (/ e e1 e2 key)
(defun s2d (str / ret)
  (setq ret
  (vl-list->string
	(vl-remove-if
  	'(lambda (x) (or (< x 48) (> x 57)))
  	(reverse (vl-string->list str))
	)
  )
  )
  (angtof
	(vl-list->string
  	(reverse
(vl-string->list
	(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
    	)
  	)
	)
  )
)
 
(if (not func) (setq func + #func " + "))
(setq key (getstring (strcat "\nEnter an option [+/-] <" #func">: ")))
(cond
  ((member key '("-" "_")) (setq #func " - ") (setq func -))
  ((member key '("+" "=")) (setq #func " + ")(setq func +))
)
 
(while
  (and  func
(setq e1 (car (entsel "\nChon text 1 <Exit>:?")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nChon text 2 [" (angtos e1 1 4) #func "...] <Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nDiem chen ket qua <exit>:"))
)
   	(setq e (subst (cons 10 p) (assoc 10 e) e))
   	(setq e (subst (cons 1  (angtos (func e1 e2) 1 4)) (assoc 1 e) e))
   	(entmake e)
  )
)

 

 

 

lisp này chỉ sử dụng được với 2 text thôi hả bác. e muốn cộng nhiều giá trị cùng lúc có được ko.

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  

×