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

Tháng 9 19, 2011

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)
)

Tháng 9 19, 2011

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:

Tháng 9 19, 2011

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

Tháng 9 19, 2011

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

Tháng 11 18, 2015

Ý đị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.

Đăng nhập

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

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

npham 75

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

whatcholingon 45

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

npham 75

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

whatcholingon 45

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

ngocnamtb1712 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

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

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse