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ị

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!

  • 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
ketxu    2.653

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 ạ

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

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: 180O00'00" - 123o00'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

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
lp_hai    207

 

VD: 180O00'00" - 123o00'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)
 )

  • 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
ketxu    2.653

@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

  • 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
lp_hai    207
@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?

  • 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
ketxu    2.653

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

  • 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

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!

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

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

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

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:

untitled_65.jpg

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!

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

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

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

 

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

untitled_65.jpg

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?

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

 

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

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

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

  • 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
ketxu    2.653

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

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

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

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

 

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

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

 

 

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!

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

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.

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

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.

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

 

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

  • 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

 

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

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

 

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:

dops.jpg

 

Thanks!

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
lp_hai    207

 

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:

dops.jpg

 

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

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  

×