;;; Make Polyline Selection (draw pline, Select Objects Within/Crossing it and delete pline)
;;; Created by Igal Averbuh 2017 (inspired by some ideas from http://www.cadtutor.net/forum/)
;;; Special thanks to Alan J. Thompson

(defun c:swc (/ _addgroup _pac add e i ss temp)
;; Select Objects Within/Crossing Curve
;; Alan J. Thompson, 03.31.11
;; Slightly modified by Igal Averbuh 2017 (added option for splines)
;; RJP simplified & added groups 02.22.2017
(vl-load-com)
(defun _pac (e / l v d lst)
(setq d (- (setq v (/ (setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) 500.))))
(while (< (setq d (+ d v)) l) (setq lst (cons (vlax-curve-getpointatdist e d) lst)))
)
(defun _addgroup (listofobjects / grp grps name)
;; Check that all items in the list are vla-objects
(if (and (vl-every '(lambda (x) (eq (type x) 'vla-object)) listofobjects)
(setq grps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object))))
)
(progn (setq grp (vla-add grps "*"))
(vlax-invoke grp 'appenditems listofobjects)
listofobjects
)
)
)
(initget 0 "Crossing Within")
(setq *swc:opt*
(cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] : "
)
)
)
(*swc:opt*)
)
)
; (princ "\nSelect closed curves to select object(s) within: ")
(if (setq add (ssadd)
ss (ssget "L" )
)
(progn
(repeat (setq i (sslength ss))
;; Must be visible on screen for point selection to work
(if (setq temp (ssget (if (eq *swc:opt* "Crossing")
"_CP"
"_WP"
)
(_pac (setq e (ssname ss (setq i (1- i)))))
)
)
(progn
;; Remove boundary from selection so it won't get grouped
(ssdel e temp)
;; Delete boundary
(entdel e)
;; Group objects
(_addgroup
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex temp))))
)
;; Highlight selection
(sssetfirst nil temp)
)
)
)
)
)
(princ)
)

(defun C:PAS ()
(setvar "osmode" 16384)

(command "_.pline")
(while (> (getvar "CmdActive") 0)
(command pause)
)
(c:swc)
(princ)
)

Advertisements