Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2854 replies to this topic

#1521 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 27 March 2013 - 04:29 PM

vl thì cũng là lisp mà. Thuần lisp nghĩa là Autolisp chăng? (các hàm vl là các hàm Visual lisp). Mình tò mò không hiểu điều gì ngăn cản bạn sử dụng Visual lisp?

- câu 1 của bạn hơi khó hiểu.

- câu 2 thì bạn có thể dùng code này

(defun Pline-list-point (en / dxf dxf-etg dxf-etg-m name etg lst)
 (defun dxf (code en) (cdr (assoc code (entget en))))
 (defun dxf-etg (code etg) (cdr (assoc code etg)))
 (defun dxf-etg-m (code etg / lst )
  (foreach asoc etg
   (if (= code (car asoc)) (setq lst (append lst (list (cdr asoc)))))) lst)
 (setq etg (entget en)) 
 (cond ((= (setq name (dxf-etg 0 etg)) "LWPOLYLINE")
        (setq lst (dxf-etg-m 10 etg))
        (if (= (dxf-etg 70 etg) 1) (setq lst (append lst (list (car lst)))) lst))
       ((= name "POLYLINE")
        (while (= (dxf 0 (setq en (entnext en))) "VERTEX")
         (setq lst (append lst (list (dxf 10 en))))) lst)
       ((= name "LINE") (list (dxf-etg 10 etg) (dxf-etg 11 etg)))))

Cái đầu đất của mình nó ngăn mình dùng :lol: .

Câu 1: chọn 1 block trong block này có 1 lne, 2 arc, 1 text, 1 line thì cho ra "line" "arc" "arc" "text" "line".


  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1522 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 27 March 2013 - 04:35 PM

Cái đầu đất của mình nó ngăn mình dùng :lol: .

Câu 1: chọn 1 block trong block này có 1 lne, 2 arc, 1 text, 1 line thì cho ra "line" "arc" "arc" "text" "line".

 

Dùng Lisp thuần :

1. Lisp lấy toạ độ điểm cuar PLINE

 

(defun gv(ename / L)
(if (wcmatch (cdr(assoc 0 (entget ename))) "*POLYLINE")
  (foreach x (entget ename) (if (= (car x) 10) (setq L (append L (list(cdr x))))))
)
L)
Thử : (GV (car(entsel "\n Pick Chon PLINE :")))
 
2. Lấy đối tượng trong Block

