Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp cộng - trừ - nhân - chia 2 hàng số cho ra hàng thứ 3


  • Please log in to reply
88 replies to this topic

#1 laivanyen

laivanyen

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 14 December 2010 - 11:25 PM

Em biết trên diễn đàn có lisp cộng- trừ nhân- chia nhưng chỉ cho 2 số nhưng giờ muốn các Bác Pro giúp em viết lisp cộng- trừ nhân- chia 2 hàng với nhau cho ra hàng thứ 3 với ạ ! bản vẽ đây ạ !
http://www.cadviet.c...files/3/1_7.dwg
  • 0

#2 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 14 December 2010 - 11:56 PM

Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.

;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
'(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
(> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(> (cadr x2) (cadr y2)) (< (car x2) (car y2))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil)
(progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
'(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
(> (cadr x3) (cadr y3)) (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
);progn
);if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru") (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
(progn
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
(setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
(command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
(command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
);progn
(entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol)
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)

  • 2

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#3 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 December 2010 - 08:50 AM

Gà mà bác viết đoạn dài thượt thế kia,k lỗi quả đã đáng nể ùi ^^..==> các bác cổ thụ đừng tự gọi mình là gà,vì chúng e hok thích làm vịt bé :undecided:(
@Bác Thái : Ars là niềm tin của e vào Giải Ngoại Hạng
  • 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


#4 laivanyen

laivanyen

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 15 December 2010 - 08:57 AM

Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.


;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
'(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
(> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(> (cadr x2) (cadr y2)) (< (car x2) (car y2))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil)
(progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
'(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
(> (cadr x3) (cadr y3)) (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
);progn
);if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru") (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
(progn
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
(setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
(command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
(command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
);progn
(entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol)
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)



Hi hi đ­ược rồi ạ ! cảm ơn Mr Thái ! Chúc Bác mạnh khoẻ !
  • 0

#5 laivanyen

laivanyen

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 15 December 2010 - 09:00 AM

Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.


;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
'(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
(> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(> (cadr x2) (cadr y2)) (< (car x2) (car y2))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil)
(progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
'(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
(> (cadr x3) (cadr y3)) (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
);progn
);if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru") (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
(progn
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
(setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
(command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
(command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
);progn
(entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol)
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)


Tiện Bác giúp em viết lisp co yêu cầu như sau ạ:

Khi em lấy bản vẽ mẫu để chỉnh sửa thì các Hatch bản vẽ mẫu không có ASSOCIATIVE nên khi em Stretch co kéo thường phải bỏ Hatch và hach lại. Bác giúp em làm sao để Hatch cũ có chế độ ASSOCIATIVE để Stretch thì Hatch theo luôn ạ !
  • 0

#6 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 15 December 2010 - 11:45 AM

Vấn đề này Ketxu đã trả lời bạn rồi. không bàn nhiều vấn đề làm lạc tiêu đề của 1 topic nhé.
@ketxu: thực ra lisp này toàn là mót của các bác trên diễn đàn này, mình chỉ mất mỗi công xắp xếp và lắp ghép nó thôi. hề hề
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#7 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 06 July 2011 - 02:17 PM

Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.


;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
'(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
(> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(> (cadr x2) (cadr y2)) (< (car x2) (car y2))))))
(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
'(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
(< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil)
(progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
'(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
(> (cadr x3) (cadr y3)) (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
);progn
);if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru") (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
(progn
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1)))))
(- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
(setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
(setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
(command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
(command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
);progn
(entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol)
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)

Lisp rất hay.Tuy nhiên mình muốn chuyển giá trị text kết quả thành màu xanh thì làm thế nào.
Trường hợp chuyển thành màu 3 khi ghi kết quả là màn hình là ok.
Trường hợp chọn nhóm text ghi nội dung chưa làm được ?
Cám ơn !
  • -1

#8 ponaparte2003

ponaparte2003

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 06 July 2011 - 02:53 PM

Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa....

Mình không dùng nhiều nhưng load thử phép + thì gặp vấn đề sau:
- Làm phép tính + rồi chọn thay vào text sẵn có thì kết quả không đúng;
- Làm phép tính + rồi chọn vị trí đặt text nó ra 1 cái số trời ơi và nghiêng 3 độ;
Bạn check lại xem sao
  • 0
Y=acosh(x/a)

#9 <<max>>

<<max>>

    biết zoom

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

Đã gửi 06 July 2011 - 03:06 PM

uhm! mình cũng bị vậy! chắ là do chưa biết xài!!. bạn nào biết sài chỉ giùm mình cái đy, lisp này hay mà
  • 0

#10 <<max>>

<<max>>

    biết zoom

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

Đã gửi 06 July 2011 - 03:11 PM

a không! mình làm được rồi :wacko: lisp chỉ cho thực hiện theo hàng thôi :D
  • 1

#11 ponaparte2003

ponaparte2003

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 06 July 2011 - 03:25 PM

a không! mình làm được rồi :wacko: lisp chỉ cho thực hiện theo hàng thôi :D

Ra thế, mình đang thử theo cột! Nhưng thử theo hàng thì nếu chọn điểm để đặt text mới thì không được.
Bác Thai sửa theo Cột đi, vì hình như cột sử dụng phổ biến hơn
  • 0
Y=acosh(x/a)

#12 tski259

tski259

    biết vẽ pline

  • Members
  • PipPip
  • 66 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 July 2011 - 01:04 AM

Ra thế, mình đang thử theo cột! Nhưng thử theo hàng thì nếu chọn điểm để đặt text mới thì không được.
Bác Thai sửa theo Cột đi, vì hình như cột sử dụng phổ biến hơn

Hi.Lisp này chỉ đúng khi tính theo hàng thôi.Tính theo cột thì nó sai bét.Hi vọng bác Thái sẽ sửa dùm cho anh em được nhờ,mình cũng nhận thấy là tính theo cột phổ biến hơn.Công nhận là lisp này hay thật.
  • 0

#13 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 July 2011 - 08:03 AM

Ra thế, mình đang thử theo cột! Nhưng thử theo hàng thì nếu chọn điểm để đặt text mới thì không được.
Bác Thai sửa theo Cột đi, vì hình như cột sử dụng phổ biến hơn

Các bạn thử Lisp này của Tue_NV
Lisp này có thể tính + - * / theo hàng và theo cột
Nếu chọn theo hàng thì Lisp tự hiểu là phải xuất theo hàng
Nếu chọn theo cột thì Lisp tự hiểu là phải xuất theo cột
Có thể xuất dưới dạng Text có sẵn hoặc pick điểm để xuất Text
Chúc các bạn 1 buổi sáng tốt lành

(defun c:cs(/ ss sx ss3 lis1 lis2 lis3 en1 en2 n i ii ptkq nn mm li li1)
;Copy right by Tue_NV
(defun dd(e1 e2 / tb1 tb2)
(setq tb1 (textbox e1) tb2 (textbox e2))
(max (abs (- (caadr tb1) (caar tb1)))
(abs (- (caadr tb2) (caar tb2)))
)
)
(defun arrangess(ss / lst)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (vl-sort lst '(lambda (x y)
(if (equal (cadr (assoc 10 (entget x)))
(cadr (assoc 10 (entget y)))
(dd (entget x) (entget y)) )
(< (caddr (assoc 10 (entget x)))
(caddr (assoc 10 (entget y)))
)
(< (cadr (assoc 10 (entget x)))
(cadr (assoc 10 (entget y)))
)
)
))
)
lst)
(vl-load-com)
(prompt"\nChon hang-cot text thu 1")
(setq ss (ssget '((0 . "TEXT"))))
(prompt"\nChon hang-cot text thu 2")
(setq sx (ssget '((0 . "TEXT"))))
(setq lis1 (arrangess ss))
(setq lis2 (arrangess sx))
(setq ctnc (cond (ctnc) ("+")))
(initget "+ - * /")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" ctnc ">"))) (ctnc)))
(if (not cal) (arxload "geomcal"))


(if (/= (sslength ss) (sslength sx)) (alert "\n Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
(setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
(if (= ptkq nil)
(PROGN
(prompt"\nChon hang-cot text ghi ket qua\n")
(setq ss3 (ssget '((0 . "TEXT"))))
(setq lis3 (arrangess ss3))

(setq n (sslength ss) i 0)

(if (= (length lis1) (length lis2) (length lis3))
(progn

(while (< i (length lis1))

(setq nn (cdr (assoc 1 (entget (nth i lis1)))))
(setq mm (cdr (assoc 1 (entget (nth i lis2)))))
(setq ii (entget (nth i lis3)))

(setq ii (subst (cons 1 (rtos (c:cal (strcat nn ctnc mm)))) (assoc 1 ii) ii))

(entmod ii)
(setq i (+ i 1))
)
)
(alert "\n Ba chuoi khong bang nhau. Lisp khong thuc hien duoc")
)
(princ)
);PROGN
(PROGN
(setq n (sslength ss) i 0)
(while (< i (length lis1))

(setq nn (cdr (assoc 1 (setq en1 (entget (nth i lis1))))))
(setq mm (cdr (assoc 1 (setq en2 (entget (nth i lis2))))))
(vla-move (vla-copy (vlax-ename->vla-object (nth i lis1)))
(Vlax-3d-point (cdr(assoc 10 en1))) (vlax-3d-point ptkq))

(setq ii (entget (entlast)))
(setq ii (subst (cons 1 (rtos (c:cal (strcat nn ctnc mm)))) (assoc 1 ii) ii))
(entmod ii)
(setq i (+ i 1))
(if (< i (length lis1))
(setq ptkq (mapcar '+ ptkq (mapcar '- (cdr (assoc 10 (entget (nth i lis1)))) (cdr(assoc 10 en1)) )) )
)
);while
)
)
))
)

  • 5

#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 July 2011 - 08:33 AM

Chưa test nhưng em đọc thấy bác Tuệ dùng strcat nối số hạng - phép tính - số hạng, sau đó dùng C:cal, như vậy có thể khá lâu (e nghĩ thế).Phép tính hoàn toàn có thể đặt làm symbol theo cond và đặt vào phép tính.
Ví dụ : (setq a *) => Nhân : (a 2 3)
  • 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


#15 ponaparte2003

ponaparte2003

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 07 July 2011 - 08:33 AM

Chuẩn luôn, thank's bác Tue_NV phát!
  • 0
Y=acosh(x/a)

#16 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 July 2011 - 08:58 AM

Chưa test nhưng em đọc thấy bác Tuệ dùng strcat nối số hạng - phép tính - số hạng, sau đó dùng C:cal, như vậy có thể khá lâu (e nghĩ thế).Phép tính hoàn toàn có thể đặt làm symbol theo cond và đặt vào phép tính.
Ví dụ : (setq a *) => Nhân : (a 2 3)

Tue_NV không chắc làm theo Ketxu nhanh hơn. vì vốn dĩ làm theo Ketxu thì mình lấy text dưới dạng 1 biến thuộc kiểu String rồi theo như Ketxu thì phải chuyển sang số thực atof mới thực hiện phép tính. Thực hiện xong rồi nó lại ra dạng số -> bạn lại phải chuyển từ số sang string rồi mới xuất Text nữa. Phải chuyển qua lại tới 2 lần.
Hơn nữa, làm như Ketxu có thể làm mất đi định dạng của số khi sử dụng hàm atof :rolleyes:

-> Còn nếu như sử dụng cal thì chỉ mất công xuất text String -> nối chuỗi và chuyển từ số sang chuỗi.
  • 0

#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 July 2011 - 09:05 AM

Em không nói nhanh hơn theo nghĩa coding nhanh hơ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


#18 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 July 2011 - 09:30 AM

Chưa test nhưng em đọc thấy bác Tuệ dùng strcat nối số hạng - phép tính - số hạng, sau đó dùng C:cal, như vậy có thể khá lâu (e nghĩ thế).Phép tính hoàn toàn có thể đặt làm symbol theo cond và đặt vào phép tính.
Ví dụ : (setq a *) => Nhân : (a 2 3)

Em không nói nhanh hơn theo nghĩa coding nhanh hơn ạ ^^

Ketxu nói chuyện lấp lửng quá nhỉ?
Rốt cục là khá lâu hay là nhanh hơn về cái gì?
Tốc độ chăng? Tue_NV thấy không đến nỗi nào?

Hơn nữa, làm như Ketxu có thể làm mất đi định dạng của số khi sử dụng hàm atof :rolleyes:

P/S: Lisp trên chưa xử lý với trường hợp "vượt giới hạn" của số nguyên
  • 0

#19 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 July 2011 - 10:37 AM

Lisp khi chọn điểm ghi kết quả bị lỗi,text kết quả không nằm đúng vị trí pick mà bị lệch ???????????
Bac TueNV có biết tại sao: khi chọn 2 nhóm (6.35;5.35) trừ nhóm (2.35;1.35) ra kết quả (4;4) mà không phải là định dạng (4.00;4.00)?
Cám ơn bác !
  • 0

#20 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 July 2011 - 11:35 AM

Lisp khi chọn điểm ghi kết quả bị lỗi,text kết quả không nằm đúng vị trí pick mà bị lệch ???????????

Ngọc Sơn đã sử dụng Lisp Tue_NV viết à?
Có thể upload file và nói rõ hơn không?
  • 0