Could not leave well enough alone, have made some changes.
Changed getpickedfirst routine to allow nil as the filter list so All types are excepted.
Changed main routine name to getuserpick and added some features.
You can use serval pick styles
;; pstyle is the pick type
;; 0 = single pick using getpoint, get all objects at point using pickbox size
;; 1 = single pick, using pickbox, get all objects in pick box
;; 2 = single pick, only like entsel
;; 3 = single pick if object, else crossing window
;; 4 = crossing window only
;; typs is a list of exceptable object types
;; prmpt is the prompt string to use for user select
;; prvss is flag for previously selcted sel sets ( T = allow )
Should the routine return the point picked and nil for the point if previous set?
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; FUNCTION
;;; To filter a preselected selection set for object types
;;; listed in the variable list lst
;;;
;;; ARGUMENTS
;;; lst -> a list of object types like ("TEXT" "MTEXT")
;;; nil will allow all types
;;;
;;; USAGE
;;; (setq ss (getpickfirst typs))
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler
;;; Co-author S. Madsen
;;; ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.1 Sep. 18, 2004
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
(defun getpickfirst (lst / ss a ent)
;; lst is a list of object types like ("TEXT" "MTEXT")
(cond ((and (setq ss (cadr (ssgetfirst))) ; get previously selected sel set
lst ; nil will allow all types
)
(setq a 0) ; set pointer
(repeat (sslength ss) ; foreach object in sel set
(setq ent (ssname ss a) ; get obj name
a (1+ a)
) ; increment counter
;; is obj not a member of the list ?
(and (not (member (cdr (assoc 0 (entget ent))) lst))
(ssdel ent ss) ; if not a member remove it from ss
(setq a (1- a)) ; and deincrement pointer
) ; and
) ; repeat
) ; end cons 1
) ; end cond stmt
;; if ss is a pick set and has objects then return the selection set
(if (and (= (type ss) 'pickset) (/= 0 (sslength ss)))
ss
)
;; else return nil because when IF fails it returns nil
) ; end defun
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; FUNCTION
;;; To offer various pick styles and to filter a preselected
;;; selection set for object types listed in the variable list lst
;;;
;;;
;;; ARGUMENTS
;;; pstyle is the pick type see below
;;; typs is a list of exceptable object types, nil = all types
;;; prmpt is the prompt string to use for user select
;;; nil = "Select object(s): "
;;; prvss is flag for previously selcted sel sets (T = allow)
;;;
;;; USAGE
;;; (setq ss (getuserpick
;;; 3 ; pick style
;;; (list "TEXT" "MTEXT") ; filter objects
;;; "\nSelect object(s): " ; prompt
;;; t)) ; allow pre selection
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler
;;; Co-author S. Madsen
;;; ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.1 Sep. 18, 2004
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
(defun getuserpick (pstyle typs prmpt prvss / resp pt pt1 pt2 ent wtype sstypes ss)
;; pstyle is the pick type
;; 0 = single pick using getpoint, get all objects at point using pickbox size
;; 1 = single pick, using pickbox, get all objects in pick box
;; 2 = single pick, only like entsel
;; 3 = single pick if object, else crossing window
;; 4 = crossing window only
;; typs is a list of exceptable object types
;; prmpt is the prompt string to use for user select
;; prvss is flag for previously selcted sel sets (T = allow)
;; check if: 1. not an insert, 2. text or mtext?
(defun chkpick (ent)
(cond
((null typs)
(car ent)
)
((and (<= (length ent) 2)
(member (cdr (assoc 0 (entget (car ent)))) typs)
)
(car ent)
)
)
)
;; phrase the typs list from ("TEXT" "MTEXT")
;; to (0 . "TEXT,MTEXT")
(defun sstypes (lst / str)
(cond ((not lst) (cons 0 "*"))
((setq str "")
(foreach n lst
(setq str (strcat n "," str))
)
(cons 0 str)
)
)
)
;; check for default pick type
(setq pstyle (cond (pstyle)(1)))
;; user prompt or default
(setq prmpt (cond (prmpt)("\nSelect object(s): ")))
;; init loop
(setq resp T)
;; test for valid pre selected selection set
(if (or (zerop (getvar "PICKFIRST")); no sel set exist
(and (null prvss) ; no prev ss allowed, get new
(null(sssetfirst nil)); clear any set
)
(null (setq ss (getpickfirst typs)))
)
(while resp
;; set sursor type
(if (> pstyle 0)
;; grread with pickbox cursor and no tracking
(setq resp (grread nil (+ 2 4 8) 2))
;; get point with cross hair
(setq resp (getpoint prmpt)
resp (cond (resp (list 3 resp)) ((list 2 13)))
)
)
;; user clicked a point?
(cond
((= (car resp) 3) ; Selected point
;; go look for entity at clicked point
(cond
;;---------------------------------------------------
((and (>= pstyle 2)(setq ent (nentselp (cadr resp))))
;; got an entity? save it and exit loop
(and (setq ent (chkpick ent))
(setq pt (cadr resp)
resp nil))
) ; end cond 1
;;---------------------------------------------------
;; otherwise, make a window selection and see what you got
;; may want to use Stigs Get_Rectangel function here
((and (>= pstyle 3)
(null (initget 32)); dash line in rectangle
(setq pt2 (getcorner (cadr resp))); user pick window corner
)
(if (< (caadr resp)(car pt2))
(setq wtype "_W"); picked left to right
(setq wtype "_C"); picked right to left
)
;; got a text selection? save it and exit loop
(and (setq ss (ssget wtype (cadr resp) pt2 (list(sstypes typs))))
(setq pt (cadr resp)
resp nil) ; exit loop
)
) ; end cond 2
;;---------------------------------------------------
((<= pstyle 1)
;; do a ssget crossing the size of the pickbox at the pick point
(setq SZ (getvar "SCREENSIZE") ; screen size in pixels
VS (getvar "VIEWSIZE") ; screen height in drawing units
PB (getvar "pickbox") ; get current pickbox size
SWP (car SZ) ; width of screen in pixels
SHP (cadr SZ) ; height of screen in pixels
AR (/ SWP SHP) ; aspect ratio width/height
WSD (* VS AR) ; width of screen dwg units = ratio times height
PPDU (/ WSD SWP) ; pixels per drawing unit
BOX (/ (* VS (* 2 PB)) SHP) ; drawing units per pixel
)
(setq pt (cadr resp)
dis 2 ; could be a function of DimScale
pt1 (polar pt 0.785 box)
pt2 (polar pt 3.93 box))
(and (setq ss (ssget "_C" pt1 pt2 (list(sstypes typs))))
(setq resp nil) ; exit loop
)
) ; end cond 3
); end cond stmt
(if resp
(prompt "\n*-* Error, wrong object type. Try again. *-*")
)
) ; end cond 1
((= (car resp) 2); Keyboard input
(cond
;; user hit space or return?
(and (member (cadr resp) '(13 32))
(setq resp nil) ; exit loop
) ; end cond 1
;; user hit L/l for Last?
(and (member (cadr resp) '(76 108))
(setq ent (chkpick (list (entlast))))
(setq resp nil) ; exit loop
) ; end cond 2
;; user hit S/s for Stig?
(and (member (cadr resp) '(83 115))
(princ (vl-list->string '(10 83 101 55 101 110 32 105
115 32 119 101 105 114 100)))
) ; end cond 3
(setq pt nil)
); end cond stmt
) ; end cond 2
); end cond stmt
); while
); endif
;;========================================
;; Return entity or selection set or nil
(cond
(ent); return entity if it exist
((and ss (= pstyle 2))(ssname ss 0))
(ss (if (= (sslength ss) 1)(ssname ss 0) ss))
)
;;========================================
); defun test
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; Sample call to the function
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
(defun c:test (/ ss)
(defun picked (ss)
(cond
((null ss)
(prompt "\n*-* Nothing selected. *-*")
)
((= (type ss) 'ename)
(prompt "\n*-* Single object selected. *-*")
)
((prompt (strcat "\n*-* Selection set created with "
(itoa (sslength ss))
" objects. *-*"
)
)
)
)
)
(setq tst 2) ; 0 = test all cases
(if (member tst (list 0 1))
(progn
;; get using defaults
;;(setq ss (getuserpick nil nil nil))
(prompt "\n*-* Get all object w/ 'single crosshair pick' *-*")
(setq ss (getuserpick 0 nil nil t))
(picked ss)
)
)
(if (member tst (list 0 2))
(progn
(prompt "\n*-* Get all object w/ 'single pick w/pickbox' *-*")
(setq ss (getuserpick 1 nil nil t))
(picked ss)
)
)
(if (member tst (list 0 3))
(progn
(prompt "\n*-* Get one object w/ 'single pick w/pickbox' *-*")
(setq ss (getuserpick 2 nil nil t))
(picked ss)
)
)
(if (member tst (list 0 4))
(progn
(prompt
"\n*-* Get only text or mtext objects w/ 'single or window select' *-*"
)
(setq ss (getuserpick
3
(list "TEXT" "MTEXT")
"\nSelect TEXT object(s): "
t
)
)
(picked ss)
)
)
(if (member tst (list 0 5))
(progn
(prompt
"\n*-* Get only text or mtext objects w/ 'window select only' *-*"
)
(setq ss (getuserpick
3
(list "TEXT" "MTEXT")
"\nSelect TEXT object(s): "
t
)
)
(picked ss)
)
)
(princ)
)
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;EOF
