Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
194 replies to this topic

#181 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 05 February 2012 - 06:41 PM

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

  • 1

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


#182 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 13 February 2012 - 11:07 AM

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

  • 1

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


#183 thuphong

thuphong

    biết vẽ circle

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

Đã gửi 26 February 2012 - 11:09 AM

.....


(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


  • 0

#184 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 26 February 2012 - 11:42 AM


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)

  • 1

#185 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 01 April 2012 - 03:50 PM

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

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


#186 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 April 2012 - 05:46 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#187 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 01 April 2012 - 06:49 PM

Uh, Mình cũng mới phát hiện ra điều này. Cứ tưởng ngon rồi cứ thế mà xơi, kú thật :(
  • 0

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


#188 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 10 June 2012 - 05:34 PM

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

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


#189 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 10 June 2012 - 06:25 PM

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

#190 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 10 June 2012 - 07:58 PM

Đóng góp link vậy, vì người ta nói rùi ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#191 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 10 June 2012 - 08:48 PM

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

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


#192 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 10 June 2012 - 09:43 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#193 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 10 June 2012 - 11:23 PM

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

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


#194 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 10 June 2012 - 11:57 PM

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


#195 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 June 2012 - 07:09 AM

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