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

#21 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 - 11:51 AM

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

#22 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 July 2011 - 01:20 PM

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 :|
  • 2

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


#23 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 - 01:29 PM

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 ý.
  • 2

#24 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 - 03:08 PM

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

#25 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 - 05:10 PM

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

Bài viết đã được chỉnh sửa nội dung bởi Tue_NV: 08 July 2011 - 07:41 AM
đã sửa lại code

  • 1

#26 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 07 July 2011 - 06:37 PM

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

  • 4

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


#27 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 July 2011 - 09:12 PM

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


#28 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 - 10:24 PM

Đã 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.
  • 1

#29 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 - 10:40 PM

Đã 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:
  • 0

#30 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 - 10:53 PM

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

Bài viết đã được chỉnh sửa nội dung bởi ketxu: 07 July 2011 - 11:00 PM

  • 0

#31 tski259

tski259

    biết vẽ pline

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

Đã gửi 08 July 2011 - 12:11 AM

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.
Hình đã gửi
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ỉ).
  • 0

#32 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

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

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

  • 0

#33 tski259

tski259

    biết vẽ pline

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

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

kq lisp cộng ma trận
Hình đã gửi
  • 0

#34 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 July 2011 - 08:17 AM

kq lisp cộng ma trận
Hình đã gửi

Tue_NV sử dụng có sao đâu nhỉ?
Đây là Lisp gốc. Bạn sử dụng thử xem :
http://www.cadviet.c...pfiles/3/cs.lsp
  • 0

#35 ponaparte2003

ponaparte2003

    biết vẽ rectang

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

Đã gửi 08 July 2011 - 08:30 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 !

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!
  • 0
Y=acosh(x/a)

#36 tski259

tski259

    biết vẽ pline

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

Đã gửi 08 July 2011 - 08:34 AM

Đã sử dụng cả lisp gốc rồi bác ah.kq nè
Hình đã gửi
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 đó.
  • 0

#37 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 July 2011 - 08:47 AM

Đã sử dụng cả lisp gốc rồi bác ah.kq nè
Hình đã gửi
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é
  • 0

#38 tski259

tski259

    biết vẽ pline

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

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

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

#39 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 08 July 2011 - 09:31 AM

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

#40 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 July 2011 - 09:51 AM

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

  • 1