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

[whatcholingon 45]

Chào mọi người!

Đề bài:

Trong một bản vẽ có các text độ phút giây (vd: 180 00 00 độ phút giây cách nhau như thế nào cũng được 180,00,00 or 180-00-00...)

Cần Đáp án:

Lệnh or Lsp chọn một text độ phút giây đầu tiên ==> cộng (+) or trừ ( -) ==> chọn một text tiếp theo ==> ra kết quả.

Thanks!

[ketxu 2.984]

Không có nút dislike đấy nhé. Bạn PHẢI cho biết format độ phút giây của Text thì người khác mới viết được bạn ạ

[whatcholingon 45]

Không có nút dislike đấy nhé. Bạn PHẢI cho biết format độ phút giây của Text thì người khác mới viết được bạn ạ

 

Không có nút dislike đấy nhé ==> Cái này là nếu có thì là mình bị pick 1 --> n lần. hay là mình pick Like This nhỉ?

Kiểu format như sau;

VD: 180^_O00'00" - 123^o00'00" = kết quả

180^_-00-00 - 123-00-00 = kết quả

180,00,00 - 123,00,00 = kết quả

..... chỉ cần chọn text này rùi chọn - or + text khác ra kết quả đúng là ok

[lp_hai 225]

 

VD: 180^_O00'00" - 123^o00'00" = kết quả

180^_-00-00 - 123-00-00 = kết quả

180,00,00 - 123,00,00 = kết quả

..... chỉ cần chọn text này rùi chọn - or + text khác ra kết quả đúng là ok

Bạn test thử nhá!

Mình ghi ra kết quả theo: 180o12'34"

