AutoLISP: Objects 2 Wipeout

Posted on May 28, 2011 by AutoCAD Tips

If you’ve ever used wipeouts in order to mask something in your drawing, you already know that you cant used curved objects. This great routine allows you to select an existing object that is curved and turn it into a wipeout. It also gives you an option to erase the existing object after it makes the wipeout. It will work on olylines, circles and ellipses.

OB2WO <enter> to start
Select object to turn into wipeout (Circle, Ellipse, Polyline)
select “Yes” or “No” to erase the existing object


;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs)
;;; Works whatever the current ucs and object OCS

(defun c:ob2wo (/ ent lst nor)
  (vl-load-com)
  (if (and (setq ent (car (entsel)))
	   (member (cdr (assoc 0 (entget ent)))
		   '("CIRCLE" "ELLIPSE" "LWPOLYLINE")
	   )
	   (setq lst (ent2ptlst ent))
	   (setq nor (cdr (assoc 210 (entget ent))))
      )
    (progn
      (vla-StartundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
      (makeWipeout lst nor)
      (initget "Yes No")
      (if
	(= (getkword "\nDelete source object? [Yes/No] <No>: ")
	   "Yes"
	)
	 (entdel ent)
      )
      (vla-EndundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
    )
  )
)


;;; ENT2PTLST
;;; Returns the vertices list of the polygon figuring the curve object
;;; Coordinates defined in OCS

(defun ent2ptlst (ent / obj dist n lst p_lst prec)
  (vl-load-com)
  (if (= (type ent) 'ENAME)
    (setq obj (vlax-ename->vla-object ent))
  )
  (cond
    ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
     (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
	      (vlax-get obj 'Normal)
	    )
	    lst
	  )
       )
     )
    )
    (T
     (setq p_lst (vl-remove-if-not
		   '(lambda (x)
		      (or (= (car x) 10)
			  (= (car x) 42)
		      )
		    )
		   (entget ent)
		 )
     )
     (while p_lst
       (setq
	 lst
	  (cons
	    (append (cdr (assoc 10 p_lst))
		    (list (cdr (assoc 38 (entget ent))))
	    )
	    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
		       ent
		     )
		     lst
		   )
	     )
	   )
	 )
       )
       (setq p_lst (cddr p_lst))
     )
    )
  )
  lst
)


;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object

(defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)

  (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
		    (apply 'min (mapcar 'cadr pt_lst))
		    (caddar pt_lst)
	      )
  )
  (setq
    max_dist
     (float
       (apply 'max
	      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
       )
     )
  )
  (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
  (setq
    dxf14 (mapcar
	    '(lambda (p)
	       (mapcar '/
		       (mapcar '- p cen)
		       (list max_dist (- max_dist) 1.0)
	       )
	     )
	    pt_lst
	  )
  )
  (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
  (entmake (append (list '(0 . "WIPEOUT")
			 '(100 . "AcDbEntity")
			 '(100 . "AcDbWipeout")
			 '(90 . 0)
			 (cons 10 (trans dxf10 nor 0))
			 (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
			 (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
			 '(13 1.0 1.0 0.0)
			 '(70 . 7)
			 '(280 . 1)
			 '(71 . 2)
			 (cons 91 (length dxf14))
		   )
		   (mapcar '(lambda (p) (cons 14 p)) dxf14)
	   )
  )
)

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.

View all posts by AutoCAD Tips →

This entry was posted in AutoLISP, Modifying, TIPS, Wipeouts. Bookmark the permalink.

30 Responses to AutoLISP: Objects 2 Wipeout

Julio Alvarado says:

May 31, 2011 at 2:51 AM

I´ve been looking for this a very long time, many thanks save me a lot of work, excellent lisp, congratulations

Reply
karthick says:

August 5, 2011 at 4:27 AM

how to enter text in polygon

Reply
- AutoCAD Tips says:
  
  August 5, 2011 at 2:11 PM
  
  Can you please clarify this question?
  Do you mean how to make text fit inside of a polygon shape? or have the text align itself with the shape of a polygon? or do you mean something else?
  Thanks
  
  Reply
Gouhar Nayab says:

April 30, 2012 at 12:59 AM

Works like a charm till autocad 2012, Error message in 2013

Command:
CIRCLE

Specify center point for circle or [3P/2P/Ttr (tan tan radius)]: *Cancel*

Command: *Cancel*

Command: *Cancel*

Command: OB2wo

Select object: ; error: ARXLOAD failed

Thank you,

Gouhar

Reply
- AutoCAD Tips says:
  
  April 30, 2012 at 7:27 AM
  
  Thanks for the heads up. I have updated the code. It had a “call” to load an .arx that wasn’t really needed. Please recopy the code.
  enjoy
  ~Greg
  
  Reply
  - Gouhar Nayab says:
    
    April 30, 2012 at 10:57 AM
    
    Hi,
    Thanks for update error is gone but, not making wipe out.
    Delete original works fine
    Thank you,
    Gouhar
Vladimir says:

August 21, 2012 at 11:17 PM

Just call wipeout command once before using ob2wo to load it.

Reply
angie says:

February 13, 2013 at 4:35 PM

I LOVE YOU

Reply
EM says:

February 22, 2013 at 9:40 AM

This routine worked beautifully. Thank you.

Reply
Alex says:

October 10, 2013 at 5:34 PM

Dude you rock

Reply
Marcos says:

January 23, 2014 at 12:51 PM

Why? Why? Why?
Command: APPLOAD
Unable to load ob2wo.LSP file.
Command: ; error: File load canceled:

Reply
Marcos says:

January 23, 2014 at 1:30 PM

Please Help me… I really need it in my files!
I used in AutoCAD 2014.

Reply
- AutoCAD Tips says:
  
  January 25, 2014 at 8:55 PM
  
  Marcos, Please see my newest post. I pointed the routine to the newly needed ARX file and it is working on my end pretty well.
  
  http://wp.me/p1aURt-xR
  I can test in 2014 tomorrow and see if it works there as well
  ~Greg
  
  -UPDATE- It works in 2014 as well
  ~Greg
  
  Reply
  - Patricia Webb says:
    
    January 26, 2014 at 6:04 AM
    
    I have acade 2014 and, I use the same lisp but with a change. I have if you need it.
  - AutoCAD Tips says:
    
    January 26, 2014 at 6:43 AM
    
    If you don’t mind sending it that would be awesome. I am always willing to try something especially if it is improved.
    ~Greg greg.battin@gmail.com
  - Patricia Webb says:
    
    January 26, 2014 at 6:51 AM
    
    Ok!! I will send it tomorrow. :)
- Patricia Webb says:
  
  January 26, 2014 at 5:59 AM
  
  What do you need? I can use it perfectly.
  
  Reply
Pingback: AutoLISP: Closed Objects to Wipeout updated | AutoCAD Tips
Carthik Babu says:

April 2, 2014 at 12:48 AM

great code…..i converted arc and line by using pedit and used your code to wipeout the polyline…..it worked and removed the barrier in normal wipeout option……thanks a lot for uploading this code

Reply
- AutoCAD Tips says:
  
  April 2, 2014 at 6:15 AM
  
  All credit goes to Gilles Chanteau. Glad it helped
  
  Reply

Gouhar Nayab says:

April 7, 2014 at 5:36 AM

Do not work in AutoCAD 2015. It his very helpful in my daily works. Please update.
No Error but no wipeouts either
Best Regards,

Gouhar

AutoCAD Tips says:

April 7, 2014 at 6:33 AM

I tried the below in 2015 on a polyline with arcs and it works



;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs)
;;; Works whatever the current ucs and object OCS

(defun c:ob2wo (/ ent lst nor)
  (vl-load-com)
  (if (and (setq ent (car (entsel)))
	   (member (cdr (assoc 0 (entget ent)))
		   '("CIRCLE" "ELLIPSE" "LWPOLYLINE")
	   )
	   (setq lst (ent2ptlst ent))
	   (setq nor (cdr (assoc 210 (entget ent))))
      )
    (progn
      (vla-StartundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
      (makeWipeout lst nor)
      (initget "Yes No")
      (if
	(= (getkword "\nDelete source object? [Yes/No] <No>: ")
	   "Yes"
	)
	 (entdel ent)
      )
      (vla-EndundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
    )
  )
)


;;; ENT2PTLST
;;; Returns the vertices list of the polygon figuring the curve object
;;; Coordinates defined in OCS

(defun ent2ptlst (ent / obj dist n lst p_lst prec)
  (vl-load-com)
  (if (= (type ent) 'ENAME)
    (setq obj (vlax-ename->vla-object ent))
  )
  (cond
    ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
     (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
	      (vlax-get obj 'Normal)
	    )
	    lst
	  )
       )
     )
    )
    (T
     (setq p_lst (vl-remove-if-not
		   '(lambda (x)
		      (or (= (car x) 10)
			  (= (car x) 42)
		      )
		    )
		   (entget ent)
		 )
     )
     (while p_lst
       (setq
	 lst
	  (cons
	    (append (cdr (assoc 10 p_lst))
		    (list (cdr (assoc 38 (entget ent))))
	    )
	    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
		       ent
		     )
		     lst
		   )
	     )
	   )
	 )
       )
       (setq p_lst (cddr p_lst))
     )
    )
  )
  lst
)


