Author Topic: Minimum Clicks with ssget  (Read 13554 times)

0 Members and 1 Guest are viewing this topic.

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Minimum Clicks with ssget
« Reply #30 on: September 14, 2004, 10:57:33 AM »
where two or more people work on a bit of code together. (Eachother exchanging code/ precedures/ etc.)
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

SMadsen

  • Guest
Minimum Clicks with ssget
« Reply #31 on: September 14, 2004, 11:47:35 AM »
Quote from: CAB
Well, would you believe I never paid any attention to it. I guess I need to open my eyes. :shock:

No I can't believe that! :shock:  heh

One could write a simulation of implied windowing, for example:

Code: [Select]
(defun getrect (pt / col method pi270 pi90 pt1 track)
  (setq pi270 (* 1.5 pi) pi90 (* 0.5 pi))
  (while (= 5 (car (setq track (grread T 5 1))))
    (redraw)
    (setq pt1 (cadr track))
    (cond ((>= pi270 (angle pt pt1) pi90)(setq col -256 method "_C"))
          ((setq col 256 method "_W")))
    (grvecs (list col pt (list (car pt) (cadr pt1))
                  col (list (car pt) (cadr pt1)) pt1
                  col pt1 (list (car pt1)(cadr pt))
                  col (list (car pt1)(cadr pt)) pt))
  )
  (redraw)
  ;; return point AND selection method
  (cond (pt1 (list pt1 method)))
)


.. BUT it looses the osnap features and is more sensitive to wrong inputs than GETCORNER

Quote from: CAB
How about this?
Code: [Select]
(cond (ent) ((null ss) nil) ((=(sslength ss)1)(ssname ss 0)) (ss))

Sure. I think the null condition is redundant, though.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #32 on: September 14, 2004, 01:01:07 PM »
Quote from: Stig
Sure. I think the null condition is redundant, though.


Ok you got me again. Where is the redundancy? :oops:

Code: [Select]
 ;;========================================
  ;;  Return entity or selection set or nil
  (cond
    (ent); return entity if it exist
    ((null ss) nil) ; nil if no selection set
    ((=(sslength ss)1)(ssname ss 0)); entity if only one
    (ss) ; selection set if more that one entity
  )
  ;;========================================
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #33 on: September 14, 2004, 01:07:17 PM »
Quote from: Stig
One could write a simulation of implied windowing, for example:


Wow
That is an amazing chuck of code... :shock:
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #34 on: September 14, 2004, 01:14:16 PM »
Quote
If the user presses the pointer button within a screen menu or pull-down
menu box, grread returns a type 6 or type 11 code, but in a subsequent call, it
does not return a type 12 code: the type 12 code follows type 6 or type 11 only
when the pointer button is pressed while it is in the graphics area of the
screen. It is important to clear the code 12 data from the buffer before
attempting another operation with a pointer button or an auxiliary button. To
accomplish this, perform a nested grread like this:

(setq code_12 (grread (setq code (grread))))

This sequence captures the value of the code 12 list as streaming input from the device.


I seldom use grread but is this something to worry about when using grread?
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.

SMadsen

  • Guest
Minimum Clicks with ssget
« Reply #35 on: September 14, 2004, 01:20:40 PM »
Quote from: CAB
Where is the redundancy?

See comments starting with "^"
Code: [Select]
;;========================================
  ;;  Return entity or selection set or nil
  (cond
    (ent); return entity if it exist
    ;;((null ss) nil) ; nil if no selection set
   
    ;; ^ ((null ss)... ) is contained in (ss ...) below
    (ss (if (= (sslength ss) 1)(ssname ss 0) ss))
    ;; ^ entity if only one or ss if more than one
     
    ;;(ss) ; selection set if more that one entity
    ;; ^ no need for this, either
  )
  ;;========================================

SMadsen

  • Guest
Minimum Clicks with ssget
« Reply #36 on: September 14, 2004, 01:27:17 PM »
Quote from: CAB
I seldom use grread but is this something to worry about when using grread?

I don't really know, CAB. I never ran into the problem but then I too seldom use GRREAD. At least not for code "out there" that otherwise could trigger complaints.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #37 on: September 14, 2004, 02:05:38 PM »
Code: [Select]
 ;;========================================
  ;;  Return entity or selection set or nil
  (cond
    (ent); return entity if it exist
    (ss (if (= (sslength ss) 1)(ssname ss 0) ss))
  )
  ;;========================================

 
You are so clever. 8)
 IF ss is nil all conditions fail and nil is returned.
 if ss is not nil the IF is executed and sslength is tested.
Thanks, I'll try to remember that one.
It's surprising how versatile the cond function is.
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.

daron

  • Guest
Minimum Clicks with ssget
« Reply #38 on: September 14, 2004, 10:58:05 PM »
I've never run into the grread 12 problem and have used grread on a good few programs.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #39 on: September 14, 2004, 11:02:44 PM »
Thanks daron.
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Minimum Clicks with ssget
« Reply #40 on: September 18, 2004, 02:08:43 PM »
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?

Code: [Select]
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; 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
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.