(defun c:SelectObjectsWithinPoly ()
(vl-load-com)
(defun getlayerlist (/ ADOC LAYERLIST lyr)
(setq LayerList nil)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lyr (vla-get-layers adoc) (setq LayerList (cons (vla-get-name lyr) LayerList)))
LayerList
)
(defun getcoords (entpl / r ll)
(setq ll (vlax-safearray->list
(vlax-variant-value (vlax-get-property (vlax-ename->vla-object entpl) "Coordinates"))
)
)
(setq r nil)
(cond ((equal (rem (length ll) 2) 0)
(repeat (/ (length ll) 2)
(setq r (cons (list (car ll) (cadr ll)) r)
ll (cddr ll)
)
)
(setq r (reverse r))
)
((equal (rem (length ll) 3) 0)
(repeat (/ (length ll) 3)
(setq r (cons (list (car ll) (cadr ll) (caddr ll)) r)
ll (cdddr ll)
)
)
(setq r (reverse r))
)
)
r
)
;;;
(setq opt1 (list "Polylines (Closed)" "Polylines (Open)" "Lines" "Text" "Mtext" "Blocks" "Circles" "Dimensions")
)
(setq opt2 (getlayerlist))
(if (and (progn (prompt "\nSelect any 1 Closed Polyline : ") T)
(setq cpolyss (ssget "_+.:E:S" (list (cons 0 "*Polyline") (cons 70 1))))
(setq cpoly (ssname cpolyss 0))
(setq cpolycoords (getcoords cpoly))
(setq opt1sel (LM:ListBox "Select Objects to Select : " opt1 1))
(setq opt2sel (LM:ListBox "Select Layers to Filter : " opt2 1))
(setq sellist (append (if (member "Polylines (Closed)" opt1sel)
(progn (list (cons -4 "<OR")
(cons -4 "<AND")
(cons 0 "*polyline")
(cons 70 1)
(cons -4 "AND>")
(cons -4 "OR>")
)
)
)
(if (member "Polylines (Open)" opt1sel)
(progn (list (cons -4 "<OR")
(cons -4 "<AND")
(cons 0 "*polyline")
(cons -4 "<OR")
(cons 70 0)
(cons 70 128)
(cons -4 "OR>")
(cons -4 "AND>")
(cons -4 "OR>")
)
)
)
(if (member "Lines" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "line") (cons -4 "OR>")))
)
(if (member "Text" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "TEXT") (cons -4 "OR>")))
)
(if (member "Mtext" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "MTEXT") (cons -4 "OR>")))
)
(if (member "Blocks" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "INSERT") (cons -4 "OR>")))
)
(if (member "Circles" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "Circle") (cons -4 "OR>")))
)
(if (member "Dimensions" opt1sel)
(progn (list (cons -4 "<OR") (cons 0 "Dimension") (cons -4 "OR>")))
)
(list (cons -4 "<AND") (cons -4 "<OR"))
(mapcar '(lambda (lyr) (cons 8 lyr)) opt2sel)
(list (cons -4 "OR>") (cons -4 "AND>"))
)
)
(setq ss (ssget "_CP" cpolycoords sellist))
)
(progn (sssetfirst nil ss) (princ (strcat "\n" (itoa (sslength ss)) " objects selected.")))
)
(Princ)
)
; Text in polygons
; By Alan H may 2013
(vl-load-com)
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
) ; end defun
; program starts here
; choose output file change acdatemp to what you want
(setq fname (strcat "c:/alan/" (getstring "\nEnter file name ")))
(setq fout (open fname "w"))
(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)
(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
(co-ords2xy)
; write pline co-ords here
(setq numb3 (length co-ords))
(setq z numb3)
(setq ansco-ords "")
(repeat numb3
(setq ansco-ords (strcat ansco-ords (rtos (nth (setq z (- z 1)) co-ords) 2 3 ) " " ))
)
(setq ans (strcat "Pline " ansco-ords))
(write-line ans fout)
(setq ansco-ords "")
(setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil)
(princ "\nnothing inside")
(progn
(setq coordsxy nil) ; reset for next time
(setq numb2 (sslength ss))
(setq y numb2)
(repeat numb2
(setq anstext (vlax-get-property (vlax-ename->vla-object (ssname ss (setq y (- y 1)))) "Textstring"))
(princ anstext) ; change to write text to file
(write-line (strcat "text " anstext) fout)
(princ "\n")
) ; end repeat2
(setq ss nil) ; reset for next poly
)
)
) ; end repeat1
(close fout)
(princ)
(defun c:SelW (/ _pac add ss i e temp it o a b pts tempC i3 ec)
;; Select Within/Crossing Curve
;; Alan J. Thompson, 03.31.11 / 05.11.11
(vl-load-com)
(defun _pac (e / l v d lst)
(setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
(while (< (setq d (+ d v)) l)
(setq lst (cons (trans (vlax-curve-getPointAtDist e d) 0 1) lst))
)
)
(initget 0 "Crossing Within")
(setq *SWCC:Opt*
(cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
(cond (*SWCC:Opt*)
((setq *SWCC:Opt* "Crossing"))
)
">: "
)
)
)
(*SWCC:Opt*)
)
)
(princ "\nSelect closed curves to select object(s) within: ")
(if (setq add (ssadd)
ss (ssget '((-4 . "<OR")
(0 . "CIRCLE,ELLIPSE")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "&=")
(70 . 1)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(progn (repeat (setq i (sslength ss))
(if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
(repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
)
(if (eq *SWCC:Opt* "Crossing")
(progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
(setq pts (mapcar 'vlax-safearray->list (list a b)))
(if (setq tempC (ssget "_C"
(list (caar pts) (cadar pts) 0.)
(list (caadr pts) (cadadr pts) 0.)
)
)
(repeat (setq i3 (sslength tempC))
(if (vlax-invoke
o
'Intersectwith
(vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
acExtendNone
)
(ssadd ec add)
)
)
)
)
)
)
(sssetfirst nil add)
(ssget "_I")
)
)
(princ)
)
;======SELBYOBJ: FUNCION INTERNA PARA OCUPAR EN 2 RUTINAS POSTERIORES================
(defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss)
(vl-load-com)
(if (= (type ent) 'ENAME)
(setq obj (vlax-ename->vla-object ent))
(setq obj ent
ent (vlax-vla-object->ename ent)
)
)
(cond
((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse"))
(setq dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
50
)
n 0
)
(repeat 50
(setq
lst
(cons
(trans
(vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
0
1
)
lst
)
)
)
)
((and (= (vla-get-ObjectName obj) "AcDbPolyline")
(= (vla-get-Closed obj) :vlax-true)
)
(setq p_lst (vl-remove-if-not
'(lambda (x)
(or (= (car x) 10)
(= (car x) 42)
)
)
(entget ent)
)
)
(while p_lst
(setq
lst
(cons
(trans (append (cdr (assoc 10 p_lst))
(list (cdr (assoc 38 (entget ent))))
)
ent
1
)
lst
)
)
(if (/= 0 (cdadr p_lst))
(progn
(setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
dist (/ (- (if (cdaddr p_lst)
(vlax-curve-getDistAtPoint
obj
(trans (cdaddr p_lst) ent 0)
)
(vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
)
(vlax-curve-getDistAtPoint
obj
(trans (cdar p_lst) ent 0)
)
)
prec
)
n 0
)
(repeat (1- prec)
(setq
lst (cons
(trans
(vlax-curve-getPointAtDist
obj
(+ (vlax-curve-getDistAtPoint
obj
(trans (cdar p_lst) ent 0)
)
(* dist (setq n (1+ n)))
)
)
0
1
)
lst
)
)
)
)
)
(setq p_lst (cddr p_lst))
)
)
)
(cond
(lst
(vla-ZoomExtents (vlax-get-acad-object))
(setq ss (ssget (strcat "_" opt) lst fltr))
(vla-ZoomPrevious (vlax-get-acad-object))
ss
)
)
)
;==========SSP ----> Selecciona todo, completamente dentro de: Pline, Elipse ó Circulo.====================
(defun c:SSP (/ ss opt)
(and
(or
(and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
)
(and
(sssetfirst nil nil)
(setq ss (ssget "_:S:E"
(list
'(-4 . "<OR")
'(0 . "CIRCLE")
'(-4 . "<AND")
'(0 . "ELLIPSE")
'(41 . 0.0)
(cons 42 (* 2 pi))
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "LWPOLYLINE")
'(-4 . "&")
'(70 . 1)
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
)
)
(sssetfirst
nil
(SelByObj (ssname ss 0) "Wp" nil)
)
)
(princ)
)
;==========SSP2 ----> Selecciona todo dentro, más lo que toca la: Pline, Elipse ó Circulo.====================
(defun c:SSP2 (/ ss opt)
(and
(or
(and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
)
(and
(sssetfirst nil nil)
(setq ss (ssget "_:S:E"
(list
'(-4 . "<OR")
'(0 . "CIRCLE")
'(-4 . "<AND")
'(0 . "ELLIPSE")
'(41 . 0.0)
(cons 42 (* 2 pi))
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "LWPOLYLINE")
'(-4 . "&")
'(70 . 1)
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
)
)
(sssetfirst
nil
(ssdel (ssname ss 0) (SelByObj (ssname ss 0) "Cp" nil))
)
)
(princ)
)