Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
14 replies to this topic

#1 gachick87

gachick87

    biết zoom

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

Đã gửi 20 December 2012 - 10:14 AM

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

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 20 December 2012 - 10:38 AM

Lệnh này ở đâu mà cad2007 tìm hoài không thấy? Tên chính xác là gì vậy?
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 gachick87

gachick87

    biết zoom

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

Đã gửi 20 December 2012 - 10:42 AM

hị hị. lệnh từ cad 2010 bác ạ. Lệnh là selectsimilar.
  • 0

#4 Hoan1111

Hoan1111

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2587 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 20 December 2012 - 11:30 AM

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

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#5 Chiron

Chiron

    biết dimradius

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

Đã gửi 20 December 2012 - 03:13 PM

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:
Hình đã gửi
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: "))))))))

  • 1

#6 gachick87

gachick87

    biết zoom

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

Đã gửi 20 December 2012 - 03:31 PM

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

#7 Chiron

Chiron

    biết dimradius

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

Đã gửi 20 December 2012 - 03:43 PM

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

Cứ copy hết code trên paste vào autoCAD rồi enter thôi bạn.^ ^
  • 0

#8 LoveLisp

LoveLisp

    biết lệnh extend

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

Đã gửi 20 December 2012 - 04:35 PM

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&#228;n &#174;&#232;i t&#173;&#238;ng b&#187;ng l&#214;nh (ssx) c&#241;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))

  • 1

#9 gachick87

gachick87

    biết zoom

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

Đã gửi 21 December 2012 - 09:55 AM

E đã chạy thử lisp của love lisp rùi. Chạy ngon rùi bác ạ. Mỗi cái là sử dụng hơi phức tạp thôi. Hi. Em cảm ơn các bác nhiều nhiều ạ.
  • 0

#10 Chiron

Chiron

    biết dimradius

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

Đã gửi 23 December 2012 - 01:53 AM

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

  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 23 December 2012 - 07:52 AM

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

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 Chiron

Chiron

    biết dimradius

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

Đã gửi 24 December 2012 - 10:04 AM

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

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 24 December 2012 - 11:56 AM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 Chiron

Chiron

    biết dimradius

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

Đã gửi 24 December 2012 - 02:27 PM

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

#15 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 24 December 2012 - 02:53 PM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.