AutoLISP: Objects 2 Wipeout

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 these ads

About AutoCAD Tips

I work for a large engineering firm and perform various CAD Administration duties and. I enjoy teaching/tutoring people in AutoCAD and seeing them enjoy using the program as much as I do. I hope that you find this blog a useful tool.
This entry was posted in AutoLISP, Modifying, TIPS, Wipeouts. Bookmark the permalink.

25 Responses to AutoLISP: Objects 2 Wipeout

  1. Julio Alvarado says:

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

  2. karthick says:

    how to enter text in polygon

    • AutoCAD Tips says:

      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

  3. Gouhar Nayab says:

    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

    • AutoCAD Tips says:

      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

      • Gouhar Nayab says:

        Hi,
        Thanks for update error is gone but, not making wipe out.
        Delete original works fine
        Thank you,
        Gouhar

  4. Vladimir says:

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

  5. angie says:

    I LOVE YOU

  6. EM says:

    This routine worked beautifully. Thank you.

  7. Alex says:

    Dude you rock

  8. Marcos says:

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

  9. Marcos says:

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

  10. Pingback: AutoLISP: Closed Objects to Wipeout updated | AutoCAD Tips

  11. Carthik Babu says:

    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

  12. Gouhar Nayab says:

    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:

      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)
      	   )
        )
      )
      

  13. Gouhar Nayab says:

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

  14. Gouhar Nayab says:

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

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