(defun Tue-list-block (blk /  e el name ob lname name lst)
    (setq name (cdr (assoc 2 (entget blk))))
    (if (not (member name lname))
        (progn
            (setq lname (append lname (list name)))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" name))))
            (while e
                (setq el (entget e))
                (if (wcmatch (cdr (assoc 0 el)) "INSERT")
(setq lst (append lst (Tue-list-block e))) 
(setq lst (append lst (list e)))
) 
                (setq e (entnext e))  
            )
        )
    )
(mapcar '(lambda (x) (cdr(assoc 0 (entget x)))) lst)
)
Thử : (Tue-list-block (car(entsel "\n Pick Chon Block :")))

  • 1

#1523 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 27 March 2013 - 05:02 PM

Code của bạn Tue_NV sẽ chỉ chạy với LWPolyline thôi. cho dù bạn viết *Polyline thì chắc chắn nó vẫn không thể chạy được với Polyline

@Duy782006

bạn làm thế này

 

(setq e (car (entsel "chon block")))
(while (not (equal (cdr (assoc 0 (entget (setq e (entnext e))))) "SEQEND"))
(setq lst (cons e lst)))

 

lst là danh sách ename các đối tượng con trong block của bạn


  • 1

#1524 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 27 March 2013 - 05:27 PM

Code bác D chắc nhầm lẫn khái niệm Insert (thường gọi tắt là Block) và Block Definition..E ở đây là ename của 1 đối tượng Insert bác ạ. Code trước bác vào định nghĩa Block mất rồi.
ps : 2 hàm bác cần có code như nhau, nên làm một hàm con thôi là đủ.
Chúc bác thành công
  • 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


#1525 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 28 March 2013 - 07:08 AM

Dạo này cad toàn tạo LWPolyline chứ không còn Polyline nửa nên mình thấy đoạn đỉnh pline cua Tuệ là ok .

Theo mình dòm ngó thì kết thúc của block là ENDBLK còn của Polyline là SEQEND mà nhỉ? Chắc mình laiọ nhầm cái gì rồi.


  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1526 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 March 2013 - 04:03 PM

Endblk là kết thúc của block definition, tức dùng khi lao vào block table
  • 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


#1527 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 28 March 2013 - 06:03 PM

Dạo này cad toàn tạo LWPolyline chứ không còn Polyline nửa nên mình thấy đoạn đỉnh pline cua Tuệ là ok .

Theo mình dòm ngó thì kết thúc của block là ENDBLK còn của Polyline là SEQEND mà nhỉ? Chắc mình laiọ nhầm cái gì rồi.

Tại vì mình nghĩ rằng vì 1 nhu cầu nào đó bạn phải dùng cad đời thấp (không có LWPolyline), chỉ sử dụng được Autolisp nên mới nói như trên. Hóa ra là bạn tự ép buộc bản thân không dùng VL ư? Thật lạ lùng! Giống như ăn chay í nhỉ.

các đối tượng Polyline và Block (insert) đều là các đối tượng phức. đều kết thúc là SEQEND. Endblk thì đúng như bạn Ketxu noi đó bạn


  • 1

#1528 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 March 2013 - 06:36 PM

Code của bạn Tue_NV sẽ chỉ chạy với LWPolyline thôi. cho dù bạn viết *Polyline thì chắc chắn nó vẫn không thể chạy được với Polyline

.....

 

Thì mình mới chỉ viết cho LWPOLYLINE thôi, muốn viết thêm cho POLYLINE nữa thì có thể duyệt từng "VERTEX" của Polyline -> Lấy ra toạ độ đỉnh (như code của bạn)

Hoặc có thể dùng cách convert POLYLINE thành LWPOLYLINE -> Lấy toạ độ đỉnh -> trả lại Polyline trước khi convert


  • 1

#1529 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 30 March 2013 - 09:28 AM

Có 1 nhu cầu đơn giản thế này nhưng TL nghĩ hoài không ra là: Làm thế nào để khi con trỏ đang ở trạng thái multiselect (chọn nhiều đối tượng bằng Cross window) ta có thể rẽ nhánh bằng cách gõ 1 phím nào đó trên bàn phím? Giống như việc gọi hộp thoại setting của lệnh MA đó các bạn. Giúp mình với!


  • 0

#1530 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 March 2013 - 10:21 AM

Có 1 nhu cầu đơn giản thế này nhưng TL nghĩ hoài không ra là: Làm thế nào để khi con trỏ đang ở trạng thái multiselect (chọn nhiều đối tượng bằng Cross window) ta có thể rẽ nhánh bằng cách gõ 1 phím nào đó trên bàn phím? Giống như việc gọi hộp thoại setting của lệnh MA đó các bạn. Giúp mình với!

 

Dùng Sendcommand đi bạn

(defun c:abc() (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "\r\r (alert \"Chuc thanh cong\") "))

 

Ví dụ :

 

Command: select
Select objects: 'abc

  • 0

#1531 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 30 March 2013 - 10:52 AM

Dạo này cad toàn tạo LWPolyline chứ không còn Polyline nửa nên mình thấy đoạn đỉnh pline cua Tuệ là ok .

Theo mình dòm ngó thì kết thúc của block là ENDBLK còn của Polyline là SEQEND mà nhỉ? Chắc mình laiọ nhầm cái gì rồi.

seqend cũng là kết thúc của các thuộc tính có trong block thuộc tính.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1532 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 30 March 2013 - 10:54 AM

@Tue_NV: Hix. Mình chưa lưu bản vẽ, thử code của bạn phát là công vẽ của mình từ gần 1 tiếng vừa rồi tèo luôn :'(
 
Mình muốn rẽ nhánh trong khi con trỏ đang chờ ở hàm ssget hoặc 1 hàm nào đó cho phép multiselect, cách này không dùng được bạn ạ. hoặc nếu có dùng được cũng không mang lại hiệu quả cao khi sử dụng vì buộc fải thêm 1 phím '


  • 0

#1533 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 March 2013 - 07:02 AM

@Tue_NV: Hix. Mình chưa lưu bản vẽ, thử code của bạn phát là công vẽ của mình từ gần 1 tiếng vừa rồi tèo luôn :'(
 
Mình muốn rẽ nhánh trong khi con trỏ đang chờ ở hàm ssget hoặc 1 hàm nào đó cho phép multiselect, cách này không dùng được bạn ạ. hoặc nếu có dùng được cũng không mang lại hiệu quả cao khi sử dụng vì buộc fải thêm 1 phím '

 

Nếu vậy thì bạn phải can thiệp vào chính lệnh gốc select của ACAD rồi. Điều đó chắc là không cách nào làm được với người sử dụng.

Với hàm grread thì có thể rẽ nhánh được. Tuy nhiên, grread chỉ có thể pick từng đối tượng một mà thôi


  • 0

#1534 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 31 March 2013 - 08:26 AM

Nếu pick từng đối tượng kèm điều kiện rẽ nhánh thì sử dụng initget cũng được rồi mà bác. Em nhớ có lần chính bác trả lời cho em vấn đề này trong topic "undo trong quá trình chạy lisp.

về hàm grread, hoàn toàn có thể viết để chọn được nhiều đối tượng. Em đã làm trong lisp chuyển nhanh các text vào trọng tâm miền kín gần nhất đã post trong forum. Cách này dùng để chữa cháy, khi tập hợp đối tượng chọn đơn giản,không cần áp dụng các điều kiện lọc fức tạp thì tạm chấp nhận được.

 

Em Linh cần cái này chắc để áp dụng vào lisp chọn nhanh đối tượng thì fải. A nghĩ là không làm được đâu, bởi trước đây anh đã thử làm rồi nhưng không thành công.


  • 0

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


#1535 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 March 2013 - 11:07 AM

Nếu pick từng đối tượng kèm điều kiện rẽ nhánh thì sử dụng initget cũng được rồi mà bác. Em nhớ có lần chính bác trả lời cho em vấn đề này trong topic "undo trong quá trình chạy lisp.

về hàm grread, hoàn toàn có thể viết để chọn được nhiều đối tượng. Em đã làm trong lisp chuyển nhanh các text vào trọng tâm miền kín gần nhất đã post trong forum. Cách này dùng để chữa cháy, khi tập hợp đối tượng chọn đơn giản,không cần áp dụng các điều kiện lọc fức tạp thì tạm chấp nhận được.

 

Em Linh cần cái này chắc để áp dụng vào lisp chọn nhanh đối tượng thì fải. A nghĩ là không làm được đâu, bởi trước đây anh đã thử làm rồi nhưng không thành công.

 

- Hàm initget có tác dụng với họ nhà GET*** chứ đâu có tác dụng với pick chọn đối tượng của nhà ENTSEL

- Nếu có thể, bạn post luôn code về hàm grread để chọn nhiều đối tượng và rẽ nhánh, có thể trong TH giống như lệnh MA nó ko thể làm đc

- Mình nghĩ Bạn Linh đang viết ứng dụng thay cho lệnh Filter và qselect -> cần rẽ nhánh để thực hiện thao tác setting đó mà


  • 0

#1536 Skywings

Skywings

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 46 (tàm tạm)

Đã gửi 31 March 2013 - 11:43 AM

Bên .NET, có thể kết hợp các hàm get_entity và get_keyword bằng cách dùng Event - tương tự Reactor bên VLisp. Mình ko chắc VLisp có thể dùng Reactor để giải quyết đc ko? Bác nào thử xem ^^!


  • 0

#1537 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 31 March 2013 - 11:54 AM

Ssget rẽ nhánh Lee viết rồi, vác về xào thôi (code hơi dài nhé).
  • 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


#1538 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 31 March 2013 - 05:15 PM

http://www.cadviet.c...o-chinh-giua-o/

lâu rồi em không làm việc với Cad nên không còn viết lisp nữa. Bác tham khảo lisp cuối cùng trong topic này.


  • 0

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


#1539 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 02 April 2013 - 11:28 AM

Grread thì mình cũng đã từng dùng, trang trước mình có trả lời hướng dẫn cho bạn ĐVH về hàm Grread cũng chính là ý này. Dùng phương pháp này thì chỉ cần chịu khó 1 chút là hoàn toàn có thể viết cho các điều kiện lọc phức tạp. nhưng mình không muốn dùng vì nó làm mất các đặc tính cơ bản của phương pháp select đối tượng thông thường, chẳng hạn như:

- Lọc đối tượng ngay từ thao tác kéo chuột để chọn;

- Kéo chuột từ trái sang phải và từ phải sang trái sẽ cho kết quả chọn khác nhau

- Không có hiệu ứng đồ họa đổi màu trong khung chọn...vv

Thiếu những đặc tính trên người dùng sẽ cảm thấy lạ lẫm khi sử dụng. Chỉ vì 1 cái option mà phải thay đổi cả phương pháp select đối tượng thì rõ ràng là không nên. mình hơi cầu toàn 1 chút ^^

 

@Ketxu có thể cho mình xin link không? Mình tìm hoài trong trang cá nhân của Lee nhưng không thấy. Cảm ơn bạn!


  • 0

#1540 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 02 April 2013 - 11:42 AM

;;------------------=={ UCS Aligned ssget }==-----------------;;
;;                                                            ;;
;;  Provides the user with a selection interface akin to      ;;
;;  those options provided by ssget, but aligned to the       ;;
;;  active UCS                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg    - prompt to be displayed                           ;;
;;  filter - optional SelectionSet filter                     ;;
;;------------------------------------------------------------;;
;;  Returns:  SelectionSet, else nil                          ;;
;;------------------------------------------------------------;;

(defun LM:UCS-ssget
     
    (
        msg filter /
     
        *error* _redrawss _getitem _getwindowselection
        acgrp e express g1 g2 gr grp i mss multiplemode pick pt removemode singlemode ss str
    )

    (defun *error* ( msg )
        (_redrawss ss 4)
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (defun _redrawss ( ss mode / i )
        (if ss
            (repeat (setq i (sslength ss))
                (redraw (ssname ss (setq i (1- i))) mode)
            )
        )
    )

    (defun _getitem ( collection item )
        (if
            (not
                (vl-catch-all-error-p
                    (setq item
                        (vl-catch-all-apply 'vla-item (list collection item))
                    )
                )
            )
            item
        )
    )

    (defun _getwindowselection ( msg p1 filter flag / gr p2 p3 p4 lst )
        (princ msg)
        (while (not (= 3 (car (setq gr (grread t 13 0)))))
            (cond
                (   (= 5 (car gr))
                    (redraw)
                    (setq p3 (cadr gr)
                          p2 (list (car p3) (cadr p1) (caddr p3))
                          p4 (list (car p1) (cadr p3) (caddr p3))
                    )
                    (grvecs
                        (setq lst
                            (list
                                (cond
                                    (   (eq "_C" flag)                 -256)
                                    (   (eq "_W" flag)                  256)
                                    (   (minusp (- (car p3) (car p1))) -256)
                                    (   256   )
                                )
                                p1 p2 p1 p4 p2 p3 p3 p4
                            )
                        )
                    )
                    t
                )
                (   (princ (strcat "\nInvalid Window Specification." msg))   )
            )
        )
        (redraw)
        (ssget (cond ( flag ) ( (if (minusp (car lst)) "_C" "_W") )) p1 p3 filter)
    )

    (setq express
        (and (vl-position "acetutil.arx" (arx))
            (not
                (vl-catch-all-error-p
                    (vl-catch-all-apply
                        (function (lambda nil (acet-sys-shift-down)))
                    )
                )
            )
        )
    )

    (setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) ))
          acgrp (vla-get-groups acdoc)
    )

    (if
        (not
            (and
                (= 1 (getvar 'PICKFIRST))
                (setq ss (cadr (ssgetfirst)))
            )
        )   
        (setq ss (ssadd))
    )

    (setq str "")
    (sssetfirst nil nil)
    (princ msg)

    (while
        (progn
            (setq gr (grread t 13 2)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
            (_redrawss ss 3)
            (cond
                (   (= 5 g1)   )
                (   (= 3 g1)
                    (cond
                        (   RemoveMode
                            (if
                                (and
                                    (setq pick (ssget g2 filter))
                                    (setq pick (ssname pick 0))
                                )
                                (if (ssmemb pick ss)
                                    (progn (ssdel pick ss) (redraw pick 4))
                                )
                                (if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
                                    (repeat (setq i (sslength pick))
                                        (if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
                                            (progn (ssdel e ss) (redraw e 4))
                                        )
                                    )
                                )
                            )
                            (princ msg)
                        )
                        (   MultipleMode
                            (if
                                (and
                                    (setq pick (ssget g2 filter))
                                    (setq pick (ssname pick 0))
                                )
                                (ssadd pick mss)
                            )
                            t
                        )
                        (   t
                            (if
                                (and
                                    (setq pick (ssget g2 filter))
                                    (setq pick (ssname pick 0))
                                )
                                (if (and express (acet-sys-shift-down))
                                    (if (ssmemb pick ss)
                                        (progn (ssdel pick ss) (redraw pick 4))
                                    )
                                    (ssadd pick ss)
                                )
                                (if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
                                    (if (and express (acet-sys-shift-down))
                                        (repeat (setq i (sslength pick))
                                            (if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
                                                (progn (ssdel e ss) (redraw e 4))
                                            )
                                        )
                                        (repeat (setq i (sslength pick))
                                            (ssadd (ssname pick (setq i (1- i))) ss)
                                        )
                                    )
                                )
                            )
                            (princ msg)
                            (not SingleMode)
                        )
                    )
                )
                (   (= 2 g1)
                    (cond
                        (   (member g2 '(32 13))
                            (cond
                                (   (zerop (strlen str))
                                    nil
                                )
                                (   t
                                    (if mss
                                        (progn
                                            (repeat (setq i (sslength mss))
                                                (ssadd (ssname mss (setq i (1- i))) ss)
                                            )
                                            (setq mss nil)
                                        )
                                    )
                                    (cond
                                        (   (wcmatch (setq str (strcase str)) "R,REMOVE")
                                            (setq
                                                MultipleMode nil
                                                SingleMode   nil
                                                RemoveMode    T
                                            )
                                        )
                                        (   (wcmatch str "M,MULTIPLE")
                                            (setq
                                                RemoveMode   nil
                                                SingleMode   nil
                                                MultipleMode  T
                                                mss (ssadd)
                                            )
                                        )
                                        (   (wcmatch str "A,ADD,AUTO")
                                            (setq
                                                MultipleMode nil
                                                RemoveMode   nil
                                                SingleMode   nil
                                            )
                                            t
                                        )
                                        (   (wcmatch str "SI,SINGLE")
                                            (setq
                                                MultipleMode nil
                                                RemoveMode   nil
                                                SingleMode    T
                                            )
                                        )
                                        (   (wcmatch str "G,GROUP")
                                            (while
                                                (progn (setq grp (getstring t "\nEnter group name: "))
                                                    (cond
                                                        (   (eq "" grp)
                                                            nil
                                                        )
                                                        (   (setq grp (_getitem acgrp grp))
                                                            (vlax-for obj grp
                                                                (if (not (ssmemb (setq e (vlax-vla-object->ename obj)) ss))
                                                                    (ssadd e ss)
                                                                )
                                                            )
                                                            nil
                                                        )
                                                        (   (princ "\nInvalid group name.")   )
                                                    )
                                                )
                                            )
                                            t
                                        )
                                        (   (or
                                                (eq str "ALL")
                                                (wcmatch str "P,PREVIOUS")
                                                (wcmatch str "L,LAST")
                                            )
                                            (princ
                                                (strcat "\n"
                                                    (if
                                                        (setq pick
                                                            (ssget
                                                                (cond
                                                                    (    (eq str "ALL")             "_X")
                                                                    (    (wcmatch str "P,PREVIOUS") "_P")
                                                                    (    (wcmatch str "L,LAST")     "_L")
                                                                )
                                                                filter
                                                            )
                                                        )
                                                        (progn
                                                            (repeat (setq i (sslength pick))
                                                                (ssadd (ssname pick (setq i (1- i))) ss)
                                                            )
                                                            (itoa (sslength pick))
                                                        )
                                                        "0"
                                                    )
                                                    " found"
                                                )
                                            )
                                            t
                                        )
                                        (   (or
                                                (eq str "BOX")
                                                (wcmatch str "W,WINDOW")
                                                (wcmatch str "C,CROSSING")
                                            )
                                            (princ
                                                (strcat "\n"
                                                    (if
                                                        (and
                                                            (setq pt (getpoint "\nSpecify first corner: "))
                                                            (setq pick
                                                                (_getwindowselection "\nSpecify opposite corner: " pt filter
                                                                    (cond
                                                                        (   (eq str "BOX")              nil)
                                                                        (   (wcmatch str "W,WINDOW")   "_W")
                                                                        (   (wcmatch str "C,CROSSING") "_C")
                                                                    )
                                                                )
                                                            )
                                                        )
                                                        (progn
                                                            (repeat (setq i (sslength pick))
                                                                (ssadd (ssname pick (setq i (1- i))) ss)
                                                            )
                                                            (itoa (sslength pick))
                                                        )
                                                        "0"
                                                    )
                                                    " found"
                                                )
                                            )
                                            t
                                        )
                                        (   (wcmatch str "U,UNDO")
                                            (if pick
                                                (cond
                                                    (   (eq 'ENAME (type pick))
                                                        (ssdel pick ss)
                                                        (redraw pick 4)
                                                    )
                                                    (   (eq 'PICKSET (type pick))
                                                        (repeat (setq i (sslength pick))
                                                            (setq e (ssname pick (setq i (1- i))))
                                                            (ssdel e ss)
                                                            (redraw e 4)
                                                        )
                                                    )
                                                )
                                            )
                                            t
                                        )
                                        (   (eq "?" str)
                                            (princ
                                                (strcat
                                                    "\nExpects a point or"
                                                    "\nWindow/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon"
                                                    "/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle"
                                                )
                                            )
                                        )
                                        (   (princ "\n** Invalid Keyword **")   )
                                    )
                                    (setq str "")
                                    (princ msg)
                                )
                            )
                        )
                        (   (< 32 g2 127)
                            (setq str (strcat str (princ (chr g2))))
                        )
                        (   (= g2 8)
                            (if (< 0 (strlen str))
                                (progn
                                    (princ (vl-list->string '(8 32 8)))
                                    (setq str (substr str 1 (1- (strlen str))))
                                )
                            )
                            t
                        )
                        ( t )
                    )
                )
            )
        )
    )
    (_redrawss ss 4)
    ss
)



 

 

 

;; Test function



 

(defun c:test nil
(sssetfirst nil (LM:UCS-ssget "\nSelect Objects: " nil))
(princ)
)
 

- Cần thêm Opt gì bạn tiếp tục ^^


  • 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