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

Tháng 7 7, 2011

mình đã sửa lại để chơi đuợc cả hàng lẫn cột đây. post lâu lắm rồi mới thấy có bạn ý kiến nên chắc cũng ít người có nhu cầu này nhỉ.

(defun c:srt (/ DXF MakeText HANG I LAP LSTKQ PT0 PTI SS1 SS2 SS3 SSN SSN3 TBS1 TBS2 TBS3)
(defun DXF (code en)	(cdr (assoc code (entget en))))
(defun entmod-en (code value en / RES)
(setq RES (entget en '("*")))
(entmod (subst (cons code value) (assoc code RES) RES)))
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst));endmaketext
(setq pheptinh (cond (pheptinh) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq pheptinh (cond ((getkword (strcat "\nchon phep tinh: [Cong/Tru/Nhan/CHia/] <" pheptinh ">: "))) (pheptinh)))
(prompt "\nChon Hang-Cot so thu nhat..")
(if (setq SS1 (ssget '((0 . "TEXT"))))
(progn (prompt "Chon Hang-Cot so thu hai..")
(if (setq SS2 (ssget '((0 . "TEXT"))))
(progn
(Setq TBS1 (ACET-GEOM-SS-EXTENTS-FAST SS1) SS1 (acet-ss-to-list SS1)
TBS2 (ACET-GEOM-SS-EXTENTS-FAST SS2) SS2 (acet-ss-to-list SS2))
(if (> (abs(- (car (car TBS1)) (car (cadr TBS1)))) (abs(- (cadr (car TBS1)) (cadr (cadr TBS1)))))
(setq Hang T
SS1 (vl-sort SS1 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq Hang nil
SS1 (vl-sort SS1 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (abs(- (car (car TBS2)) (car (cadr TBS2)))) (abs(- (cadr (car TBS2)) (cadr (cadr TBS2)))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (length SS1) (length SS2)) (setq lap (length SS1) i 0) (setq lap (length SS2) i 0))
(setq LstKQ '())
(if (setq PT0 (getpoint (strcat "\nchon diem dat " (if Hang "hang" "cot") " ket qua. Enter de ghi va Hang-Cot text khac")))
(progn (vl-cmdf "ucs" "w")
(repeat lap
(setq SSn (nth i SS1))
(maketext
(if (= hang nil)
(setq PTi (list (car PT0) (cadr (DXF 10 SSn))))
(setq PTi (list (car (DXF 10 SSn)) (cadr PT0))))
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2)))
(DXF 40 SSn) 0 "R"(DXF 7 SSn) (DXF 8 SSn) nil nil)
(setq  i (1+ i)))
(vl-cmdf "ucs" "p"))
(progn
(prompt "\nChon Hang hoac Cot text de ghi ket qua")
(if (setq SS3 (ssget '((0 . "TEXT"))))
(setq TBS3 (ACET-GEOM-SS-EXTENTS-FAST SS3)
SS3 (acet-ss-to-list SS3))
(EXIT))
(if (> (abs(- (car (car TBS3)) (car (cadr TBS3)))) (abs(- (cadr (car TBS3)) (cadr (cadr TBS3)))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(vl-cmdf "undo" "begin")
(repeat lap
(setq SSn (nth i SS1))
(if (setq SSn3 (nth i SS3))
(entmod-en 1
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))) SSn3)
(progn
(alert (strcat "tap hop text khong du de ghi ket qua. Thieu "(rtos (- lap i) 2 0)" text"))
(vl-cmdf "undo" "end")
(EXIT)))
(setq  i (1+ i)))
(vl-cmdf "undo" "end")));if
);progn
)));if
(princ)
);end

Tháng 7 7, 2011

2 lisp công phu, chúc bác Tuệ và bác Thái tiếp tục khỏe mạnh để anh em CADVIET được nhờ dài dài, bọn em còn được mót lâu lâu ^^

Tháng 7 7, 2011

Đã tet thử lisp của 2 bác.Của bác Tuệ gặp vấn đề khi enter để chọn hàng-cột text ghi kq không đúng nữa.Của bác "Đường Thái" lisp chạy rất suôn,nhưng chưa chọn số chữ số sau dấu thập phân,dù đã chọn trong unit.Nếu bác Thái sửa lại chọn số sau sau phần thập đặt theo unit thì hay.Hi.dù sao cũng cảm ơn 2 bác nhiều.

Tháng 7 7, 2011

Đã tet thử lisp của 2 bác.Của bác Tuệ gặp vấn đề khi enter để chọn hàng-cột text ghi kq không đúng nữa.Của bác "Đường Thái" lisp chạy rất suôn,nhưng chưa chọn số chữ số sau dấu thập phân,dù đã chọn trong unit.Nếu bác Thái sửa lại chọn số sau sau phần thập đặt theo unit thì hay.Hi.dù sao cũng cảm ơn 2 bác nhiều.

Tue_NV đã sửa lại code ở bài viết số 25. Bạn vui lòng thử lại :rolleyes:

Tháng 7 7, 2011

Tue_NV đã sửa lại code ở bài viết số 25. Bạn vui lòng thử lại :rolleyes:

Hic.cái ni thực sự là gà đây.Mần răng mà đến được bài viết 25 đây.Tìm mãi không được,tìm trong search cũng không được,bó tay luôn.

P/S : ^^ Bạn nhìn phía bên trên tay phải mỗi bài Reply, có đánh số bài trong 1 topic, đó chính là số bác TUệ muốn nói đến. Ví dụ như bài của bạn mang số #30

Chỉnh sửa Tháng 7 7, 2011 theo ketxu

Tháng 7 7, 2011

Hi. Tiện thể mình nêu ý tưởng mới luôn đây. Tính cho n hàng và m cột. Giả sử có ma trận text.

Yêu cầu:1.Thực hiện lệnh

2. Lựa chọn phép tính “+ , - , * , / “.

3. Lựa chọn tính theo hàng hoặc cột: - Theo hàng thì tính cho hàng với hàng và kq ghi ra hàng. – Theo cột thì tính cho cột với cột và kq ghi ra cột.” VD trong ảnh là cho phép tính +”.

4. Lựa chọn vùng tính:VD quét từ góc I tới góc II.(bỏ chọn từng hàng với hàng hay cột với cột).

5.Chọn vị trí ghi kq.

Không biết các bác có thể thực hiện được không.(Mà có lẽ chỉ nên thực hiện với lệnh “+” và “*”, chứ với lệnh “-“ và “/” chắc là không ai dùng nhỉ).

Tháng 7 8, 2011

Cộng Trừ Nhân Chia ma trận theo ý của tski259

Vì viết vội nên chưa xuất Text.

Đây là code

(defun c:cs(/ ss box minp maxp stp oldlu ctnc ctnch shang lis ResC ResR matran i j k ptui dem)
;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 ma tran")  
(if (ktrass (setq ss (ssget '((0 . "TEXT")))))
(progn
(setq box (ACET-GEOM-SS-EXTENTS-FAST ss))
(setq minp (car box) maxp (cadr box))

(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 lis (arrangess ss))

(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 0.0))
     ((= ctnc "/") (setq ctnch / shang 0.0))
)


(setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() MatranRes '())
(while (< j (length lis))
  (if (not (equal (cdr(assoc 10 (entget (nth j lis)))) minp (/ (cdr(assoc 40 (entget (nth j lis)))) 1.5) ))
(setq i (1+ i) j (1+ j))
(setq j (length lis))
  )
)
(setq j (/ j i))
(Repeat j
   (Repeat i
(setq ptui (ctnch ptui shang (atof (cdr (assoc 1 (entget (nth k lis)))))) 
	matran (append matran (list (atof (cdr (assoc 1 (entget (nth k lis)))))))
	k (1+ k))
  )
  (setq ResC (append ResC (list ptui)) ptui 0.0)
)
(setq k 0 dem 0)
(Repeat i
  (Repeat j
(setq ptui (ctnch ptui shang (nth k matran)))
(setq k (+ k i))
  )
(setq ResR (append ResR (list ptui)) ptui 0.0)
(setq dem (1+ dem))
(setq k dem)
)
))
(Alert (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
(princ (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
)

Tháng 7 8, 2011

kq lisp cộng ma trận

Tháng 7 8, 2011

kq lisp cộng ma trận

Tue_NV sử dụng có sao đâu nhỉ?

Đây là Lisp gốc. Bạn sử dụng thử xem :

http://www.cadviet.com/upfiles/3/cs.lsp

Tháng 7 8, 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 !

Cái này là do lúc pick bạn bi bắt điểm lệch nên nó thế thôi, còn muốn ghi định dạng 4.00 thì bạn chỉh dimstyle bỏ traling đi là được!

Tháng 7 8, 2011

Đã sử dụng cả lisp gốc rồi bác ah.kq nè

Mà có lẽ Bác hoàn thiện cho xuất ra text luôn đi bác ah.chứ để bảng vậy lấy số liệu thì chắc là dùng lisp ban đầu cộng 2 hàng cho ra hàng thứ 3 có lẽ sẽ nhanh hơn đó.

Tháng 7 8, 2011

Đã sử dụng cả lisp gốc rồi bác ah.kq nè

Mà có lẽ Bác hoàn thiện cho xuất ra text luôn đi bác ah.chứ để bảng vậy lấy số liệu thì chắc là dùng lisp ban đầu cộng 2 hàng cho ra hàng thứ 3 có lẽ sẽ nhanh hơn đó.

Nếu hoàn thiện thì cái này sẽ nhanh hơn Lisp đầu ở bước chọn và có thể thực hiện phép tính với nhiều cột số

Bạn có thể gửi cái file .dwg của bạn test để Tue_NV test thử. Tue_NV sử dụng không có vấn đề gì.

@All: Mọi người tham gia test thử, góp ý giúp nhé

Tháng 7 8, 2011

Nếu hoàn thiện thì cái này sẽ nhanh hơn Lisp đầu ở bước chọn và có thể thực hiện phép tính với nhiều cột số

Bạn có thể gửi cái file .dwg của bạn test để Tue_NV test thử. Tue_NV sử dụng không có vấn đề gì.

@All: Mọi người tham gia test thử, góp ý giúp nhé

Hi.Mình sử dụng lisp ban đầu vẫn bình thường mà.chỉ có cộng ma trận không được thôi.Mình không nghĩ là do bản vẽ cad,mọi người xung phong tet thử đi.

cái này mà hoàn thiện thì chắc chắn thay được cho lisp ban đầu và còn nhanh hơn nữa đó.(Hi.nhanh hơn ở bước chọn,còn tốc độ thì tổng quát hơn thì chắc là chậm hơn rồi).

Tháng 7 8, 2011

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

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

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

Đoạn mã trên có phải nhớ phép tính sau mỗi lần tính ?

Nếu như vậy sao mình thực hiện lisp không nhớ phép tính nhỉ?

Cám ơn Tue_NV!

Tháng 7 8, 2011

Đoạn mã trên có phải nhớ phép tính sau mỗi lần tính ?

Nếu như vậy sao mình thực hiện lisp không nhớ phép tính nhỉ?

Cám ơn Tue_NV!

Ngọc Sơn có thể sửa lại :

Thay các dòng :

(setq ctnc (cond (ctnc) ("+")))

(initget "+ - * /")

(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" ctnc ">"))) (ctnc)))

....

thành :

(setq *ctnc* (cond (*ctnc*) ("+")))

(initget "+ - * /")

(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" *ctnc* ">"))) ))

(if ctnc (setq *ctnc* ctnc) (setq ctnc *ctnc*))

Tháng 7 8, 2011

Cộng Trừ Nhân Chia ma trận theo ý của tski259

Vì viết vội nên chưa xuất Text.

..........

Thử với phép cộng thì OK.

Nhưng với phép nhân thi k/quả toàn là zero.

Nguyên nhân do "Phép nhân với số zero" tại dòng :

- ((= ctnc "*") (setq ctnch * shang 0.0))

- (setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() MatranRes '())

và

- (setq ResR (append ResR (list ptui)) ptui 0.0)

Tháng 7 8, 2011

Thử với phép cộng thì OK.

Nhưng với phép nhân thi k/quả toàn là zero.

Nguyên nhân do "Phép nhân với số zero" tại dòng :

- ((= ctnc "*") (setq ctnch * shang 0.0))

- (setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() MatranRes '())

và

- (setq ResR (append ResR (list ptui)) ptui 0.0)

Cảm ơn anh gia_bach. Cái này em cũng đã phát hiện ra. Tại em coding nhanh quá :lol:

Tuy nhiên theo cái ảnh mà bạn Tski259 chụp thì em không hiểu tại sao xuất ra kết quả như vậy

Không thể có kết quả như vậy được. Em không hiểu tại sao? Nếu phép nhân thì kết quả cột không thể là NIL được mà kết quả hàng theo hình Tski259 post lại dài dằng dặc như vậy được???

.....

....

Tháng 7 8, 2011

Chỉ cần bạn ấy post file test là có câu trả lời bác ạ :)

Tháng 7 8, 2011

Chỉ cần bạn ấy post file test là có câu trả lời bác ạ :)

Đây mọi người thử coi nhé

http://www.cadviet.com/upfiles/3/guicadviet.zip

Tháng 7 8, 2011

Ngọc Sơn có thể sửa lại :

Thay các dòng :

(setq ctnc (cond (ctnc) ("+")))

(initget "+ - * /")

(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" ctnc ">"))) (ctnc)))

....

thành :

(setq *ctnc* (cond (*ctnc*) ("+")))

(initget "+ - * /")

(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ - * /] <" *ctnc* ">"))) ))

(if ctnc (setq *ctnc* ctnc) (setq ctnc *ctnc*))

Sơn đã check nhưng chưa được. Chỉ nhớ mặc định phép cộng ?????????

Chắc là nhầm gì đó? Lisp nhớ được phép tính nhưng khi tính thì kết quả nhớ là phép +

Tháng 7 8, 2011

Bác Tue_NV xem lại ở cái hàm này xem?

(setq box (ACET-GEOM-SS-EXTENTS-FAST ss))

Cái box mà OK là box chứa điểm 2D (file của đa số), cái box mà NO thì chứa điểm 3D (file của bạn ấy gửi).

Tháng 7 8, 2011

mình đã sửa lại để chơi đuợc cả hàng lẫn cột đây. post lâu lắm rồi mới thấy có bạn ý kiến nên chắc cũng ít người có nhu cầu này nhỉ.

(defun c:srt (/ DXF MakeText HANG I LAP LSTKQ PT0 PTI SS1 SS2 SS3 SSN SSN3 TBS1 TBS2 TBS3)
(defun DXF (code en)	(cdr (assoc code (entget en))))
(defun entmod-en (code value en / RES)
(setq RES (entget en '("*")))
(entmod (subst (cons code value) (assoc code RES) RES)))
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst));endmaketext
(setq pheptinh (cond (pheptinh) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq pheptinh (cond ((getkword (strcat "\nchon phep tinh: [Cong/Tru/Nhan/CHia/] <" pheptinh ">: "))) (pheptinh)))
(prompt "\nChon Hang-Cot so thu nhat..")
(if (setq SS1 (ssget '((0 . "TEXT"))))
(progn (prompt "Chon Hang-Cot so thu hai..")
(if (setq SS2 (ssget '((0 . "TEXT"))))
(progn
(Setq TBS1 (ACET-GEOM-SS-EXTENTS-FAST SS1) SS1 (acet-ss-to-list SS1)
TBS2 (ACET-GEOM-SS-EXTENTS-FAST SS2) SS2 (acet-ss-to-list SS2))
(if (> (abs(- (car (car TBS1)) (car (cadr TBS1)))) (abs(- (cadr (car TBS1)) (cadr (cadr TBS1)))))
(setq Hang T
SS1 (vl-sort SS1 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq Hang nil
SS1 (vl-sort SS1 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (abs(- (car (car TBS2)) (car (cadr TBS2)))) (abs(- (cadr (car TBS2)) (cadr (cadr TBS2)))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (length SS1) (length SS2)) (setq lap (length SS1) i 0) (setq lap (length SS2) i 0))
(setq LstKQ '())
(if (setq PT0 (getpoint (strcat "\nchon diem dat " (if Hang "hang" "cot") " ket qua. Enter de ghi va Hang-Cot text khac")))
(progn (vl-cmdf "ucs" "w")
(repeat lap
(setq SSn (nth i SS1))
(maketext
(if (= hang nil)
(setq PTi (list (car PT0) (cadr (DXF 10 SSn))))
(setq PTi (list (car (DXF 10 SSn)) (cadr PT0))))
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2)))
(DXF 40 SSn) 0 "R"(DXF 7 SSn) (DXF 8 SSn) nil nil)
(setq  i (1+ i)))
(vl-cmdf "ucs" "p"))
(progn
(prompt "\nChon Hang hoac Cot text de ghi ket qua")
(if (setq SS3 (ssget '((0 . "TEXT"))))
(setq TBS3 (ACET-GEOM-SS-EXTENTS-FAST SS3)
SS3 (acet-ss-to-list SS3))
(EXIT))
(if (> (abs(- (car (car TBS3)) (car (cadr TBS3)))) (abs(- (cadr (car TBS3)) (cadr (cadr TBS3)))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(vl-cmdf "undo" "begin")
(repeat lap
(setq SSn (nth i SS1))
(if (setq SSn3 (nth i SS3))
(entmod-en 1
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))) SSn3)
(progn
(alert (strcat "tap hop text khong du de ghi ket qua. Thieu "(rtos (- lap i) 2 0)" text"))
(vl-cmdf "undo" "end")
(EXIT)))
(setq  i (1+ i)))
(vl-cmdf "undo" "end")));if
);progn
)));if
(princ)
);end

Sơn thử đổi màu kết quả tính thành màu 3 bằng đoạn mã :

(if (assoc 62 ii)
(setq ii (subst (cons 62 3) (assoc 62 ii) ii))
(setq ii (append ii (list (cons 62 3))))
)

Nhưng thử đặt vào lisp thấy không được???

Nên đặt ở chỗ nào ?

Cám ơn các bác !

Tháng 7 8, 2011

Sơn thử đổi màu kết quả tính thành màu 3 bằng đoạn mã :
(if (assoc 62 ii)
(setq ii (subst (cons 62 3) (assoc 62 ii) ii))
(setq ii (append ii (list (cons 62 3))))
)
Nhưng thử đặt vào lisp thấy không được???

Nên đặt ở chỗ nào ?

Cám ơn các bác !

Ngọc Sơn phải (Entmod ii) nữa

File Lisp viết theo ý NgocSon đây :

http://www.cadviet.com/upfiles/3/cs_4.lsp

@tski259: Tue_NV đã thử Lisp Cộng ma trận trên file dwg bạn gửi. Vẫn ổn cả. Không có vấn đề gì?

Tháng 7 8, 2011

Ngọc Sơn phải (Entmod ii) nữa

File Lisp viết theo ý NgocSon đây :

http://www.cadviet.com/upfiles/3/cs_4.lsp

@tski259: Tue_NV đã thử Lisp Cộng ma trận trên file dwg bạn gửi. Vẫn ổn cả. Không có vấn đề gì?

Mình cũng đã thử lại nhiều lần rồi mà không được.Chắc tại xung đột với cái gì đó chăng.Thấy ít người test quá nhỉ,nên mình cũng không biết sao nữa.Nhưng chắc chắn là máy mình không chạy được ah.Với lisp đầu tiên thì vô tư,lisp cộng ma trận là tỏi.Mình dùng cad2007.

Tháng 7 8, 2011

Mình cũng đã thử lại nhiều lần rồi mà không được.Chắc tại xung đột với cái gì đó chăng.Thấy ít người test quá nhỉ,nên mình cũng không biết sao nữa.Nhưng chắc chắn là máy mình không chạy được ah.Với lisp đầu tiên thì vô tư,lisp cộng ma trận là tỏi.Mình dùng cad2007.

Chú ý, chú ý : Lisp chạy được khi cài phụ trợ Express.

Bạn tski259 chưa cài Express nên chưa sử dụng được Lisp :rolleyes:

Do vậy, Tue_NV viết lại, không sử dụng hàm ACET-GEOM-SS-EXTENTS-FAST. Các bạn chạy thử xem.

Với phép * /, xuất text sẽ viết sau nhé

(defun c:cs(/ ss lis stp oldlu ctnc ctnch shang ResC ResR matran i j k ptui dem)
;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 layminmax( / minpp maxpp LX LY)
  (vlax-for x (vla-get-activeselectionset (vla-get-activedocument(vlax-get-acad-object)))
(vla-getboundingbox x 'minpp 'maxpp)
(setq LX (append LX (list (car(safearray-value minpp)))
		    (list (car(safearray-value maxpp)))))
(setq LY (append LY (list (cadr(safearray-value minpp)))
		    (list (cadr(safearray-value maxpp)))))
  )
  (setq minp (list (apply 'min LX) (apply 'min LY) 0.0))
  (setq maxp (list (apply 'max LX) (apply 'max LY) 0.0))	
)
(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 ma tran")  
(if (ktrass (setq ss (ssget '((0 . "TEXT")))))
(progn
(layminmax)

(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 lis (arrangess ss))

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

;(setq lis (reverse lis) )  
(setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() )
(while (< j (length lis))
  (if (not (equal (cdr(assoc 10 (entget (nth j lis)))) minp  (cdr(assoc 40 (entget (nth j lis))))  ))
(setq i (1+ i) j (1+ j))
(setq j (length lis))
  )
)
(setq j (/ j i))

(Repeat j
   (Repeat i
(setq ptui (ctnch ptui shang (atof (cdr (assoc 1 (entget (nth k lis)))))) 
	matran (append matran (list (atof (cdr (assoc 1 (entget (nth k lis)))))))
	k (1+ k))
  )
  (setq ResC (append ResC (list ptui)) ptui 0.0)
)
(setq k 0 dem 0)
(Repeat i
  (Repeat j
(setq ptui (ctnch ptui shang (nth k matran)))
(setq k (+ k i))
  )
(setq ResR (append ResR (list ptui)) ptui 0.0)
(setq dem (1+ dem))
(setq k dem)
)
))
(Alert (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
(princ (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
)

Đă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ị

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 2.984

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 3.912

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

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 3.912

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 3.912

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 3.912

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

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 3.912

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

gia_bach 1.552

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 3.912

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

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

NguyenNgocSon 43