Hole Punch

[Jason Rhymes]

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

 

[Jim Claypool]

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

 

[Jeff Mishler]

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

 

[Jason Rhymes]

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