Chuyển đến nội dung
Diễn đàn CADViet
gachick87

[Yêu cầu] Xin Lisp nâng cấp của lệnh select_similar

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

Em thấy lệnh select_similar khá hay trong acad. Em thấy dùng cũng tiện nhưng nó lại chọn tất cả đối tượng giống nhau trong bản vẽ. Các ACE bro có thể viết dùm em lisp thay thế cho lệnh selectsimilar Để chọn được các đối tượng giống nhau trong vùng đối tượng mình chọn được không ạ. Như thế em thấy ứng dụng sẽ tiện hơn nhiều ạ. Em xin chân thành cảm ơn.

Cụ thể lisp như sau:

Lệnh ss1.

Chọn đối tượng mẫu.

Xác định vùng cần chọn đối tượng.

Kết quả sẽ chọn được các đối tượng tương tự đối tượng mẫu trong vùng cần xác định.

(Ghi chú: tương tự như selectsimilar full option)

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

Em thấy lệnh select_similar khá hay trong acad. Em thấy dùng cũng tiện nhưng nó lại chọn tất cả đối tượng giống nhau trong bản vẽ. Các ACE bro có thể viết dùm em lisp thay thế cho lệnh selectsimilar Để chọn được các đối tượng giống nhau trong vùng đối tượng mình chọn được không ạ. Như thế em thấy ứng dụng sẽ tiện hơn nhiều ạ. Em xin chân thành cảm ơn.

Cụ thể lisp như sau:

Lệnh ss1.

Chọn đối tượng mẫu.

Xác định vùng cần chọn đối tượng.

Kết quả sẽ chọn được các đối tượng tương tự đối tượng mẫu trong vùng cần xác định.

(Ghi chú: tương tự như selectsimilar full option)

Bác em xem thử: http://www.cadviet.c...opic=65258&st=0

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

Tiếc quá! Nhiều khả năng nó là 1 lệnh của Tool Express. Nếu đúng vậy thì có thể xâm nhập vào file lisp (nếu nó viết bằng lisp) để sửa được. Đoán mò vậy thôi, tối về mở 2013 xem sao.

Đây bác:

102896_similar.png

www.CADforum.cz đưa ra code cho CAD (pre-2011):

(cadr(sssetfirst nil (ssget"_X"(list(cons 0(cdr(assoc 0(entget(car(entsel"\nSelect object and all similar: "))))))))))

hoặc

(ssget(list(cons 0(cdr(assoc 0(entget(car(entsel"\nSelect object and all similar: "))))))))

  • 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

Theo mình, yêu cầu này gần với lệnh SSX của AutoCAD (hình như có từ Cad2004). Tuy nhiên lệnh SSX tìm trong toàn bản vẽ và chỉ trả về tập chọn cuối cùng (mà không làm gì cả).

Mình đã cải tiến nó lại, cho phép khoanh vùng chọn trên màn hình và grip kết quả chọn được.

 