;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object

(defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)

  (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
		    (apply 'min (mapcar 'cadr pt_lst))
		    (caddar pt_lst)
	      )
  )
  (setq
    max_dist
     (float
       (apply 'max
	      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
       )
     )
  )
  (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
  (setq
    dxf14 (mapcar
	    '(lambda (p)
	       (mapcar '/
		       (mapcar '- p cen)
		       (list max_dist (- max_dist) 1.0)
	       )
	     )
	    pt_lst
	  )
  )
  (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
  (entmake (append (list '(0 . "WIPEOUT")
			 '(100 . "AcDbEntity")
			 '(100 . "AcDbWipeout")
			 '(90 . 0)
			 (cons 10 (trans dxf10 nor 0))
			 (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
			 (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
			 '(13 1.0 1.0 0.0)
			 '(70 . 7)
			 '(280 . 1)
			 '(71 . 2)
			 (cons 91 (length dxf14))
		   )
		   (mapcar '(lambda (p) (cons 14 p)) dxf14)
	   )
  )
)

Gouhar NayabNayab says:

April 7, 2014 at 12:01 PM

it works fine at my home will try in office tomorrow
Thank you for your quick reply

Best regards

Gouhar Nayab

Gouhar Nayab says:

April 7, 2014 at 5:47 AM

error: no function definition: VLAX-ENAME->VLA-OBJECT in 2014

Reply
Gouhar Nayab says:

April 8, 2014 at 1:17 AM

error: no function definition: VLAX-ENAME->VLA-OBJECT in 2015

Reply
Mohd Ashraf Ashaari says:

May 27, 2015 at 8:56 PM

Hi Greg,
Nice work & excellent lisp routine you got here. Really helps me & my colleague a lot! Being looking for such routine for a long time and i only found it now. By the way, knowing that AutoCAD LT does not support Lisp, any chance to apply such routine in LT? Macro perhaps? Many thanks for your help!

Reply
- AutoCAD Tips says:
  
  May 28, 2015 at 8:02 PM
  
  My default answer when I here that people are using AutoCAD LT is to not use it and save your money and buy an AutoCAD clone at a lower cost that lets you use lisp and extract attributes ect. AutoCAD LT is not worth the savings. But if you are stuck using it, there is a separate add-on that lets you use LISP at http://www.cadsta.com/CADSTA-Tools-Appload.html
  Other than that I don’t know how to go about making a wipeout without the express tools or LISP
  
  You might try adding a text object that consists of nothing but spaces and then adding a “background mask” to it
  
  Reply
Danny says:

July 22, 2015 at 3:05 PM

This is a wonderful routine, but suppose a drawing has several different wipeouts and you wish to maintain individual control (ie you want boundaries to be shown here but not there) is there a way to accomplish this? The only command I know is TFRAMES but this only toggles boundaries on and off for all the wipeouts in the drawing, there’s no way to target them one by one… thanks for any help

Reply
Akmal says:

February 1, 2016 at 3:03 AM

how to make wipeout boundaries/frames to appear but not plotted ?

Reply
Shoukath says:

March 21, 2020 at 12:10 AM

Tks. really helpful…

Reply