« previous next »
Pages: [1] 2  All |   Go Down

Author Topic: Selection Set and Text  (Read 5096 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12928
  • London, England
Selection Set and Text
« on: July 04, 2009, 09:09:07 AM »
I'm not sure if this will be of any use to anyone, or even whether the function has already been created by someone else. But I may use it for a program I am working on, so I thought I'd share it with the community.

It is based on CAB's (getpoint_or_text) routine - (a very useful routine indeed... nice one Alan)   :-)

Lee

Code: [Select]
;; ====================[ ss_and_text.lsp ]=================== ;;
;;  Author: Lee McDonnell Copyright © July 2009               ;;
;;  Function: Will allow for a Selection Set and text input.  ;;
;;  Syntax: ss_and_text                                       ;;
;;  Version: 1.0  ~  04.07.2009                               ;;
;;                                                            ;;
;;  Arguments: prmpt ~ a prompt to be displayed               ;;
;;             ctyp  ~ the cursor type to be displayed        ;;
;;                     0 = Normal Crosshairs                  ;;
;;                     1 = No Cursor Displayed                ;;
;;                     2 = Object Selection Cursor            ;;
;;             flst  ~ an optional Selection Set Filter list  ;;
;;                                                            ;;
;;  Returns:   A dotted pair ~                                ;;
;;             (<SelectionSet> . <String>)                    ;;
;;                                                            ;;
;; ========================================================== ;;

(defun ss_and_text (prmpt ctyp flst / ss str grdat gr dat ent
                                      grwin cPt pt1 pt2 lst nss)
  (vl-load-com)
  (setq ss (ssadd) str "")
  (vl-catch-all-apply
    (function
      (lambda ( )
        (princ prmpt)
        (while
          (progn
            (setq grdat (grread t 15 ctyp)
                  gr (car grdat) dat (cadr grdat))
            (if
              (not
                (zerop
                  (sslength ss)))
              (mapcar
                (function
                  (lambda (x)
                    (redraw x 3)))
                (vl-remove-if 'listp
                  (mapcar 'cadr (ssnamex ss)))))
            (cond
              ((eq 3 gr)
               (if (setq ent (car (nentselp dat)))
                 (if flst
                   (if (vl-every
                         (function
                           (lambda (x / tag)
                             (and
                               (setq tag (assoc (car x) (entget ent)))
                                 (wcmatch (cdr tag) (cdr x)))))
                         flst)
                     (ssadd ent ss) t)
                   (ssadd ent ss))
                 (progn
                   (while
                     (and
                       (eq 5
                         (car
                           (setq grwin (grread t 15 0))))
                       (listp (setq cPt (cadr grwin))))
                     (redraw)
                     (setq pt1 (list (car cPt) (cadr dat) (caddr cPt))
                           pt2 (list (car dat) (cadr cPt) (caddr cPt)))
                     (setq lst
                       (list
                         (if
                           (minusp
                             (- (car cPt) (car dat))) -30 30)
                         dat pt1 dat pt2 pt1 cPt pt2 cPt))
                     (grvecs lst))
                   (redraw)
                   (if (setq nss
                         (ssget
                           (if (minusp (car lst)) "_C" "_W")
                             dat cPt
                           (cond (flst))))
                     (mapcar
                       (function
                         (lambda (x)
                           (ssadd x ss)))
                       (vl-remove-if 'listp
                         (mapcar 'cadr (ssnamex nss)))) t))))
              ((eq 2 gr)
               (cond
                 ((< 31 dat 127)
                  (princ (chr dat))
                  (setq str (strcat str (chr dat))))
                 ((= dat 8)
                  (and (> (strlen str) 0)
                       (setq str (substr str 1 (1- (strlen str))))
                       (princ (vl-list->string '(8 32 8)))))
                 ((= dat 13)
                  nil)
                 (t t)))
              ((eq 25 gr) nil)
              (t t))))
        (if
          (not
            (zerop
              (sslength ss)))
          (mapcar
            (function
              (lambda (x)
                (redraw x 4)))
            (vl-remove-if 'listp
              (mapcar 'cadr (ssnamex ss))))))))
  (cons
    (if
      (not
        (zerop
          (sslength ss))) ss) str))

;; Test Function

(defun c:test (/ input)
  (setq input (ss_and_text "\nSelect Objects:  " 2 '((0 . "LINE"))))
  (sssetfirst nil (car input))
  (princ (strcat "\nUser Entered: " (cdr input)))
  (princ))
       
Logged

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Selection Set and Text
« Reply #1 on: July 04, 2009, 11:45:34 AM »
Works as advertised! Good job. :-)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12928
  • London, England
Re: Selection Set and Text
« Reply #2 on: July 04, 2009, 11:50:31 AM »
Thanks Alan  8-)
Logged

hermanm

  • Guest
Re: Selection Set and Text
« Reply #3 on: July 04, 2009, 01:41:09 PM »
Nice job, Lee, but I must be dense, 'cause I don't see an obvious use for the "user comment" on the selected items.

Could you provide a simple example of how you would actually use the string?
Logged

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Selection Set and Text
« Reply #4 on: July 04, 2009, 01:55:20 PM »
First thing that comes to mind is:
You could have a situation where you want the user to "Name" the selection set or several of selection sets with user names.
Obviously you could have a loop to getsting the names. Also the "Select Objects:" prompt is avoided.

Lee there is no way to remove [Shift + Click] items from the SS. 8-)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12928
  • London, England
Re: Selection Set and Text
« Reply #5 on: July 04, 2009, 02:24:13 PM »
Quote from: CAB on July 04, 2009, 01:55:20 PM
First thing that comes to mind is:
You could have a situation where you want the user to "Name" the selection set or several of selection sets with user names.
Obviously you could have a loop to getsting the names. Also the "Select Objects:" prompt is avoided.

True, -
I used it to override the "Select Objects" prompt - which probably isn't using it to its full extent, but it was fun to make.
I can see other uses for it though - for instance, ssget doesnt allow for keywords, or any string input (except for the usual "Last/Window.."), also, I had considered using it so that I could prompt a user to either select a selection set of blocks, or specify a block name.


Quote from: CAB on July 04, 2009, 01:55:20 PM
Lee there is no way to remove [Shift + Click] items from the SS. 8-)

Good point - but I wanted to avoid the necessity of Expess Tools, as I can't see any other way of detecting a down-shift in LISP without using the acet-sys-shift-down function  :-(  But, if you can see a way around this just shout  :-)

Lee
Logged

hermanm

  • Guest
Re: Selection Set and Text
« Reply #6 on: July 04, 2009, 04:49:59 PM »
Quote from: CAB on July 04, 2009, 01:55:20 PM
Also the "Select Objects:" prompt is avoided.

Ah. I like that.:)
Logged

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8822
  • AKA Daniel
Re: Selection Set and Text
« Reply #7 on: July 04, 2009, 08:46:57 PM »
Quote from: Lee Mac on July 04, 2009, 02:24:13 PM
I used it to override the "Select Objects" prompt...

It's too bad the :$ option was never exposed to lisp
http://www.theswamp.org/index.php?topic=21875.msg338728#msg338728
Logged

Lee Mac

  • Seagull
  • Posts: 12928
  • London, England
Re: Selection Set and Text
« Reply #8 on: July 04, 2009, 09:14:04 PM »
Quote from: Daniel on July 04, 2009, 08:46:57 PM
Quote from: Lee Mac on July 04, 2009, 02:24:13 PM
I used it to override the "Select Objects" prompt...

It's too bad the :$ option was never exposed to lisp
http://www.theswamp.org/index.php?topic=21875.msg338728#msg338728

Yeah, that would be kinda handy  :-P
Logged

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8822
  • AKA Daniel
Re: Selection Set and Text
« Reply #9 on: July 04, 2009, 09:59:49 PM »
I meant by aUtOdEsK  :-P :-P  :-D
Logged

Spike Wilbury

  • Guest
Re: Selection Set and Text
« Reply #10 on: July 04, 2009, 11:17:48 PM »
one of my old functions (like 14 years ago)...

Code: [Select]
(defun lbx-ssget-prompt (msg filter / ss *current-nomutt*)
  (setq *current-nomutt* (getvar "nomutt"))
  (prompt (strcat "\n" msg ": "))
  (setvar "nomutt" 1)
  (if filter
    (setq ss (ssget filter))
    (setq ss (ssget))
  )
  (setvar "nomutt" 0)
  ss
)

;;; (setq ss1 (lbx-ssget-prompt "Select my entities: "))

an x .... lisper

 :-P
Logged

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Selection Set and Text
« Reply #11 on: July 04, 2009, 11:38:25 PM »

Quote
one of my old functions (like 14 years ago)...



I know time flies Luis, but wasn't nomutt introduced in R14 or R2000 ??

... perhaps it just feels like 14 years :)
Logged
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Spike Wilbury

  • Guest
Re: Selection Set and Text
« Reply #12 on: July 04, 2009, 11:46:10 PM »
Quote from: Kerry Brown on July 04, 2009, 11:38:25 PM

Quote
one of my old functions (like 14 years ago)...



I know time flies Luis, but wasn't nomutt introduced in R14 or R2000 ??

... perhaps it just feels like 14 years :)

no idea Kerry, that's why I use the "like".... in there
Logged

Lee Mac

  • Seagull
  • Posts: 12928
  • London, England
Re: Selection Set and Text
« Reply #13 on: July 05, 2009, 05:34:26 AM »
Quote from: LE on July 04, 2009, 11:17:48 PM
one of my old functions (like 14 years ago)...

Code: [Select]
(defun lbx-ssget-prompt (msg filter / ss *current-nomutt*)
  (setq *current-nomutt* (getvar "nomutt"))
  (prompt (strcat "\n" msg ": "))
  (setvar "nomutt" 1)
  (if filter
    (setq ss (ssget filter))
    (setq ss (ssget))
  )
  (setvar "nomutt" 0)
  ss
)

;;; (setq ss1 (lbx-ssget-prompt "Select my entities: "))

an x .... lisper

 :-P

Nice Luis, I like it  8-)
Logged

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Selection Set and Text
« Reply #14 on: July 05, 2009, 05:47:01 AM »

Should that be

(setq ss1 (lbx-ssget-prompt "Select my entities " NIL )) ; ??

and/or  (setq ss2 (lbx-ssget-prompt "Select my entities " '( ( 0 . "THINGY")) ))


/// kdub
Logged
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.
Pages: [1] 2  All |   Go Up
« previous next »