Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
29 replies to this topic

#21 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 17 September 2011 - 05:54 PM


Dạ nó đây ạ:
http://www.cadviet.c.../dophutgiay.dwg

Ở đây độ tới dấu phẩy (,) ( có thể dấu chấm (.) cũng được) rồi đến phút giây.

P/s: Cái này mà làm được trên excel thì tốt quá. mình đã lên google tìm nhưng mà thấy rắc rối quá(về excel mình còn kém hơn cả cad). nên đành làm trên cad cho chắc ăn.


Bạn xem cái này vừa ý không.
Format:
Space: 123 00 00
Dot: 123.0000
Comma: 123,0000
Dash: 123-00-00
Degress:123d00'00"

Toán tử: +, -


Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -

 

(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 e1 (car (entsel "\nEnter Text 1 <Exit>:")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nEnter Text 2 [" (format (angtos e1 1 4) fm) #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 (format (angtos (func e1 e2) 1 4) fm)) (assoc 1 e) e))
(entmake e)
)
(princ)
)

  • 1

#22 whatcholingon

whatcholingon

    biết lệnh break

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

Đã gửi 17 September 2011 - 07:12 PM


Bạn xem cái này vừa ý không.
Format:
Space: 123 00 00
Dot: 123.0000
Comma: 123,0000
Dash: 123-00-00
Degress:123d00'00"

Toán tử: +, -


Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -



(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 e1 (car (entsel "\nEnter Text 1 <Exit>:")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nEnter Text 2 [" (format (angtos e1 1 4) fm) #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 (format (angtos (func e1 e2) 1 4) fm)) (assoc 1 e) e))
(entmake e)
)
(princ)
)


Qủa là tuyệt. mún thanks bạn nhìu mà chỉ pick được có mỗi cái bạn ạ.
Thanks bạn nhiu nhiu...
  • 0

#23 whatcholingon

whatcholingon

    biết lệnh break

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

Đã gửi 19 September 2011 - 06:55 AM


Bạn xem cái này vừa ý không.
Format:
Space: 123 00 00
Dot: 123.0000
Comma: 123,0000
Dash: 123-00-00
Degress:123d00'00"

Toán tử: +, -


Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -



(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 e1 (car (entsel "\nEnter Text 1 <Exit>:")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nEnter Text 2 [" (format (angtos e1 1 4) fm) #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 (format (angtos (func e1 e2) 1 4) fm)) (assoc 1 e) e))
(entmake e)
)
(princ)
)


Bạn đã giúp thi giúp cho chót nhé:
Mr npham và mọi người có thể sửa lisp này được như thế này không vậy:
Hình đã gửi

Thanks!
  • 0

#24 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 September 2011 - 08:38 AM

cũng dễ thôi, nhưng là cái trắng +/- cái đỏ hay ngược lại vậy bạn.
  • 0

#25 lp_hai

lp_hai

    biết lệnh measure

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

Đã gửi 19 September 2011 - 08:51 AM


Bạn đã giúp thi giúp cho chót nhé:
Mr npham và mọi người có thể sửa lisp này được như thế này không vậy:
Hình đã gửi

Thanks!

Các pác chú ý: hình như các số trên đây ghi theo hệ thập phân chứ ko phải là độ phút giây?
bởi vậy có thể dùng tính cộng trừ như text bình thường chăn?!
  • 0
Hình đã gửi

#26 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 September 2011 - 09:37 AM

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

  • 2

#27 whatcholingon

whatcholingon

    biết lệnh break

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

Đã gửi 19 September 2011 - 01:12 PM

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:
Hình đã gửi
  • 0

#28 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 September 2011 - 04:00 PM

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
  • 1

#29 whatcholingon

whatcholingon

    biết lệnh break

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

Đã gửi 19 September 2011 - 05:40 PM

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

#30 ngocnamtb1712

ngocnamtb1712

    Chưa sử dụng CAD

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

Đã gửi 18 November 2015 - 10:52 AM

 

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


  • 0