AutoLISP: Delete Outside of Window

Link to AutoCAD Tips

Here’s is a great little routine that will erase everything that is outside of or crosses a selection window that you create.

This is useful for erasing objects that may have gone astray in a layout tab…

Here’s How:

  • DOUT <enter> to start
  • Make a window selection. Note: Doesn’t matter what type of selection window ex. crossing…

Everything the crosses the window and lies outside of the window will be erased.

~enjoy

;------------------------------------------------------------------------------
; PROCEDURE NAME: DOUT.LSP
;
; FUNCTIONAL DESCRIPTION: This is a complement of ERASE WINDOW.
; It will delete all entities OUTSIDE OF or CROSSING a selected window.
;
; CALLED BY: interactive
;
; CALLS: none
;
; PARAMETERS: none
;
; INPUT: interactive
;
; OUTPUT: none
;
; HEADER FILES: n/a
;
; RETURN VALUES: none
;
; CREATED BY / DATE: Daniel J. Squires, CADENCE May 92 p. 89
; UPLOADED BY: M. Shrout, CDOT R-4 Design (303) 350-2155 06/02/92
;
; MODIFIED BY / REASON / DATE:
;
; PRECONDITIONS, POSTCONDITIONS:
;
; SIDE EFFECTS / EXCEPTIONS: If any portion of an entity is outside of the
; selected window, that entity will be deleted (as in a "crossing"
; selection set).
;------------------------------------------------------------------------------
; The program
(defun c:DOUT (/ ss1 ss2 ss3)
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq picked nil)
(setq cntr1 0)
(setq cntr2 0)
(setq cntr3 0)
(setq cntr4 0)
(setq cntr6 0)
(setq ss3 (ssadd))
; Define selection set #1 (entities to be retained)
(while (not picked)
(prompt "\nWindow entities to be retained: ")(prin1)
(setq pt1 (getpoint "\nFirst window point: "))
(setq pt2 (getcorner pt1 "\nOpposite corner: "))
;
(setq ss1 (ssget "w" pt1 pt2))
(if (/= ss1 nil)
(progn
(prompt "\nWorking...")(prin1)
(setq ss1lng (sslength ss1))
(setq picked 0))
(progn
(prompt "\nERROR: No Entities Found - Select Again...")
(prin1))
)
)
; Find all layers in current drawing
(setq lyr (tblnext "layer" T))
(while (/= cntr3 nil)
(if (and (or (= (cdr (assoc 70 lyr)) 64)
(= (cdr (assoc 70 lyr)) 0)
)
(/= (minusp (cdr (assoc 62 lyr))) T)
)
(progn
(setq incrval (itoa cntr4))
(setq cntr4 (1+ cntr4))
(set (read (strcat "lyr" incrval)) (cons 8 (cdr (assoc 2 lyr))))
(setq lyr (tblnext "layer")))
(setq lyr (tblnext "layer"))
)
(cond
((= lyr nil)
(setq cntr3 nil))
)
)
; Build delection set #2 & #3 (of displayed entities)
(setq cntr5 (1- cntr4))
(setq cntr4 0)
(while (<= cntr4 cntr5)
(setq incrval (itoa cntr4))
(setq ss2 (ssget "x" (list (eval (read (strcat "lyr" incrval))))))
(if (/= ss2 nil)
(progn
(while (< cntr6 (sslength ss2))
(setq enty (ssname ss2 cntr6))
(setq ss3 (ssadd enty ss3))
(setq cntr6 (1+ cntr6))
)
)
)
(setq cntr4 (1+ cntr4))
(setq cntr6 0)
)
; Determine if entities exist in both selection sets (#2 & #3)
(setq ss2 (ssadd))
(while (< cntr2 (sslength ss3))
(setq entnm3 (ssname ss3 cntr2))
(if (not (ssmemb entnm3 ss1))
(progn
(setq ss2 (ssadd entnm3 ss2))
(setq cntr2 (1+ cntr2)))
(setq cntr2 (1+ cntr2))
)
)
; Delete all entities outside of defined window
(if (/= (sslength ss2) 0)
(progn
(command ".ERASE" ss2 "")
(prompt "\n\n")
(princ (sslength ss2)) (princ " entities found & DELETED...")
(prin1))
(progn
(prompt "\nNO entities found outside defined window...")
(prin1))
)
(setvar "CMDECHO" cmd)
(prin1)
)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP: Modify. Bookmark the permalink.

