Hey guys, i just watched a video clip regarding new feature of ACAD 2015
This Stylus concept inspired me on my ac2007
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
;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)))))