| Author |
Message |
T.Willey
Guest
|
 Posted:
Thu Jan 06, 2005 5:30 am Post subject:
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
)
)
)
|
|
| Back to top |
|
 |
Luis Esquivel
Guest
|
| Posted:
Thu Jan 06, 2005 7:47 pm Post subject:
Re: ssget with message |
|
|
Hi Tim,
Here is one of my base functions for this, it will required to have an error
control... hth
;; usage:
;; (setq ss (ssget-prompt "Select my entities: " nil))
(defun ssget-prompt (msg filter / ss)
(prompt (strcat "\n" msg ": "))
(setvar "nomutt" 1)
(setq ss (if filter
(ssget filter)
(ssget)))
(setvar "nomutt" 0)
ss)
For free AutoLisp/Visual Lisp resources go to:
http://www.draftteam.com/free.php?&lang=en |
|
| Back to top |
|
|
Tom Smith
Guest
|
| Posted:
Thu Jan 06, 2005 8:44 pm Post subject:
Re: ssget with message |
|
|
| Quote: | 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).
|
|
| Back to top |
|
|
T.Willey
Guest
|
| Posted:
Thu Jan 06, 2005 8:50 pm Post subject:
Re: ssget with message |
|
|
Luis,
Thanks, and I will look into the use of "nomutt". Never heard of that one before.
Tim |
|
| Back to top |
|
|
Luis Esquivel
Guest
|
| Posted:
Thu Jan 06, 2005 8:51 pm Post subject:
Re: ssget with message |
|
|
Tom,
Very good! Thank you... :-)
| Quote: | 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). |
|
|
| Back to top |
|
|
Tom Smith
Guest
|
| Posted:
Thu Jan 06, 2005 9:10 pm Post subject:
Re: ssget with message |
|
|
| Quote: | "nomutt". Never heard of that one before.
|
It will suppress nearly all disp[lay messages (muttering) such as the
"select objects" prompt. However, there are a very few messages which even
this won't suppress, a minor glitch IMHO. But you have to be very cautious
in using nomutt, and always use an error handler to catch an ESC, because
your users will totally freak if their command prompt disappears altogether! |
|
| Back to top |
|
|
|
|
|
|
FAQ
Memberlist
Register
Profile
Log in to check your private messages
Log in