7 Responses to AutoLISP: Delete Outside of Window

  1. cihangir says:

    hello my dear, lisp is very nice but i need to delete outside of a polyline, and the polyline is not a rectangle. do you have this lisp ? thank you!

  2. cihangir says:

    you are so polite, and it is working awesome, this is more than a wordpress publishing, thank you!

  3. This is a fantastic add-on. Is there a way to exclude entities touching the polyline? My job requires me to delete thousands of circles inside certain polylines but NOT ones that touch/intersect the polyline selected. There must be a radius measurement check somewhere….

    • AutoCAD Tips says:

      Here is a routine that has multiple selection routines within it.
      I don’t know where i found this routine, but the author is Giles Chanteau
      These routines are for selecting only. So after it makes the selection set, you must delete the objects on your own.
      The option that you are looking for is SSOF

      ~enjoy

      ;;; Special_Selections -Gilles Chanteau- (gile)
      ;;; Some routines to create specific selection sets.
      ;;;===============================================================;;;
      ;; Select by layer
      (defun c:ssl (/ ss ent)
        (and
          (or
            (and
      	(setq ss (cadr (ssgetfirst)))
      	(= 1 (sslength ss))
      	(setq ent (ssname ss 0))
            )
            (and
      	(sssetfirst nil nil)
      	(setq ent (car (entsel)))
            )
          )
          (sssetfirst nil (ssget "_X" (list (assoc 8 (entget ent)))))
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;; Select by type of entity
      (defun c:sse (/ ss)
        (and
          (or
            (and
      	(setq ss (cadr (ssgetfirst)))
      	(= 1 (sslength ss))
      	(setq ent (ssname ss 0))
            )
            (and
      	(sssetfirst nil nil)
      	(setq ent (car (entsel)))
            )
          )
          (sssetfirst nil (ssget "_X" (list (assoc 0 (entget ent)))))
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;; Select by color
      (defun c:ssc (/ ent elst col)
        (and
          (or
            (and
      	(setq ss (cadr (ssgetfirst)))
      	(= 1 (sslength ss))
      	(setq ent (ssname ss 0))
            )
            (and
      	(sssetfirst nil nil)
      	(setq ent (car (entsel)))
            )
          )
          (setq elst (entget ent)
      	  col  (cond
      		 ((assoc 430 elst))
      		 ((assoc 420 elst))
      		 ((assoc 62 elst))
      		 (T (cons 62 256))
      	       )
          )
          (sssetfirst nil (ssget "_X" (list col)))
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;; Select by Line type
      (defun c:sstl (/ ent tl)
        (and
          (or
            (and
      	(setq ss (cadr (ssgetfirst)))
      	(= 1 (sslength ss))
      	(setq ent (ssname ss 0))
            )
            (and
      	(sssetfirst nil nil)
      	(setq ent (car (entsel)))
            )
          )
          (or	(setq tl (assoc 6 (entget ent)))
      	(setq tl (cons 6 "BYLAYER"))
          )
          (sssetfirst nil (ssget "_X" (list tl)))
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;; Select by attribute value
      (defun c:ssatt (/ doc att elst tag val name ss1 ss2)
        (vl-load-com)
        (and
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
          (setq att (car (nentsel "\nSelect the source attribute: ")))
          (setq att (vlax-ename->vla-object att))
          (= (vla-get-ObjectName att) "AcDbAttribute")
          (setq tag (vla-get-TagString att)
      	  val (vla-get-TextString att)
      	  blk (vla-ObjectIDToObject doc (vla-get-OwnerId att))
      	  name (if (vlax-property-available-p blk 'EffectiveName)
      		 (vla-get-EffectiveName blk)
      		 (vla-get-Name blk)
      	       )
      	  ss2 (ssadd)
          )
          (princ "\nSelect blocks or <All>: ")
          (or
            (ssget (list '(0 . "INSERT")
      		   '(66 . 1)
      		   (cons 2 (strcat name ",`*U*"))
      	     )
            )
            (ssget "_X"
      	     (list '(0 . "INSERT")
      		   '(66 . 1)
      		   (cons 2 (strcat name ",`*U*"))
      	     )
            )
          )
          (vlax-for blk (setq ss1 (vla-get-ActiveSelectionSet doc))
            (if (= name
      	     (if (vlax-property-available-p blk 'EffectiveName)
      	       (vla-get-EffectiveName blk)
      	       (vla-get-Name blk)
      	     )
      	  )
      	(foreach a (vlax-invoke blk 'GetAttributes)
      	  (if (and (= (vla-get-TagString a) tag)
      		   (= (vla-get-TextString a) val)
      	      )
      	    (ssadd (vlax-vla-object->ename blk) ss2)
      	    T
      	  )
      	)
      	T
            )
          )
          (not (vla-delete ss1))
          (sssetfirst nil ss2)
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;; SSCU (gile) 31/03/07
      ;; Selection by mutiple target window or capture
      ;; The window frame is parallel to the plane of the current UCS
      ;; The selection is completed by Enter, Space or right-click
      
      (defun c:sscu (/ sel sst loop p1 gr p2 p3 p4 po ss n ent)
      
        (defun ssd_err (msg)
          (if	(= msg "function canceled")
            (princ)
            (princ (strcat "\nError: " msg))
          )
          (sssetfirst nil nil)
          (redraw)
          (setq *error* m:err
      	  m:err	nil
          )
          (princ)
        )
      
        ;; Returns a selection set, point, or nil
        (defun sel (/ loop gr pt)
          (setq loop T)
          (while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
            (cond
      	((= (car gr) 5)
      	 (setq pt (cadr gr))
      	)
      	((or (member gr '((2 13) (2 32)))
      	     (or (= (car gr) 11) (= (car gr) 25))
      	 )
      	 (setq loop nil
      	       pt   nil
      	 )
      	)
            )
          )
          (if	pt
            (cond
      	((ssget pt))
      	(pt)
            )
          )
        )
      
        (setq	m:err	*error*
      	*error*	ssu_err
        )
        (sssetfirst nil nil)
        (setq sst (ssadd))
        (while (and
      	   (princ "\nSelect Objects: ")
      	   (setq p1 (sel))
      	 )
          (if	(listp p1)
            (progn
      	(princ "\nSpecify opposite corner: ")
      	(setq p1 (list (car p1) (cadr p1)))
      	(while (and (setq gr (grread T 12 0)) (/= (car gr) 3))
      	  (if (= 5 (car gr))
      	    (progn
      	      (redraw)
      	      (setq p2 (list (caadr gr) (cadr p1))
      		    p3 (list (caadr gr) (cadadr gr))
      		    p4 (list (car p1) (cadadr gr))
      	      )
      	      (if (< (car p1) (car p2))
      		(progn
      		  (setq po "_WP")
      		  (grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1)
      		  )
      		)
      		(progn
      		  (setq po "_CP")
      		  (grvecs
      		    (list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)
      		  )
      		)
      	      )
      	    )
      	  )
      	)
      	(redraw)
      	(if (setq ss (ssget po (list p1 p2 p3 p4)))
      	  (repeat (setq n (sslength ss))
      	    (setq ent (ssname ss (setq n (1- n))))
      	    (if	(not (ssmemb ent sst))
      	      (ssadd ent sst)
      	    )
      	    (sssetfirst nil sst)
      	  )
      	)
            )
            (progn
      	(ssadd (ssname p1 0) sst)
      	(sssetfirst nil sst)
            )
          )
        )
        (sssetfirst nil sst)
        (setq	*error*	m:err
      	m:err nil
        )
        (princ)
      )
      
      ;;;===============================================================;;;
      
      ;;; SelByObj -Gilles Chanteau- 06/10/06
      ;;; Creates a selection set with all objects or 
      ;;; captured in the current view, by the selected object
      ;;; (circle, ellipse, polyline closed).
      ;;; Arguments :
      ;;; - an entity name (ename) 
      ;;; - a user selection (Cp or Wp)
      ;;; - a selection filter or nil
      ;;;
      ;;; modifié le 19/07/07 : works with objects outside the window
      
      (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
          )
        )
      )
      
      ;;;===============================================================;;;
      
      ;;; SSOC to select all objects captured following
      ;;; view, by the circle, ellipse, or polyline.
      
      (defun c:ssoc (/ 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)
      )
      
      ;;;===============================================================;;;
      
      ;;; SSOF to select all objects, according
      ;;; view, in the circle, ellipse, or polyline.
      
      (defun c:ssof (/ 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)
      )
      
      ;;;===============================================================;;;
      
      ;;; Inv_sel Inverse of the current selection set.
      
      (defun c:inv_sel (/ ssa ssf n)
        (setq
          ssa	(ssget "_A"
      	       (list '(0 . "~VIEWPORT") (cons 410 (getvar "ctab")))
      	)
        )
        (if (setq ssf (cadr (ssgetfirst)))
          (repeat (setq n (sslength ssf))
            (ssdel (ssname ssf (setq n (1- n))) ssa)
          )
        )
        (sssetfirst)
        (sssetfirst nil ssa)
      )
      
      ;;;===============================================================;;;
      
      ;;; SSD version 2.6 (gile) 14/07/08 (dernière révision 17/11/2011)
      ;;; Selection of dynamic blocks by dynamic parameter values
      ;;;
      ;;; applications :
      ;;; - To create a selection set, enter SSD, select a source block
      ;;;   then choose to filter the values ??in the dialog.
      ;;; - Inside of a change order, at the prompt "Select objects: "
      ;;;   enter (SSD).
      ;;; The filter can be done on any drawing or within a selection
      
      (defun ssd (/ *error* ToString DynBlkPropValue dz ss ent blk name pop fuzz ret sel res)
      
        (vl-load-com)
        (or *acad* (setq *acad* (vlax-get-acad-object)))
        (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
      
        (defun *error* (msg)
          (if	(/= msg "Function canceled")
            (princ (strcat "Erreur: " msg))
          )
          (and blk (not (redraw (vlax-vla-object->ename blk) 4)))
          (setvar 'dimzin dz)
          (princ)
        )
      
        (defun ToString (v u)
          (cond
            ((= 0 u) (vl-princ-to-string v))
            ((= 1 u) (angtos v (getvar 'aunits) 16))
            ((if (< (abs v) 1e-6)
      	 (rtos v 1 6)
      	 (rtos v (getvar 'lunits) 12)
             )
            )
          )
        )
      
        ;; DynBlkPropValue
        ;; Dialog box to choose values ??of dynamic parameters
        ;;
        ;; Argument : the list of dynamic parameters
      
        (defun DynBlkPropValue (lst / tmp file pn unt av dcl_id val)
          (setq tmp  (vl-filename-mktemp "Tmp.dcl")
      	  file (open tmp "w")
          )
          (write-line
            (strcat
      	"DynBlkProps:dialog{label=\"Filter Dynamic Blocks\";"
      	":text{label=\"Nom du bloc : \""
      	(vl-prin1-to-string name)
      	";}spacer;:boxed_column{label=\"dynamic properties\";"
            )
            file
          )
          (foreach p lst
            (setq pn	(vla-get-PropertyName p)
      	    unt	(vla-get-UnitsType p)
            )
            (cond
      	((setq av (vlax-get p 'AllowedValues))
      	 (setq av  (mapcar '(lambda (x) (ToString x unt)) av)
      	       pop (cons (vl-list* pn "*" av) pop)
      	 )
      	 (write-line
      	   (strcat
      	     ":popup_list{label="
      	     (vl-prin1-to-string pn)
      	     ";key="
      	     (vl-prin1-to-string pn)
      	     ";value="
      	     (itoa (1+ (vl-position (ToString (vlax-get p 'Value) unt) av)))
      	     ";edit_width=25;allow_accept=true;}"
      	   )
      	   file
      	 )
      	)
      	((/= pn "Origin")
      	 (setq fuzz (cons pn fuzz))
      	 (write-line
      	   (strcat
      	     ":row{:edit_box{label="
      	     (vl-prin1-to-string pn)
      	     ";key="
      	     (vl-prin1-to-string pn)
      	     ";value="
      	     (vl-prin1-to-string (ToString (vlax-get p 'Value) unt))
      	     ";edit_width=18;allow_accept=true;}"
      	     ":edit_box{label=\"Tolérance\";key="
      	     (vl-prin1-to-string (strcat pn "_fuzz"))
      	     ";value=\"1e-12\";edit_width=6;allow_accept=true;}}"
      	   )
      	   file
      	 )
      	)
            )
          )
          (write-line
            (strcat
      	"}spacer;:radio_row{key=\"selset\";"
      	":radio_button{label=\"The entire drawing\";key=\"all\";value=\"1\";}"
      	":radio_button{label=\"Selection\";key=\"sel\";}}"
      	"spacer;ok_cancel;}"
            )
            file
          )
          (close file)
          (setq dcl_id (load_dialog tmp))
          (if	(not (new_dialog "DynBlkProps" dcl_id))
            (exit)
          )
          (foreach p pop
            (start_list (car p))
            (mapcar 'add_list (cdr p))
            (end_list)
          )
          (action_tile
            "accept"
            "(foreach p (mapcar 'vla-get-PropertyName lst)
            (if (assoc p pop)
            (setq val (nth (atoi (get_tile p)) (cdr (assoc p pop))))
            (setq val (get_tile p)))
            (if (and val (/= val \"\") (/= val \"*\"))
            (setq ret (cons (cons p val) ret))))
            (setq fuzz (mapcar (function (lambda (x)
            (cons x (get_tile (strcat x \"_fuzz\"))))) fuzz))
            (and (not ret) (setq ret T))
            (setq sel (get_tile \"selset\"))
            (done_dialog)"
          )
          (action_tile "cancel" "(setq ret nil)")
          (start_dialog)
          (unload_dialog dcl_id)
          (vl-file-delete tmp)
          ret
        )
      
        ;;----------------------------------------------------;;
      
        (setq dz (getvar 'dimzin))
        (setvar 'dimzin 8)
        (and
          (or
            (and
      	(setq ss (cadr (ssgetfirst)))
      	(= 1 (sslength ss))
      	(setq ent (ssname ss 0))
      	(sssetfirst nil nil)
            )
            (and
      	(sssetfirst nil nil)
      	(setq ent (car (entsel)))
            )
          )
          (setq blk (vlax-ename->vla-object ent))
          (= (vla-get-ObjectName blk) "AcDbBlockReference")
          (= (vla-get-IsDynamicBlock blk) :vlax-true)
          (not (redraw ent 3))
          (setq name (vla-get-EffectiveName blk))
          (or
            (DynBlkPropValue (vlax-invoke blk 'getDynamicBlockProperties))
            (redraw ent 4)
          )
          (not (redraw ent 4))
          (if	(= sel "all")
            (ssget "_X"
      	     (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
            )
            (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
            )
          )
          (setq res (ssadd))
          (vlax-for b	(setq ss (vla-get-ActiveSelectionSet *acdoc*))
            (if
      	(and
      	  (= (vla-get-EffectiveName b) name)
      	  (or
      	    (= ret T)
      	    ((lambda (lst)
      	       (apply
      		 '=
      		 (cons
      		   T
      		   (mapcar
      		     (function
      		       (lambda (p / n v l u f)
      			 (setq n (car p)
      			       l (assoc n lst)
      			       u (vla-get-UnitsType (caddr l))
      			 )
      			 (equal	(cond
      				  ((= 0 u) (cdr p))
      				  ((= 1 u) (angtof (cdr p)))
      				  (T (distof (cdr p)))
      				)
      				(if (= u 0)
      				  (vl-princ-to-string (cadr l))
      				  (cadr l)
      				)
      				(if (and (setq f (cdr (assoc n fuzz)))
      					 (numberp (read f))
      				    )
      				  (atof f)
      				  1e-12
      				)
      			 )
      		       )
      		     )
      		     ret
      		   )
      		 )
      	       )
      	     )
      	      (mapcar
      		(function
      		  (lambda (p / n v)
      		    (list
      		      (setq n (vla-get-PropertyName p))
      		      (vlax-get p 'Value)
      		      p
      		    )
      		  )
      		)
      		(vlax-invoke b 'getDynamicBlockProperties)
      	      )
      	    )
      	  )
      	)
      	 (ssadd (vlax-vla-object->ename b) res)
            )
          )
          (vla-delete ss)
        )
        (setvar 'dimzin dz)
        res
      )
      
      (defun c:ssd ()
        (sssetfirst nil (ssd))
        (princ)
      )
  4. Pete Busciglio says:

    How do I use this Lisp in AutoCAD Civil 3D? I’ve loaded it successfully under applications, but in the past I would type in the name of the lisp (DOUT) and it would work. What am I doing wrong?

  5. chuzzle says:

    Thank you for you post.
    The routine is so awesome.
    Could you please modify this to just delete objects that are completely outside of the window selection (not just the objects touching or crossing the window).
    Many thanks.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s