[Yêu cầu] Lisp cộng - trừ - nhân - chia 2 hàng số cho ra hàng thứ 3

Tháng 12 14, 2010

Em biết trên diễn đàn có lisp cộng- trừ nhân- chia nhưng chỉ cho 2 số nhưng giờ muốn các Bác Pro giúp em viết lisp cộng- trừ nhân- chia 2 hàng với nhau cho ra hàng thứ 3 với ạ ! bản vẽ đây ạ !

http://www.cadviet.com/upfiles/3/1_7.dwg

Tháng 12 14, 2010

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

Tháng 12 15, 2010

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

Tháng 12 15, 2010

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 ạ ! cảm ơn Mr Thái ! Chúc Bác mạnh khoẻ !

Tháng 12 15, 2010

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 Bác giúp em viết lisp co yêu cầu như sau ạ:

Khi em lấy bản vẽ mẫu để chỉnh sửa thì các Hatch bản vẽ mẫu không có ASSOCIATIVE nên khi em Stretch co kéo thường phải bỏ Hatch và hach lại. Bác giúp em làm sao để Hatch cũ có chế độ ASSOCIATIVE để Stretch thì Hatch theo luôn ạ !

Tháng 12 15, 2010

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ề

Tháng 7 6, 2011

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 !

Tháng 7 6, 2011

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

Tháng 7 6, 2011

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à

Tháng 7 6, 2011

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

Tháng 7 6, 2011

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

Tháng 7 6, 2011

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.

Tháng 7 7, 2011

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

Tháng 7 7, 2011

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)

Tháng 7 7, 2011

Chuẩn luôn, thank's bác Tue_NV phát!

Tháng 7 7, 2011

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.

Tháng 7 7, 2011

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

Tháng 7 7, 2011

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

Tháng 7 7, 2011

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 !

Tháng 7 7, 2011

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?

Tháng 7 7, 2011

Ngọc Sơn đã sử dụng Lisp Tue_NV viết à?

Có thể upload file và nói rõ hơn không?

Rất xin lỗi bác. Sơn không hiểu tại sao có bản vẽ khi pick lại đúng vị trí, có lúc lại nhảy vị trí.

2 bản vẽ khác nhau: 1 bản đúng vị trí, 1 bản không đúng. Cũng hoi khó hiểu

Em dang cố gắng tìm. Cám ơn bác !

Tháng 7 7, 2011

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?

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

E chỉ góp vui vậy thôi, bác bắt e ghê quá ^^

^^ Chính xác là e nói về tốc độ ạ.Chưa kể đến phần P/S của bác.

E Thử test 1 chút với phép cộng nhé:

(defun Tue_NV (so1 so2)

(if (not cal) (arxload "geomcal"))

(C:cal (strcat so1 "+" so2))

)

(defun my (so1 so2)

(+ (atof so1) (atof so2))

)

(defun my (so1 so2)

(+ (atof so1) (atof so2))

)

(setq a "2" c "5")

;;;Kết quả :

Command: (benchmark '((TUE_NV a c)(my a c)))

Elapsed milliseconds / relative speed for 32768 iteration(s):

(MY A C)..........1544 / 6.63 <fastest>

(TUE_NV A C).....10233 / 1.00 <slowest>

;;;Trường hợp bỏ hàm kiểm tra geomcal ra ngoài :

(defun Tue_NV (so1 so2)

(C:cal (strcat so1 "+" so2))

)

;;;Kết quả :

Command: (benchmark '((TUE_NV A C)(my A C)))

Elapsed milliseconds / relative speed for 16384 iteration(s):

(MY A C).........1420 / 5.48 <fastest>

(TUE_NV A C).....7785 / 1.00 <slowest>

Tất nhiên là với số lượng phép tính nhỏ thì sự khác biệt có thể coi là nhỏ, nên em mới nói là "góp vui" ^^ Dù dùng phép toán hay cal cũng đều trả về số, và số này được lấy từ text, nên e nghĩ việc chuyển nó sang số không có gì gọi là lòng vòng cả :)

Bác kiểm tra kỹ càng việc 3 tập chọn có số lượng bằng nhau, tuy nhiên lại lờ đi việc khi chọn có thể trong tập chọn có text chẳng là số, thì coi như Cal string crash :|

Tháng 7 7, 2011

Rất xin lỗi bác. Sơn không hiểu tại sao có bản vẽ khi pick lại đúng vị trí, có lúc lại nhảy vị trí.

2 bản vẽ khác nhau: 1 bản đúng vị trí, 1 bản không đúng. Cũng hoi khó hiểu

Em dang cố gắng tìm. Cám ơn bác !

Ngọc Sơn cứ post 2 bản vẽ ấy lên đây nhé

@Ketxu : Cảm ơn bạn góp ý.

Tháng 7 7, 2011

hi.Trước tiên cứ pick 1 "+" cho Bác Tuệ cái đã.Đã tet thử lisp của bác.Lisp chạy rất đúng.Chỉ cái khi chọn pick điểm ghi ra hàng hoặc cột text có nhận xét như sau:Theo hàng thì ghi ra text bên phải so với điểm pick cái này thì được vì thường căn ghi text theo từ đầu hàng.Chỉ là khi tính cho cột thì text được ghi lên phía trên so với điểm pick, thành ra phải đưa diểm pick xuống cuối cột thì mới có cột tương đương thẳng hàng,(mà thường căn ghi text theo từ đầu cột chứ nhỉ).Chắc là do thói wen mỗi người mỗi khác thôi.Dù sao cũng cảm ơn bác,lisp rất hay đó.ghi xong ra cho bac một tick nữa đó.hi.

Tháng 7 7, 2011

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

....

Ngoài các tính năng đã viết ở trên

Tue_NV Cập nhật Lại Lisp :

Tue_NV cảm ơn góp ý của Ketxu (đã vote + cho Ketxu) :)

