Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
ketxu

[Thảo luận] Viết lại các hàm Express

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

Doan Van Ha    2.678

LM cũng có 2 hàm tương tự, nhưng kết quả trả về có khác nhau.

1). Dùng đệ quy:

(defun Cv:list-put-nth (val lst id)
(if lst
 (if (zerop id)
  (cons a (cdr lst))
  (cons (car lst)
(Cv:list-put-nth val (cdr lst) (1- id))))))

2). Không dùng đệ quy:

(defun Cv:list-put-nth (val lst id / i )
(setq i -1)
(mapcar '(lambda (x) (if (= (setq i (1+ i)) id) val x)) lst))

Tuy nhiên so sánh giữa 3 hàm: của Acet, của bác Thaistreetz và của LM thì có sự khác nhau như sau:

Trích dẫn:

1). Theo Acet:

(acet-list-put-nth 1 '(a b c d e) -1) => (1 B C D E nil)

(acet-list-put-nth 1 '(a b c d e) 5) => (A B C D E 1)

(acet-list-put-nth 1 '(a b c d e) 6) => (A B C D E nil 1)

2). Theo Thaistreetz:

(Cv:list-put-nth 1 '(a b c d e) -1) => (1 B C D E)

(Cv:list-put-nth 1 '(a b c d e) 5) => (A B C D E 1)

(Cv:list-put-nth 1 '(a b c d e) 6) => (A B C D E)

3). Theo LM:

(Cv:list-put-nth 1 '(a b c d e) -1) => (A B C D E)

(Cv:list-put-nth 1 '(a b c d e) 5) => (A B C D E)

(Cv:list-put-nth 1 '(a b c d e) 6) => (A B C D E)

Vậy, nên dùng cái nào thì tiện nhất nhỉ?

  • Vote tăng 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    515

Ẹc! giống nhau i chang, khác mỗi cái kiểm trả điều kiện đối số. Xét về sự giống nhau của kết quả thì của mình trả về giống acet hơn. tuy nhiên mấy trường hợp đặc biệt này chắc chả mấy khi đụng fải nên dùng thế nào cũng được, tùy nhu cầu sử dụng của mỗi người thôi.

Vẫn là ACET-LIST-PUT-NTH nhưng mạnh hơn nữa đây:

(defun Cv:list-put-nth (val lst lst-id)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)
(if (and (cdr lst-id)(=(type(car lst))'LIST))(cons (Cv:list-put-nth val (car lst) (cdr lst-id)) (cdr lst))(cons val (cdr lst)))
(if lst (cons (car lst) (Cv:list-put-nth val (cdr lst) (Cv:list-put-nth (1- (car lst-id)) lst-id 0)))))
(if (<= lst-id 0)(cons val (cdr lst)) (if lst (cons (car lst) (Cv:list-put-nth val (cdr lst) (1- lst-id) ))))))

Hàm này mình nâng cấp thêm chút nữa để có thể thay thế 1 phần tử thuộc 1 list nằm trong list...n lớp. với đối số lst-id có thể là list hoặc integer miêu tả địa chỉ của phần tử cần thay thế.

VD1: (Cv:list-put-nth 1 '(a b c d e) 1) => (a 1 c d e)

VD2: (Cv:list-put-nth 1 '(a '(1 2 3 '(x y z)) c d e) '(1 3 1)) => (a '(1 2 3 '(x 1 z)) c d e)

VD3: (Cv:list-put-nth 1 '(a '(1 2 3 '(x y z)) c d e) '(1 3)) => (a '(1 2 3 1) c d e)

  • Vote tăng 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
ketxu    2.652

Theo e thì viết như ACET, có thêm flag

Phần tử đầu mang

flag T : Thêm phần tử nil cho đủ số lượng (cả trước và sau)

flag nil : K thêm phần tử

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    515

mình nghĩ điều đó là không cần thiết, bởi như thế là chúng ta copy 1 cách cứng nhắc acet khi mà ta hầu như ko có xác suất sử dụng nó. trong khi đó các hàm con sử lý danh sách thì ưu tiên hàng đầu vẫn là tốc độ. cần tránh tối đa việc kiểm tra dữ liệu và lặp danh sách nhiều lần

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    515

Tiếp theo là (ACET-LIST-REMOVE-NTH nth list) : Dùng để loại bỏ phần tử thứ nth ra khỏi list

Tương tự như trên, hàm này mình cũng post 2 hàm.

Hàm cơ bản dùng cho list chỉ có 1 lớp

(defun Cv:list-remove-nth (id lst)
(if (<= id 0) (cdr lst) (if lst (cons (car lst) (Cv:list-remove-nth (1- id) (cdr lst))))))

VD1: (Cv:list-remove-nth 1 '(1 2 3)) => (1 3)

 

Hàm mạnh hơn, dùng cho list nhiều lớp

(defun Cv:list-remove-nth (lst-id lst)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)(if (and(cdr lst-id)(= (type(car lst))'LIST)) (cons(Cv:list-remove-nth(cdr lst-id)(car lst))(cdr lst))(cdr lst))
(if lst (cons (car lst) (Cv:list-remove-nth (Cv:list-put-nth (1- (car lst-id)) lst-id 0) (cdr lst)))))
(if (<= lst-id 0) (cdr lst) (if lst (cons (car lst) (Cv:list-remove-nth (1- lst-id) (cdr lst)))))))  

VD2:(Cv:list-remove-nth '(1 2 0) '(1 '(a b (x y)) 3)) => (1 '(a b (y)) 3)

VD3:(Cv:list-remove-nth 1 '(1 '(a b (x y)) 3)) => (1 3)

  • Vote tăng 1

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    515

Và (ACET-LIST-INSERT-NTH val list nth) : Thêm phần tử val vào vị trí thứ nth của list.

Hàm cơ bản:

(defun Cv:list-insert-nth (val lst id)
(if (<= id 0) (cons val lst) (if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (1- id))))))

Hàm nâng cao:

(defun Cv:list-insert-nth (val lst lst-id)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)
(if (and (cdr lst-id) (= (type(car lst))'LIST)) (cons (Cv:list-insert-nth val (car lst) (cdr lst-id)) (cdr lst)) (cons val lst))
(if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (Cv:list-put-nth (1- (car lst-id)) lst-id 0)))))
(if (<= lst-id 0) (cons val lst) (if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (1- lst-id)))))))

  • Vote tăng 1

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    515

ACET-GEOM-VIEW-POINTS: không đối số, trả về tọa độ góc trái bên dưới và tọa độ góc phải bên trên của màn hình, của vport (nếu đang trong vport) hoặc của viewport (nếu đang trong viewport)

(defun Cv:View-points (/ Y1 X1)
(list (polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar"viewsize")))) pi (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1)))
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar"viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1)))))

  • Vote tăng 1

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
thuphong    18

.....

(defun Cv:ss-drag-move (ss p / el)
 (setq el (entlast))
 (if (and (vl-cmdf "copy" ss "" p pause) (null (equal (getvar "lastpoint") p)))
  (progn
(while (setq el (entnext el)) (entdel el)) (getvar "lastpoint") ) nil)
 )

 

Bác Tuệ cho mình hỏi : Trong trường hợp khi mình nhấn ESC, hàm trên tại sao không xóa được đối tượng phát sinh (hàm ACET-SS-DRAG-MOVE có xét đến trường hợp này Bác à). Nhờ Bác fix hộ lại đoạn code trên. Cảm ơn Bác nhiều

 

Mình test bằng đoạn code sau:

 

(defun c:t1 ()

 

(defun Cv:ss-drag-move (s p / el)

(setq el (entlast))

(if (and (vl-cmdf "copy" s "" p pause) (null (equal (getvar "lastpoint") p)))

(progn

(while (setq el (entnext el)) (entdel el)) (getvar "lastpoint") ) nil)

)

 

(setq s (ssget "_:L"))

(setq p1 (getpoint "\nSpecify base point:"))

(Cv:ss-drag-move s p1)

)

 

- Lần test 1: khi nhấn L_mouse thì OK, có giá trị trả về tọa độ điểm chọn

- Lần test 2: khi nhấn R_mouse thì OK có giá trị trả về "nil", nhưng lại phát sinh đối tượng "s" (xin lỗi Bác ,chỗ này mình nhầm)

- Lần test 3: khi nhấn ESC thì OK có giá trị trả về "nil"

 

CAD mình dùng là Acad 2012. Cảm ơn Bác đã quan tâm

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

 

Bác Tuệ cho mình hỏi : Trong trường hợp khi mình nhấn ESC, hàm trên tại sao không xóa được đối tượng phát sinh (hàm ACET-SS-DRAG-MOVE có xét đến trường hợp này Bác à). Nhờ Bác fix hộ lại đoạn code trên. Cảm ơn Bác nhiều

- Lần test 1: khi nhấn L_mouse thì OK, có giá trị trả về tọa độ điểm chọn

- Lần test 2: khi nhấn R_mouse thì OK có giá trị trả về "nil", nhưng lại phát sinh đối tượng "s" (xin lỗi Bác ,chỗ này mình nhầm)

- Lần test 3: khi nhấn ESC thì OK có giá trị trả về "nil"

Tue_NV chưa hiểu rõ câu hỏi của bạn vì mình nhấn ESC thì không có đối tượng nào tạo ra cả. Cũng đã xóa đối tượng phát sinh bằng hàm entdel trong code rồi cơ mà???

-------------------------------------------------------

Tue_NV đã gom 2 bài viết của bạn lại làm 1 bài viết và Fix lỗi của đoạn code trên (có kèm theo việc kiểm tra dữ liệu nhập của biến ss và biến p

Đây là code đã fix lỗi :

(defun Cv:ss-drag-move (ss p / el lp)
;;;copyright by Tue_NV
(setq el (entlast))
(if (and ss p (vl-cmdf "copy" ss "" p pause) (null (equal (getvar "lastpoint") p)))
  (setq lp (getvar "lastpoint")) (setq lp nil)
)
(while (setq el (entnext el)) (entdel el))
lp)

  • Vote tăng 1

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    515

Một hàm mình hay dùng để thay thế hàm alert là (Acet-ui-message "noi dung thong bao" "tieu de" flags), vì nó đẹp: Hàm này tạo 1 hộp thoại thông báo như hàm alert nhưng với nhiều lựa chọn hơn: OK, Cancel, Abort, Retry, Ignore.. Có kèm âm thanh và các icon cảnh báo đặc trưng từ thư viện shell32 của window.

 

[Tham số flags = Base types + Icons +Default buttons]

 

Base types

0 = Acet:OK

1 = Acet:OKCANCEL

2 = Acet:ABORTRETRYIGNORE

3 = Acet:YESNOCANCEL

4 = Acet:YESNO

5 = Acet:RETRYCANCEL

Icons

16 = Acet:ICONSTOP

32 = Acet:ICONQUESTION

48 = Acet:ICONWARNING

64 = Acet:ICONINFORMATION

Nút chọn mặc định

0 = Acet:DEFBUTTON1

256 = Acet:DEFBUTTON2

512 = Acet:DEFBUTTON3

768 = Acet:DEFBUTTON4

 

Giá trị trả về tùy theo lựa chọn khi nhấn nút chọn

1 = Acet:IDOK

2 = Acet:IDCANCEL

3 = Acet:IDABORT

4 = Acet:IDRETRY

5 = Acet:IDIGNORE

6 = Acet:IDYES

7 = Acet:IDNO

8 = Acet:IDCLOSE

9 = Acet:IDHELP

 

Định nghiên cứu viết lại thì thấy thằng lee-mac nó viết từ đời nào rồi. Quăng link của nó qua đây cho các bác tham khảo. http://www.lee-mac.com/popup.html

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

2 thằng này khác xa nhau về nguồn gọi bác ạ. LM gọi ws nên hỗ trợ Unicode cũng kém luôn

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    515

Tiếp tục là 1 hàm xử lý list khá tiện dụng của acet: ACET-LIST-GROUP-BY-ASSOC. hàm này sẽ nhóm các phần tử trong list có cùng "assoc" (phần tử đầu tiên giống nhau)

(defun CV:list-group-by-assoc (lst / lst-i name)
(setq name (caar lst))
(mapcar '(lambda (x) (if (= name (car x)) (setq lst-i (append lst-i (cdr x)) lst (vl-remove x lst)))) lst)
(if lst (append (list (cons name lst-i)) (cv:list-group-by-assoc lst)) (list (cons name lst-i))))

Test:

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

(CV:list-group-by-assoc lst) => (("a" 1 2 3 4 5 6) ("b" 1 2 X Y Z) ("c" 1 2 3))

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

Tiếp tục là 1 hàm xử lý list khá tiện dụng của acet: ACET-LIST-GROUP-BY-ASSOC. hàm này sẽ nhóm các phần tử trong list có cùng "assoc" (phần tử đầu tiên giống nhau)

.......

Tue_NV góp thêm hàm CV:list-group-by-assoc (Viết theo cách khác)

(defun CV:list-group-by-assoc (lst / lst-temp res)
 (while (null (zerop (length lst)))
   	(setq lst-temp (vl-remove-if '(lambda(x) (/= (caar lst) (car x))) lst)
     	lst-temp (append (list (caar lst)) (apply 'append (mapcar 'cdr lst-temp)))
     	lst (vl-remove-if '(lambda(x) (= (caar lst) (car x))) lst))
   	(setq res (append res (list lst-temp)) lst-temp '())

)
 res
)

Test:

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

(CV:list-group-by-assoc lst) => (("a" 1 2 3 4 5 6) ("b" 1 2 X Y Z) ("c" 1 2 3))

  • Vote tăng 1

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    515

Không biết thằng leemac nó test bằng cái gì nhỉ? muốn so thử với nó quá! :D

 

các bác thử phát triển hàm này lên tổng quát chút nữa đi: nhóm các phần tử của list theo 1 điều kiện người dùng đưa vào. điều kiện có thể là kết quả thỏa mãn 1 hàm lisp hoặc 1 hàm không tên nào đó. kiểu như các hàm điều kiện của vl-remove-if hay vl-sort í.

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

Các lisp benchmark ketxu đã post ở topic Đố vui với lisp :)

Ngoài ra như bác có nhận xét, dùng vl-remove chính là 1 lần lisp duyệt qua toàn bộ list, nhiều khả năng sẽ gây chậm. Hơn nữa, dòng (vl-remove x lst) sẽ xóa toàn bộ x trong list, điều này sẽ nảy sinh vấn đề trong list xuất hiện >= 2 phần tử sub-list y chang nhau. ACET cũng chưa xử lý trường hợp có các phần tử đơn trong list ^^

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    515

mình có theo dõi các lisp benchmark của ketxu. ý mình là muốn dùng chính chương trình benchmark của leemac dùng để đo trong topic kia thôi.

dòng (vl-remove x lst) sẽ xóa toàn bộ x trong list, điều này sẽ nảy sinh vấn đề trong list xuất hiện >= 2 phần tử sub-list y chang nhau

Chỗ này có nhầm lẫn không ketxu? thử lấy ví dụ với code của mình, có (vl-remove x lst): (list-group-by-assoc '((1 2) (1 2) (1 2)) -> ((1 2 2 2)) đạt yêu cầu và không bị mất bất kỳ phần tử nào.

 

Về việc trong list có phần tử đơn thì có thể giải quyết được, nhưng khi xem xét đến tốc độ thì tốt hơn là bỏ qua việc này, trong quá trình sử dụng có thể kiểm tra trước sự có mặt của phần tử đơn nếu nghi ngờ.

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

Srr bác, e copy trực tiếp code nên nó mất đoạn (cons ...) cuối cùng, dẫn đến lỗi đã thông báo.

Lisp Bench mà LM test là 1 trong 2 cái e đã post thôi

  • Vote tăng 1

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

Không biết thằng leemac nó test bằng cái gì nhỉ? muốn so thử với nó quá! :D

 

các bác thử phát triển hàm này lên tổng quát chút nữa đi: nhóm các phần tử của list theo 1 điều kiện người dùng đưa vào. điều kiện có thể là kết quả thỏa mãn 1 hàm lisp hoặc 1 hàm không tên nào đó. kiểu như các hàm điều kiện của vl-remove-if hay vl-sort í.

Tue_NV vừa viết xong:

(defun cv-asc (dk lst / lst-temp res lis)
(foreach x lst
 (if (dk x)
   (setq lis (append lis (list x)))
  )
)
(append (list (caar lis)) (apply 'append (mapcar 'cdr lis)))
)

Thử :

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

 

(cv-asc (lambda(x) (= "a" (car x))) lst)

("a" 1 2 3 4 5 6)

 

(cv-asc (lambda(x) (= "b" (car x))) lst)

("b" 1 2 X Y Z)

 

(cv-asc (lambda(x) (= "c" (car x))) lst)

("c" 1 2 3)

 

Chắc là chưa được tổng quát .Các bác góp ý thêm nhé

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×