ssget with message

Here is my first stab at this problem. It works on my system A2k4. Comments welcomed.


Tim

(defun tmw:ssget (Criteria Message / Ent Rtnss TypeList Pt1 Pt2 WinOpt temp1 temp2 cnt1)
;|
Allows you to get a selection set with a message.
use: (setq test (tmw:ssget (list '(0 . "*LINE") (cons 410 (getvar "ctab"))) "\nSelect line:"))
Right now only supports one DxfCode entry per use
By: Tim Willey Jan. 2005
|;

(setvar "errno" 0)
(setq Rtnss (ssadd))
(setq TypeList (StrParse (strcase EntType) ","))
(while (/= (getvar "errno") 52)
(initget "All")
(setq Ent (entsel Message))
(if (and (not Ent) (= (getvar "errno") 7))
(setq Pt1 (cadr (grread 3)))
)
(cond
((and Ent (= (type Ent) 'LIST))
(if (setq temp1 (ssget (cadr Ent) Criteria))
(while (setq temp2 (ssname temp1 0))
(ssadd temp2 Rtnss)
(redraw temp2 3)
(ssdel temp2 temp1)
)
)
)
((and Pt1 (= (getvar "errno") 7))
(setq Pt2 (getcorner Pt1 "\nSelect second point: "))
(if (< (car Pt1) (car Pt2))
(setq WinOpt "W")
(setq WinOpt "C")
)
(if (setq temp1 (ssget WinOpt Pt1 Pt2 Criteria))
(while (setq temp2 (ssname temp1 0))
(ssadd temp2 Rtnss)
(redraw temp2 3)
(ssdel temp2 temp1)
)
)
)
((= Ent "All")
(if (setq temp1 (ssget "x" Criteria))
(while (setq temp2 (ssname temp1 0))
(ssadd temp2 Rtnss)
(redraw temp2 3)
(ssdel temp2 temp1)
)
)
(setvar "errno" 52)
)
)
)
(if (> (sslength Rtnss) 0)
(progn
(setq cnt1 0)
(repeat (sslength Rtnss)
(redraw (ssname Rtnss cnt1) 4)
(setq cnt1 (1+ cnt1))
)
Rtnss
)
)
)

 

it will required to have an error control

Luis, I have used nomutt for similar things, and you are right, it
isimportant to include an error handler with nomutt. Users become very
alarmed when their command prompt disappears! In this case, they have plenty
of time to cancel the function during object selection.

Also, I believe you do not need the (if filter ... ) test. If filter is nil,
I think the selection still works, as in (ssget nil).