Hole Punch

Does anyone know of a lisp that will do something like this macro?

^C^Cregion;\;extrude;last;;100000;;-group;;sub;;last;;copy;last;;0,0;0,0,-10
0000;union;last;group;sub;;-group;explode;sub;-group;create;sub;;last;;subtr
act;\;g;sub;;-group;explode;sub;

It's a punch tool that I wrote to punch a closed pline or circle through a
solid. It works great except there is no error handling and if you escape in
the middle of the command you have to manually delete the group "sub" are it
will not work again. Try it and see what it does.
Thanks,
Jason Rhymes

 

This should do it

(defun cunch ( / ename ename1)
(setq notok 1)
(while notok
(while (not (setq ename (entsel "\nSelect Solid: "))))
(setq ename1 (car ename))
(if (/= (cdr (assoc 0 (entget ename1))) "3DSOLID")
(alert "Object selected is no a solid")
(setq notok nil)
)
)
(setq notok 1)
(while notok
(while (not (setq ename (entsel "\nSelect object to remove: "))))
(setq ename (car ename))
(if
(and
(/= (cdr (assoc 0 (entget ename))) "CIRCLE")
(/= (cdr (assoc 0 (entget ename))) "POLYLINE")
(/= (cdr (assoc 0 (entget ename))) "LWPOLYLINE")
)
(alert "Object selected must be a circle or closed polyline")
(setq notok nil)
)
)
(command
".region" ename ""
".extrude" (entlast) "" "100000" ""
)
(setq ename (entlast))
(command
".copy" ename "" "0,0" "0,0,-100000"
".union" ename "l" ""
)
(command ".subtract" ename1 "" ename "")
(princ)
)

 

Here's my contribution, using strictly ActiveX functions rather than command
calls.

Jeff

(defun c:holepunch (/ ss_solid solid ss_punch
punch space solid1 solid2
new_solid new_region
)
(if (and
(princ "\nSelect Solid you wish to punch: ")
(setq ss_solid (ssget ":S" '((0 . "3DSOLID"))))
(setq solid (vlax-ename->vla-object (ssname ss_solid 0)))
(princ "\nSelect Circle or Closed Polyline to punch with: ")
(setq ss_punch (ssget ":S" '((0 . "CIRCLE,LWPOLYLINE"))))
(setq punch (vlax-ename->vla-object (ssname ss_punch 0)))
(if (vlax-property-available-p punch 'closed)
(= (vla-get-closed punch) :vlax-true)
t
)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
)
(progn
(setq space (if (= 1 (vla-get-activespace doc))
(vla-get-modelspace doc) ;we're in modelspace
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc) ;we're in modelspace
;thru paperspace VPort
(vla-get-paperspace doc) ;we're in paperspace
)
)
)
(vla-startundomark doc)
(setq new_region (vlax-invoke-method
space
'addregion
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 0)
)
(list punch)
)
)
new_region (car (vlax-safearray->list
(vlax-variant-value new_region)
)
)
solid1 (vlax-invoke-method
space 'addextrudedsolid new_region 100000.0 0)
solid2 (vlax-invoke-method
space 'addextrudedsolid new_region -100000.0 0)
)
(vlax-invoke-method solid1 'boolean acunion solid2)
(vlax-invoke-method solid 'boolean acsubtraction solid1)
(vla-delete new_region)
(vla-delete punch)
(vla-endundomark doc)
)
(princ "\nInvalid object(s) selected, try again...")
)
(princ)
) ;defun

 

They both work great! Thank you very much. How you guys come up with this so
fast amazes me. Again, Thank you.
Jason