Đế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

#1 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 15 September 2011 - 08:42 PM

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

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 15 September 2011 - 09:19 PM

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 ạ
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 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 15 September 2011 - 10:41 PM

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

#4 lp_hai

lp_hai

    biết lệnh measure

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

Đã gửi 16 September 2011 - 01:55 PM


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


  • 2
Hình đã gửi

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 16 September 2011 - 02:32 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 lp_hai

lp_hai

    biết lệnh measure

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

Đã gửi 16 September 2011 - 03:14 PM

@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?
  • 1
Hình đã gửi

#7 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 16 September 2011 - 04:03 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 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 16 September 2011 - 07:14 PM

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!
  • 0

#9 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 16 September 2011 - 07:19 PM

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

  • 0

#10 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 16 September 2011 - 08:32 PM

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 đã gửi
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!
  • 0

#11 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 16 September 2011 - 11:14 PM

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

#12 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 16 September 2011 - 11:35 PM


Mình text thử thấy báo như sau:
Hình đã gửi
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?
  • 0

#13 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 16 September 2011 - 11:49 PM


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

#14 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 - 10:36 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)
)
)

  • 1

#15 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 17 September 2011 - 11:09 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#16 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 - 11:48 AM

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

#17 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 - 11: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)
)
)


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

#18 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 - 12:16 PM

Ý đị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!
  • 0

#19 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 17 September 2011 - 01:56 PM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#20 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 - 02:30 PM

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