How to let user select entities or KWord in AutoLISP? - autocad-plugin

Question

In my command I want to let user select entities, but if he wants, he should be able to use KWord.
Something like command with prompt:
Select elements od [Settings]:
I know that I can use KWord while entsel.
But entsel allows me to select only one entity,
ssget let me select many entities - which is neede, but can't use KWords.
Or I mismatched something ?
Do You know any way to join both: select many entities and KWord?

Answer 1

Since the AutoLISP ssget function offers its own keywords to allow the user to initiate any of the standard selection methods (Window, Crossing, Fence, etc.), it is not one of the functions supported by the initget (keyword initialising) function:
Expects a point or Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle
There are two alternative techniques that come to mind which could potentially allow the user to supply arbitrary predefined keywords whilst also permitting multiple selection:
Use an entsel or nentsel selection within a while loop, permitting multiple single-pick selections (i.e. selection using the pickbox aperture, with no window selection).
Develop your own ssget function through the use of the grread function within a loop to continuously capture user input.
I attempted the latter back in 2010, when I developed a 'UCS-aligned ssget function' (i.e. such that the selection window is aligned with the active UCS) - with full control over how user input is handled, you can then define your own keywords and react accordingly when the input matches such keywords:
;;------------------=={ 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)
)