;;
;;;
;;;	SSX.LSP
;;;	Copyright © 1999 by Autodesk, Inc.
;;;
;;;	Your use of this software is governed by the terms and conditions of the
;;;	License Agreement you accepted prior to installation of this software.
;;;	Please note that pursuant to the License Agreement for this software,
;;;	"[c]opying of this computer program or its documentation except as
;;;	permitted by this License is copyright infringement under the laws of
;;;	your country.  If you copy this computer program without permission of
;;;	Autodesk, you are violating the law."
;;;
;;;	AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;	AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;	MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;	DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;	UNINTERRUPTED OR ERROR FREE.
;;;
;;;	Use, duplication, or disclosure by the U.S. Government is subject to
;;;	restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;	Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;	(Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------

;;; DESCRIPTION
;;;                          	SSX.LSP
;;;
;;;   "(SSX)" -  Easy SSGET filter routine.
;;;
;;;   Creates a selection set.  Either type "SSX" at the "Command:" prompt
;;;   to create a "previous" selection set or type "(SSX)" in response to
;;;   any "Select objects:" prompt.  You may use the functions "(A)" to add
;;;   entities and "(R)" to remove entities from a selection set during
;;;   object selection.  More than one filter criteria can be used at a
;;;   time.
;;;
;;;   SSX returns a selection set either exactly like a selected
;;;   entity or, by adjusting the filter list, similar to it.
;;;
;;;   The initial prompt is this:
;;;
;;; 	Command: ssx
;;; 	Select object/<None>: (RETURN)
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   Pressing RETURN at the initial prompt gives you a null selection
;;;   mechanism just as (ssx) did in Release 10, but you may select an
;;;   entity if you desire.  If you do so, then the list of valid types
;;;   allowed by (ssget "x") are presented on the command line.
;;;
;;; 	Select object/<None>:  (a LINE selected)
;;; 	Filter: ((0 . "LINE") (8 . "0") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   At this point any of these filters may be removed by selecting the
;;;   option keyword, then pressing RETURN.
;;;
;;; 	>>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;; 	Filter: ((0 . "LINE") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   If an item exists in the filter list and you elect to add a new item,
;;;   the old value is overwritten by the new value, as you can have only
;;;   one of each type in a single (ssget "x") call.
;;;
;;;--------------------------------------------------------------------------;
;;;
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named "ent".
;;;
;;; ssx_fe == SSX_Find_Entity
;;;

(defun ssx_fe (/ data fltr ent)
 (setq ent (car (entsel "\nSelect object <None>: ")))
 (if ent
(progn
 	(setq data (entget ent))
 	(foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
   	(if (assoc x data)
     	(setq fltr
       	(cons (assoc x data) fltr)
     	)
   	)
 	)
 	(reverse fltr)
)
 )
)
;;;
;;; Remove "element" from "alist".
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
 (append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
 )
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s)                 	; If an error (such as CTRL-C) occurs
                                 	; while this command is active...
 (if (/= s "Function cancelled")
(princ (acet-str-format "\nError: %1" s))
 )
 (if olderr (setq *error* olderr))   ; Restore old *error* handler
 (princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr fltr)
 (gc)                            	; close any sel-sets
 (setq olderr *error*
   	*error* ssx_er
 )
 (setq fltr (ssx_fe))
 (ssx_gf fltr)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f2)
 (while
(progn
 	(cond (f1 (prompt "\nCurrent filter: ") (prin1 f1)))     
 	(initget
   	"Block Color Entity Flag LAyer LType Pick Style Thickness Vector")
 	(setq t1 (getkword
   	"\nEnter filter option [block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector]: "))
)
(setq t2
 	(cond
   	((eq t1 "Block")  	2)   ((eq t1 "Color") 	62)
   	((eq t1 "Entity") 	0)   ((eq t1 "LAyer")  	8)
   	((eq t1 "LType")  	6)   ((eq t1 "Style")  	7)
   	((eq t1 "Thickness") 39)   ((eq t1 "Flag" ) 	66)
   	((eq t1 "Vector")   210)
   	(T t1)
 	)
)
(setq t3
 	(cond
   	((= t2  2)  (getstring "\n>>Enter block name to add <RETURN to remove>: "))
   	((= t2 62)  (initget 4 "?")
     	(cond
       	((or (eq (setq t3 (getint
         	"\n>>Enter color number to add [?] <RETURN to remove>: ")) "?")
         	(> t3 256))
         	(ssx_pc)            	; Print color values.
         	nil
       	)
       	(T
         	t3                  	; Return t3.
       	)
     	)
   	)
   	((= t2  0) (getstring "\n>>Enter entity type to add <RETURN to remove>: "))
   	((= t2  8) (getstring "\n>>Enter layer name to add <RETURN to remove>: "))
   	((= t2  6) (getstring "\n>>Enter linetype name to add <RETURN to remove>: "))
   	((= t2  7)
     	(getstring "\n>>Enter text style name to add <RETURN to remove>: ")
   	)
   	((= t2 39)  (getreal   "\n>>Enter thickness to add <RETURN to remove>: "))
   	((= t2 66)  (if (assoc 66 f1) nil 1))
   	((= t2 210)
     	(getpoint  "\n>>Specify extrusion Vector to add <RETURN to remove>: ")
   	)
   	(T      	nil)
 	)
)
(cond
 	((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
 	((and f1 (assoc t2 f1))     	; already in the list
   	(if (and t3 (/= t3 ""))
     	;; Replace with a new value...
     	(setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
     	;; Remove it from filter list...
     	(setq f1 (ssx_re (assoc t2 f1) f1))
   	)
 	)
 	((and t3 (/= t3 ""))
   	(setq f1 (cons (cons t2 t3) f1))
 	)
 	(T nil)
)
 )
 (princ "\nKhoanh vung chon <enter=all>: ")
 (setq chon (ssget))
 (if chon (if f1 (setq f2 (ssget "_p" f1)))
(if f1 (setq f2 (ssget "_x" f1))))
 (setq *error* olderr)
 (if (and f1 f2)
(progn
 	(princ (acet-str-format "\n%1 found. "  (itoa (sslength f2))))
 	f2
)
(progn (princ "\n0 found.") (prin1))
 )
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
 (if textpage (textpage) (textscr))
 (princ "\n                                                 	")
 (princ "\n             	Color number   |   Standard meaning ")
 (princ "\n            	________________|____________________")
 (princ "\n                            	|                	")
 (princ "\n                   	0    	|  	<BYBLOCK> 	")
 (princ "\n                   	1    	|  	Red       	")
 (princ "\n                   	2    	|  	Yellow    	")
 (princ "\n                   	3    	|  	Green     	")
 (princ "\n                   	4    	|  	Cyan      	")
 (princ "\n                   	5    	|  	Blue      	")
 (princ "\n                   	6    	|  	Magenta   	")
 (princ "\n                   	7    	|  	White     	")
 (princ "\n                	8...255 	|  	-Varies-  	")
 (princ "\n                  	256   	|  	<BYLAYER> 	")
 (princ "\n                                           	\n\n\n")
)
;;;
;;; C: function definition.
;;;
(defun c:ssx ()
(ssx)
(princ)
)
;(princ "\n\tType \"ssx\" at a Command: prompt or ")
;(princ "\n\t(ssx) at any object selection prompt. ")

(princ)


;chän ®èi t­îng b»ng lÖnh (ssx) cña Express
(defun c:ssx(/ chon)
 (if (/= (ssx)(princ))
(progn
 	(setq chon (ssget "p"))
 	(if (> (sslength chon) 0)
(progn
  (sssetfirst chon chon)
  (princ "\nChon duoc ")(princ (sslength chon))(princ " doi tuong.")
  (setq chon (gc))))))
 (princ))

  • 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

Chiron ơi, lisp không có lệnh vậy? làm sao để dùng?

Mình sửa lại chút xíu để dùng ở dòng lệnh, tuy không được hoàn hảo lắm nhưng vẫn xài được:

(defun c:qsl ()
 (cadr (sssetfirst nil (ssget (list (cons 0 (cdr (assoc 0 (entget (car (entsel "\nSelect object and all similar: "))))))))))
 (princ)
)

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

Chiron ơi, sao phải cởi trần truồng ra rồi mặc vào lại vậy? Bỏ cons và cdr được chứ nhỉ?

(cadr (sssetfirst nil (ssget (list (assoc 0 (entget (car (entsel "\nSelect object and all similar: "))))))))

  • 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

Chiron ơi, sao phải cởi trần truồng ra rồi mặc vào lại vậy? Bỏ cons và cdr được chứ nhỉ?

(cadr (sssetfirst nil (ssget (list (assoc 0 (entget (car (entsel "\nSelect object and all similar: "))))))))

Cám ơn Bác đã sửa. assoc đã trả về list cần lấy, cdr lấy phần thứ 2, cons lại thêm 0 vào. Đúng là quá thừa. Vậy còn cadr ở đầu bỏ luôn được không bác?

Nếu muốn bắt người ta phải chọn đối tượng thì phải sửa như thế nào vậy bác?

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

Nếu sau khi chọn đối tượng mà dùng lệnh để sử dụng ngay các đối tượng đó thì nên bỏ cadr.

Nếu sau khi chọn đối tượng mà chưa dùng lệnh liên quan đến các đối tượng đó thì phải dùng cadr và cả setq nữa. Tức là lấy để cất đó mà chưa dùng liền.

Tôi đang dùng cad2007 không có lệnh đó nên không hiểu bản chất các câu lệnh, nên khó hình dung.

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

Nếu sau khi chọn đối tượng mà dùng lệnh để sử dụng ngay các đối tượng đó thì nên bỏ cadr.

Nếu sau khi chọn đối tượng mà chưa dùng lệnh liên quan đến các đối tượng đó thì phải dùng cadr và cả setq nữa. Tức là lấy để cất đó mà chưa dùng liền.

Tôi đang dùng cad2007 không có lệnh đó nên không hiểu bản chất các câu lệnh, nên khó hình dung.

Lệnh của CAD là yêu cầu người chọn 1 đối tượng mẫu, autoCAD sẽ chọn tất cả đối tượng tương tự trong bản vẽ. Yêu cầu của chủ topic là chọn 1 đối tượng mẫu, sau đó chọn các đối tượng tương tự trong 1 vùng chọn xác định.

Theo Chiron thấy thì không cần cadr.

(defun c:qsl (/ sel)
 (while (not (setq sel (entsel "\nSelect Object and all similar: "))))
 (sssetfirst nil (ssget (list (assoc 0 (entget (car sel))))))
 (princ)
)

Bác có cách nào không sử dụng biến trung gian mà vẫn lặp đến khi chọn đối tượng được khô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

Bác có cách nào không sử dụng biến trung gian mà vẫn lặp đến khi chọn đối tượng được không?

Chịu! Vì 2 lần chọn nên phải hứng bằng 1 biến trung gian thôi.

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


×