;;; Quick Create wblock from Polyline Selection with base point 0,0,0 and place it in a drawing directory
;;; No need to specify name and insertion point of wblock
;;; Special thanks to Alan J. Thompson and Lee Mak

;;; Combined by Igal Averbuh 2017 (inspired by some ideas from http://www.cadtutor.net/forum/)

;;; Lee Mak Quick Wblock Creator
;;; 'Convert' current selection set to selection set required by the Wblock method)
;;; Saved from: http://www.cadtutor.net/forum/showthread.php?91674-Make-selection-set-active

(defun c:wb ( / doc idx lst sel ssc vsl )
(if (setq sel (ssget "P"))
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
ssc (vla-get-selectionsets doc)
vsl (vla-add ssc (uniqueitem ssc "mywb"))
)
(vla-additems vsl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)
(vla-wblock doc
(vl-filename-mktemp
(vl-filename-base (getvar 'dwgname))
(getvar 'dwgprefix)
".dwg"
)
vsl
)
(vla-delete vsl)
)
)
(princ)
)

(defun uniqueitem ( col key / int rtn )
(setq int 0)
(while
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item
(list col (setq rtn (strcat key (itoa (setq int (1+ int))))))
)
)
)
)
rtn
)

(vl-load-com) (princ)

(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:WPS ()
(setvar "osmode" 16384)

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

Advertisements