Topic: ssget WP by Free hand lasso?

[hanhphuc]

Hey guys, i just watched a video clip regarding new feature of ACAD 2015
This Stylus concept inspired me on my ac2007

Code: [Select]

hp#011 / 15.07.14
;Inspired by youtube
;http://www.youtube.com/watch?v=lO0yck-r-C0

(defun lasso ( _pt  /  i l _tp d vs) ; argument: _pt =point,
  (setvar "cmdecho" 0)
      (setq  vs '(nil (/ (getvar 'viewsize) (cadr (getvar 'screensize)))))
   (if
     (not i)
     (setq d 0 )
     ) ;_ end of if
   (while
     (< d (* (vs) 50 )) ; <--- smoothness setting, which the smaller value is, the more smoothness. not 0
     (setq l   (grread nil 15 0)
   i   (car l)
   _tp (cadr l)
   ) ;_ end of setq
     (redraw)
     (if (apply 'or (mapcar '(lambda (a) (or (= a nil) (numberp a ))) (list _pt _tp)))
       (setq  d 0)
       (progn (grdraw _pt _tp 2 1) (setq d (distance _pt _tp)))
       ); if
     ) ;while
  (if (= (car (grread nil 13 0)) 5)
    (vl-cmdf "_PLINE" _pt)
    ) ;_ end of if
  (lasso _tp )
  (princ)
  ) ;defun

"rubber band" helps tracking, so still can zoom in & out

Code: [Select]

;Since using "vl-cmdf" to draw polyline, so simply use *error* to "close" the loop if [ESC] is pressed.
;can be optimized using cond & entmake
(defun c:test (/ myerr olderr)
(defun myerr (msg / )
(setq  *error* olderr)
(if(and(>(getvar "cmdactive")0) (wcmatch (strcase msg) "*CANCEL*,*QUIT*") )
(progn(princ "\n*CANCEL*")
(command "c"))
(princ(strcat "error: "msg))
))
(setq olderr *error* *error* myerr)
(lasso (getpoint "\nPEN down.. <ESC> to cancel") )
)

;command: TEST
;<ESC> to cancel
selection set Method:
(ssget "WP" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (=(car x) 10) )(entget (entlast)))))

[CAB]

Good start to a nice idea.   

[Lee Mac]

Nice idea hanhphuc 

Here is my version:

Code: [Select]

(defun c:lasso ( / c f l p q )
    (if (setq p (getpoint "\nSpecify first point: "))
        (progn
            (setq l (list p)
                  c 1
            )
            (while
                (and
                    (= 5 (car (setq q (grread t 13 0))))
                    (setq q (cadr q)
                          f (* 10 (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
                    )
                    (or (< (length l) 10) (< f (distance p q)))
                )
                (redraw)
                (if (< f (distance (car l) q))
                    (setq l (cons q l)
                          c (if (LM:listclockwise-p (reverse l)) 3 1)
                    )
                )
                (mapcar (function (lambda ( a b ) (grdraw a b c 1))) (cons (last l) l) l)
            )
            (sssetfirst nil (ssget (if (LM:listclockwise-p (reverse l)) "_CP" "_WP") l))
        )
    )
)

;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented

(defun LM:ListClockwise-p ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

(princ)
Quick Demo:



If you're feeling adventurous, you could also look to incorporate the shading 

[hanhphuc]

@CAB: thank you sir
@Lee Mac : Yeah! i like the way your LM:ListClockwise-P to play a trick in different ssget mode,
much more user friendly & smart coding
thank you too


 

[Lee Mac]

It was fun to write 

[snownut2]

Nice function Lee

[Lee Mac]

Nice function Lee

Cheers Bruce 

[Crank]

I agree the ListClockwise-p function is nice. I remember from the past I had some difficulties with this: Let's see if I can use this.  :kewl:

But of course this lasso function is too late

Nb1.: The version of Acad2015 also toggels between crossing/windows/fence if the space bar is pressed.
Nb2.: For the colors you should use the variables WINDOWAREACOLOR and CROSSINGAREACOLOR (if available). Default colors are 150 and 100.

[Lee Mac]

Thanks Crank 

I have attached a new variation of the above program. 

[pBe]

I have attached a new variation of the above program. 

Very nice LM

Neat idea hanhphuc

[hanhphuc]

I have attached a new variation of the above program. 

an ordinary wood can be masterpiece by a brilliant carve ! nice code! Lee

[Lee Mac]

Very nice LM

an ordinary wood can be masterpiece by a brilliant carve ! nice code! Lee

Many thanks guys!