1. Sửa lại theo lời góp ý của Ketxu

2. -> Kiểm tra thêm Trong 1 tập chọn Text có chứa chữ là hiện lên ngay thông báo và thoát ra luôn không phải tính toán gì.

3. Cho phép User xuất ra số lẻ thập phân do mình chọn

4. Xử lý trường hợp "vượt giới hạn của số nguyên.

5./ Xuất Text theo góp ý của bạn tski259

-> Các bạn chạy thử, cứ góp ý. Tue_NV sẽ hoàn thiện nó. Hy vọng nó có ích cho mọi người

(defun c:cs(/ ss sx ss3 lis1 lis2 lis3 en1 en2 n i ii ptkq nn mm li li1 stp ctnc ctnch shang oldlu)
;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)  
(defun ktrass(ss / i ent ret)
(setq i 0 L (sslength ss))
(while (< i L)
    (if (distof (cdr(assoc 1 (entget (ssname ss i)))))
 (setq i (1+ i) ret t)
 (progn (setq i L ret nil) (alert "Tap ss co chua chu - Khong thuc hien duoc phep tinh"))
    )
 )
ret
)
(vl-load-com)
(setvar "DIMZIN" 0)
(prompt"\nChon hang-cot text thu 1")  
(if (ktrass (setq ss (ssget '((0 . "TEXT")))))
(progn
(prompt"\nChon hang-cot text thu 2")
(if (ktrass (setq sx (ssget '((0 . "TEXT")))))
(progn
(or *stp* (setq *stp* 2))
(setq stp (getint (strcat "\n So chu so thap phan <" (itoa *stp*) "> :")))
(if stp (setq *stp* stp) (setq stp *stp*))
(setq oldlu (getvar "luprec"))
(setvar "luprec" stp)
(setq lis1 (arrangess ss))
(setq lis2 (arrangess sx))
(setq ctnc (cond (ctnc) ("+")))  
(initget "+ - * /")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" ctnc ">"))) (ctnc)))
(cond ((= ctnc "+") (setq ctnch + shang 0.0))
     ((= ctnc "-") (setq ctnch - shang 0.0))
     ((= ctnc "*") (setq ctnch * shang 1.0))
     ((= ctnc "/") (setq ctnch / shang 1.0))
)

(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 (atof (cdr (assoc 1 (entget (nth i lis1))))))
   (setq mm (atof (cdr (assoc 1 (entget (nth i lis2))))))
   (setq ii (entget (nth i lis3)))

   (setq ii (subst (cons 1 (rtos (ctnch nn mm shang) 2)) (assoc 1 ii) ii))

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

   (setq nn (atof (cdr (assoc 1 (setq en1 (entget (nth i lis1)))))))
   (setq mm (atof (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 (ctnch nn mm shang) 2)) (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
);PROGN
)
))
(setvar "luprec" oldlu)
)
)
))

 (princ)
)

Chỉnh sửa Tháng 7 8, 2011 theo Tue_NV
đã sửa lại code

Đăng nhập

[Yêu cầu] Lisp cộng - trừ - nhân - chia 2 hàng số cho ra hàng thứ 3

Các bài được khuyến nghị

laivanyen 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

Thaistreetz 539

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 3000

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

laivanyen 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

laivanyen 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

Thaistreetz 539

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

NguyenNgocSon 43

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

ponaparte2003 6

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

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

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

ponaparte2003 6

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

tski259 10

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

Tue_NV 3915

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 3000

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

ponaparte2003 6

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

Tue_NV 3915

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 3000

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

Tue_NV 3915

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

NguyenNgocSon 43

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

Tue_NV 3915