AutoLISP: Closed Objects to Wipeout updated

It has been a while since using this LISP routine, but apparently the routine that was posted a couple of years ago (found here: http://autocadtips.wordpress.com/2011/05/28/autolisp-objects-2-wipeout/) and written by Giles Chanteau stopped working in newer releases of AutoCAD because it now needs to call upon a different .ARX file (AutoCAD Runtime eXtension).

OB2WO 3

The LISP routine creates a wipeout object from selecting a closed object. This might not seem like a big deal since you can do the same thing with the WIPEOUT command, but this routine lets you select closed curved objects with the exception of SPLINE objects.

Here’s how:

  • Load the code below
  • Use OB2WO <enter> in the command line to start.
  • Select  a closed object whose shape from which you would like to create a wipeout (Circle, Ellipse, Closed Polyline with or without arc segments).

OB2WO 4

  • After selecting the object, you are asked if the object that you selected should be erased after the wipeout is created. By default, “No” is selected and the object will remain and the wipeout that is created is placed on the current layer. so make sure that the layer you want it on is set current,
Hatch with various shapes covering the hatch

Hatch with various shapes covering the hatch

The above picture shows a Hatched area with some curved closed shapes.

Shown below, The wipeouts have been created and the original selected object remains.

OB2WO 2

 

Thanks to Giles Chanteau for his routines and for his presence on the various forums always willing to ask and answer question in a pleasant manner, Thanks again Giles

~Greg


;;; 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
;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/wipeout-with-arcs/m-p/786490#M12148

(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)
  (if (not (member "acismui.arx" (arx)))
    (arxload "acismui.arx")
  )
  (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: Creating, AutoLISP: Modify, AutoLISP: Polylines, Wipeouts. Bookmark the permalink.

5 Responses to AutoLISP: Closed Objects to Wipeout updated

  1. Bill Jackson says:

    Need this, but can’t get to work in AC2014?

  2. Mike J says:

    Tried it in Civil 3d 2012 Sp4 and it didn’t work. It seemed to execute properly, but no wipeout.

    It’s possible to use other means to create a close polyline, such as c2gon.lsp then use just use polygon option from the wipeout command.

    http://www.turvill.com/t2/free_stuff/

  3. Phan says:

    Thanks a lot

  4. Gouhar Nayab says:

    Hi,

    Ina AutoCAD 2015 the routine comes up with following errror

    Command: OB2WO
    Select object: ; error: no function definition: VLAX-ENAME->VLA-OBJECT
    Command:

    Please help

    Thanks you,

    Best Regards,

    Gouhar

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