(defun c:ssdd(/ t1 t2 ls1 ls2 pt1 nd1 nd2 l1 l2 d1 d2 p1 p2 s1 s2 ts tp td th olay font lay tong cao)
 (setq t1 (entsel "\nChon text 1: ")
t2 (entsel "\nChon text 2: ")
ls1 (entget (car t1))
ls2 (entget (car t2))
pt1 (getpoint "\nChon diem dat ket qua: ")
nd1 (cdr (assoc 1 ls1))
l1 (strlen nd1)
nd2 (cdr(assoc 1 ls2))
l2 (strlen nd2)
d1 (substr nd1 1 (- l1 7))
p1 (substr nd1 (- l1 5) 2)
s1 (substr nd1 (- l1 2) 2)
d2 (substr nd2 1 (- l2 7))
p2 (substr nd2 (- l2 5) 2)
s2 (substr nd2 (- l2 2) 2)
ts (+ (atoi s1) (atoi s2))
tp (+ (atoi p1) (atoi p2))
td (+ (atoi d1) (atoi d2))
)
 (if (>= ts 60)   
(setq tp (+ tp 1)
  ts (- ts 60)
  )
)

 (if (>= tp 60)   
(setq td (+ td 1)
  tp (- tp 60)
  )
)
 (cond ((and (< ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (< ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (setq th (getvar "textsize"))
 (setq olay (getvar "clayer"))
 (setq cao (cdr(assoc 40 ls1)))
 (setq font (cdr(assoc 7 ls1)))
 (setq lay (cdr(assoc 8 ls1)))
 (setvar "clayer" lay)
 (command "text" "s" font "m" pt1 cao "0" tong "")
 (setvar "textsize" th)
 (setvar "clayer" olay)
 (princ)
 )

[ketxu 2.984]

@lp_hai : Bạn dùng Angtos và angtof, lấy string để chuyển sang số thực, tính toán xong lại chuyển ngược lại thì sẽ nhanh hơn rất nhiều

[lp_hai 225]

@lp_hai : Bạn dùng Angtos và angtof, lấy string để chuyển sang số thực, tính toán xong lại chuyển ngược lại thì sẽ nhanh hơn rất nhiều

nhưng mà dữ liệu đầu vào chủ topic cho là một text đơn thuần thôi : 18o12'34" cái này thì cũng phải tính toán strlen rồi tìm ra vị trí các số cần lấy là độ phút giây, tới đây rồi thì cũng phải tính đưa về số thập phân là 18.209.... mới dùng hàm angtof dc chứ ah?

[ketxu 2.984]

Chính vì chủ topic đại lãn nên bạn hoàn toàn có thể yêu cầu format của text ban đầu mà :)

221d42'17\" chẳng hạn

[whatcholingon 45]

Chào mọi người!

ban ngày mình phải ra công trường nên giờ mới online.

Cám ơn mọi người đã quan tâm. và thanks rất nhìu Mr lp_hai, Mr kechxu (ketxut chắc bạn này nhìu tiền lắm đây )

Mr lp_hai cho mình hỏi, mình có thể sửa lsp ssdd text độ ở dạng 180 00 00, 180-00-00...không vậy?

Thanks!

[npham 75]

Bạn thử đoạn này xem, bạn có thể dùng cho mọi định dạng.

 

 

(defun c:demo (/ e1 e2)
(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
 (and
(setq e1 (ssget "+.:S:N" '((0 . "TEXT"))))
(setq e2 (ssget "+.:S:N" '((0 . "TEXT"))))
 )
(alert  (angtos
  	(+
  	(s2d (cdr (assoc 1 (entget (ssname e1 0)))))
  	(s2d (cdr (assoc 1 (entget (ssname e2 0)))))
  	)
 	1 4)
 )
 )
 ) 

[whatcholingon 45]

Bạn thử đoạn này xem, bạn có thể dùng cho mọi định dạng.

 

(defun c:demo (/ e1 e2)
(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
 (and
(setq e1 (ssget "+.:S:N" '((0 . "TEXT"))))
(setq e2 (ssget "+.:S:N" '((0 . "TEXT"))))
 )
(alert  (angtos
  	(+
  	(s2d (cdr (assoc 1 (entget (ssname e1 0)))))
  	(s2d (cdr (assoc 1 (entget (ssname e2 0)))))
  	)
 	1 4)
 )
 )
 )

 

Mình text thử thấy báo như sau:

Hình như là kết quả ko đúng bạn à.

bạn có thể sửa: chọn text 1 ==> cộng (+) or trừ (-) ==> chọn text 2 ==> kết quả được ko?

Thanks!

[whatcholingon 45]

Bạn test thử nhá!

Mình ghi ra kết quả theo: 180o12'34"

(defun c:ssdd(/ t1 t2 ls1 ls2 pt1 nd1 nd2 l1 l2 d1 d2 p1 p2 s1 s2 ts tp td th olay font lay tong cao)
 (setq t1 (entsel "\nChon text 1: ")
t2 (entsel "\nChon text 2: ")
ls1 (entget (car t1))
ls2 (entget (car t2))
pt1 (getpoint "\nChon diem dat ket qua: ")
nd1 (cdr (assoc 1 ls1))
l1 (strlen nd1)
nd2 (cdr(assoc 1 ls2))
l2 (strlen nd2)
d1 (substr nd1 1 (- l1 7))
p1 (substr nd1 (- l1 5) 2)
s1 (substr nd1 (- l1 2) 2)
d2 (substr nd2 1 (- l2 7))
p2 (substr nd2 (- l2 5) 2)
s2 (substr nd2 (- l2 2) 2)
ts (+ (atoi s1) (atoi s2))
tp (+ (atoi p1) (atoi p2))
td (+ (atoi d1) (atoi d2))
)
 (if (>= ts 60)  
(setq tp (+ tp 1)
  ts (- ts 60)
  )
)

 (if (>= tp 60)  
(setq td (+ td 1)
  tp (- tp 60)
  )
)
 (cond ((and (< ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (< ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'0" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (< tp 10))
 (setq tong (strcat (rtos td) "o0" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (cond ((and (>= ts 10) (>= tp 10))
 (setq tong (strcat (rtos td) "o" (rtos tp) "'" (rtos ts) "\""))
 )
)
 (setq th (getvar "textsize"))
 (setq olay (getvar "clayer"))
 (setq cao (cdr(assoc 40 ls1)))
 (setq font (cdr(assoc 7 ls1)))
 (setq lay (cdr(assoc 8 ls1)))
 (setvar "clayer" lay)
 (command "text" "s" font "m" pt1 cao "0" tong "")
 (setvar "textsize" th)
 (setvar "clayer" olay)
 (princ)
 )

 

ở Lsp này chỉ có + các text độ phút giây. bạn có thể bổ sung bước: (chọn text 1 ==> cộng hoặc trừ ==>chọn text 2==> kết quả) có được không ạ?

Thanks

[npham 75]

 

Mình text thử thấy báo như sau:

Hình như là kết quả ko đúng bạn à.

bạn có thể sửa: chọn text 1 ==> cộng (+) or trừ (-) ==> chọn text 2 ==> kết quả được ko?

Thanks!

 

260d56'43" + 260d56'43" = 161d53'26" là đúng rồi chứ sai gì bạn?

[whatcholingon 45]

 

260d56'43" + 260d56'43" = 161d53'26" là đúng rồi chứ sai gì bạn?

 

Ừ nhỉ! mình quên mất là góc chỉ có 360 :D . còn cái ghi lun ra màn hình thì sao bạn. ở đây chỉ báo như vậy bấm ok rùi nó mất tiêu lun. và cũng chỉ có cộng text thui chứ ko có trừ,

bạn sửa như thế này có được ko ạ?

(chọn text 1 ==> cộng hoặc trừ ==>chọn text 2==> kết quả)

[npham 75]

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

[ketxu 2.984]

Gán Func bác npham có thể dùng (eval (read "string nhap vao")), #func lấy ký tự gần cuối của (vl-princ-to-string func) và bắt lỗi key nhập vào xem có hàm như thế không, nếu không thì dùng getkword vậy ^^

[npham 75]

Gán Func bác npham có thể dùng (eval (read "string nhap vao")), #func lấy ký tự gần cuối của (vl-princ-to-string func) và bắt lỗi key nhập vào xem có hàm như thế không, nếu không thì dùng getkword vậy ^^

 

Đã thử dùng getkword để bắt lỗi nhập, nhưng lại bất tiện cho bàn phím laptop :D,

Đành vậy thôi, để hoàn hiện cho "pro" thì còn nhièu thứ linh tinh lắm. hehe

[whatcholingon 45]

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

 

Thanks bạn rất nhìu. đúng như ý mìnhrùi.

[whatcholingon 45]

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

 

 

Bạn cho mình hỏi có thể đưa text độ phút giây ở dạng: 180,0000, 123,1232 không?

Tại vì mình làm bên khảo sát khi đưa số liệu ở máy toàn đạc ra thì nó ở dạng như vậy.

Thanks!

[phamthanhbinh 3.146]

Chào mọi người!

Đề bài:

Trong một bản vẽ có các text độ phút giây (vd: 180 00 00 độ phút giây cách nhau như thế nào cũng được 180,00,00 or 180-00-00...)

Cần Đáp án:

Lệnh or Lsp chọn một text độ phút giây đầu tiên ==> cộng (+) or trừ ( -) ==> chọn một text tiếp theo ==> ra kết quả.

Thanks!

Bạn hãy gửi bản vẽ cụ thể lên bởi vì cách ghi có ảnh hưởng rất nhiều tới kết quả của việc làm lisp.

[whatcholingon 45]

Bạn hãy gửi bản vẽ cụ thể lên bởi vì cách ghi có ảnh hưởng rất nhiều tới kết quả của việc làm lisp.

 

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.

[npham 75]

 

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

[whatcholingon 45]

 

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

[whatcholingon 45]

 

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:

 

Thanks!

[npham 75]

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

[lp_hai 225]

 

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:

 

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