Author Topic: Grread selection window parallel to twisted UCS: strange response from Acad?  (Read 4101 times)

0 Members and 1 Guest are viewing this topic.

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
Here is some code I've been working on that uses grread to create/simulate a selection window parallel to the current UCS. It works OK on Bricscad. But after posting it on a forum, Acad users reported a problem if the two points for the window are picked in an empty part of the drawing. Is Acad behaving illogically or am I missing something?

The grread portion of the code was based on:
http://www.bricsys.nl/common/support/forumthread.jsp?id=11793
Something similar can be found here:
http://www.theswamp.org/index.php?topic=12813.0

Code: [Select]
(defun SWP () (SelWinParToUcs))
(defun SelWinParToUcs ( / ssGripped pt1 pt2 pt3 pt4 grResult col ss)
  (setq ssGripped (cadr (ssgetfirst)))
  (setq pt1 (getpoint "\nFirst point: "))
  (princ "\nSecond point: ")
  (while
    (and
      (setq grResult (grread 'T))
      (= (car grResult) 5)
    )
    (setq
      pt3 (cadr grResult)
      pt2 (list (car pt1) (cadr pt3) (caddr pt1))
      pt4 (list (car pt3) (cadr pt1) (caddr pt1))
      col (if (< (car pt3) (car pt1)) -256 256)
    )
    (redraw)
    (grvecs (list col pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1))
  )
  (redraw)
  (princ grResult) ; < princ for debugging
  (if (= (car grResult) 3)
    (progn
      (if (< (car pt3) (car pt1))
        (setq ss (ssget "_CP" (list pt1 pt2 pt3 pt4)))
        (setq ss (ssget "_WP" (list pt1 pt2 pt3 pt4)))
      )
      (if (= (getvar "cmdactive") 0)
        (progn
          (if ssGripped
            (setq ss (SsUnion ss ssGripped))
          )
          (sssetfirst ss ss)
          (princ)
        )
        ss
      )
    )
  )
)

(defun SsUnion (ss1 ss2 / ssResult ssToAdd i)
  (cond
    ((and (= (type ss1) 'pickset) (= (type ss2) 'pickset))
      (if (> (sslength ss1) (sslength ss2))
        (setq
          ssResult ss1
          ssToAdd ss2
        )
        (setq
          ssResult ss2
          ssToAdd ss1
        )
      )
      (repeat (setq i (sslength ssToAdd))
        (ssadd (ssname ssToAdd (setq i (1- i))) ssResult)
      )
      ssResult
    )
    ((and (= (type ss1) 'pickset) (not ss2))
      ss1
    )
    ((and (= (type ss2) 'pickset) (not ss1))
      ss2
    )
  )
)

(princ "\nUsage: (SelWinParToUcs) or (SWP) ")
(princ)

History:
Command: move
Select objects: 'wss < User has created a short cut
First point:
Second point: (3 (2.38448 10.9889 0.0))nil < grResult and ss (=nil)

First polygon point: < Acad prompts for first point of new polygon, why?

« Last Edit: September 05, 2010, 05:37:53 AM by roy_043 »

hmspe

  • Bull Frog
  • Posts: 336
The function works exactly the same here in Autocad 2011 and Bricscad 10.14.18.  Do you have any more details?  I guess I should also ask what one would expect to select in an empty part of a drawing...   
"Science is the belief in the ignorance of experts." - Richard Feynman

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
The function works exactly the same here in Autocad 2011 and Bricscad 10.14.18.
Does that mean it works OK in both programs?

Do you have any more details?
No.

I guess I should also ask what one would expect to select in an empty part of a drawing...
Ok, "empty part" is confusing. Read that portion as: "... a problem if the two points for the window are picked and for whatever reason, nothing is selected ..."

Lee Mac

  • Seagull
  • Posts: 12267
  • London, England
My old one, not sure if it's any help to you?

Code: [Select]
(defun LM:GetSelectionSet ( str pt filter / gr p1 pt1 pt2 lst )
  ;; © Lee Mac  ~  17.06.10
  (princ str) 

  (while (and (= 5 (car (setq gr (grread t 13 0)))) (listp (setq p1 (cadr gr))))
    (redraw)

    (setq pt1 (list (car p1) (cadr pt) (caddr p1))
          pt2 (list (car pt) (cadr p1) (caddr p1)))

    (grvecs
      (setq lst
        (list
          (if (minusp (- (car p1) (car pt))) -30 30)
          pt pt1 pt pt2 pt1 p1 pt2 p1
        )
      )
    )
  )

  (redraw)

  (ssget (if (minusp (car lst)) "_C" "_W") pt p1 filter)
)

Code: [Select]
(defun c:test nil
  (sssetfirst nil (LM:GetSelectionSet "\nSelect Objects: " (getpoint "\nFirst Pt: ") nil))
)

I liked orange :-)

gile

  • Water Moccasin
  • Posts: 2231
  • Marseille, France
Hi,

Here's one I wrote some times ago
Using : type SSUCS to select an grip objects or (ssucs) when the user is prompted to select objects within an edition command.

Code: [Select]
;; SSCU (gile) 31/03/07
;; Sélection mutiple par cible, fenêtre ou capture
;; Le cadre de la fenêtre est parallèle au plan du SCU courant
;; La sélection est terminée en faisant Entrée, Espace ou clic droit

(defun ssucs (/ *error* sel RedrawSelSet  sst loop p1 gr p2 p3 p4 po ss n ent)

  (defun *error* (msg)
    (and msg
(/= msg "Function cancelled")
(princ (strcat "\nError: " msg))
    )
    (redraw)
    (RedrawSelSet sst 4)
    (princ)
  )

  ;; Applique redraw avec le drapeau spécifié à un jeu de sélection
  (defun RedrawSelSet (ss flag / n)
    (repeat (setq n (sslength ss))
      (redraw (ssname ss (setq n (1- n))) flag)
    )
  )

  ;; Retourne un jeu de sélection, un point ou nil
  (defun sel (/ loop gr pt)
    (setq loop T)
    (while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
      (cond
((= (car gr) 5)
(setq pt (cadr gr))
)
((or (member gr '((2 13) (2 32)))
     (or (= (car gr) 11) (= (car gr) 25))
)
(setq loop nil
       pt   nil
)
)
      )
    )
    (if pt
      (cond
((ssget pt))
(pt)
      )
    )
  )

  (sssetfirst nil nil)
  (setq sst (ssadd))
  (while (and
   (princ "\nSelect objects: ")
   (setq p1 (sel))
)
    (if (listp p1)
      (progn
(princ "\nSpecify the opposite corner: ")
(setq p1 (list (car p1) (cadr p1)))
(while (and (setq gr (grread T 12 0)) (/= (car gr) 3))
  (if (= 5 (car gr))
    (progn
      (redraw)
      (setq p2 (list (caadr gr) (cadr p1))
    p3 (list (caadr gr) (cadadr gr))
    p4 (list (car p1) (cadadr gr))
      )
      (if (< (car p1) (car p2))
(progn
  (setq po "_WP")
  (grvecs (list 255 p1 p2 p2 p3 p3 p4 p4 p1)
  )
)
(progn
  (setq po "_CP")
  (grvecs
    (list -255 p1 p2 p2 p3 p3 p4 p4 p1)
  )
)
      )
    )
  )
)
(redraw)
(if (setq ss (ssget po (list p1 p2 p3 p4)))
  (repeat (setq n (sslength ss))
    (setq ent (ssname ss (setq n (1- n))))
    (if (not (ssmemb ent sst))
      (ssadd ent sst)
    )
    (redraw ent 3)
  )
)
      )
      (progn
(ssadd (ssname p1 0) sst)
(redraw (ssname p1 0) 3)
      )
    )
  )
  (*error* nil)
  sst
)

(defun c:ssucs ()
  (sssetfirst nil (ssucs))
  (princ)
)
Speaking English as a French Frog

hmspe

  • Bull Frog
  • Posts: 336
The function works exactly the same here in Autocad 2011 and Bricscad 10.14.18.
Does that mean it works OK in both programs?

No, it just means it appears to do exactly the same thing in both programs.  If there are entities in the rectangle the entities are selected.  I don't know exactly what is intended by the code so I can't say whether it is "OK".

Do you have any more details?
No.

Hard to troubleshoot with no idea what the user thinks is wrong...

I guess I should also ask what one would expect to select in an empty part of a drawing...
Ok, "empty part" is confusing. Read that portion as: "... a problem if the two points for the window are picked and for whatever reason, nothing is selected ..."

For me, if there are blocks inside the rectangle they are selected. 

Could this be a as simple as not having grips turned on so there is no visible evidence of a selection?  ...or maybe related to "totally within" vs. "partly within?   
"Science is the belief in the ignorance of experts." - Richard Feynman

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
Thanks everybody for all your replies. I will look into all your solutions.

But apparently my question hasn't been very clear. The problem with my code is that in case of a nil selection AutoCAD starts a new selection polygon. This seems totally illogical to me. Can anybody explain this behaviour?
First polygon point: < Acad prompts for first point of new polygon, why?

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
Code update...
<EDIT>And another update... :roll:</EDIT>

Code: [Select]
(defun SWP () (SelWinParToUcs))
(defun SelWinParToUcs ( / ssGripped ss)
  (setq ssGripped (cadr (ssgetfirst)))
  (setq ss
    (vl-catch-all-apply
      '(lambda ( / pt1 pt2 pt3 pt4 grResult)
        (while (not (setq pt1 (getpoint "\nFirst corner: ")))
          (princ "\nInvalid window specified. ")
        )
        (princ "\nOpposite corner: ")
        (while
          (and
            (setq grResult (grread 'T 12 0))
            (cond
              ((member (car grResult) '(2 11 12))
                (princ "\nInvalid window specified. \nOpposite corner: ")
              )
              ((= (car grResult) 5)
                (setq
                  pt3 (cadr grResult)
                  pt2 (list (car pt1) (cadr pt3) (caddr pt1))
                  pt4 (list (car pt3) (cadr pt1) (caddr pt1))
                )
                (redraw)
                (grvecs (list (if (< (car pt3) (car pt1)) -256 256) pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1))
                'T
              )
            )
          )
        )
        (redraw)
        (if (= (car grResult) 3) (ssget (if (< (car pt3) (car pt1)) "_CP" "_WP") (list pt1 pt2 pt3 pt4)))
      )
    )
  )
  (cond
    ((vl-catch-all-error-p ss)
      (redraw)
      (if (= (getvar "cmdactive") 0)
        (princ)
        (progn
          (command) ; cancel the command
          (princ)
        )
      )
    )
    (ss
      (if (= (getvar "cmdactive") 0)
        (progn
          (setq ss (kg:SsUnion ss ssGripped))
          (sssetfirst ss ss)
          (princ)
        )
        ss
      )
    )
    ('T
      (princ)
    )
  )
)

(defun kg:SsUnion (ss1 ss2 / i)
  (cond
    ((and (= (type ss1) 'pickset) (= (type ss2) 'pickset))
      (repeat (setq i (sslength ss2))
        (ssadd (ssname ss2 (setq i (1- i))) ss1)
      )
      ss1
    )
    ((and (= (type ss1) 'pickset) (not ss2))
      ss1
    )
    ((and (= (type ss2) 'pickset) (not ss1))
      ss2
    )
  )
)

(princ "\nUsage: (SelWinParToUcs) or (SWP) ")
(princ)
« Last Edit: September 11, 2010, 04:56:48 AM by roy_043 »