halam Posted May 8, 2018 Share Posted May 8, 2018 Hi, I'm trying to get some code working. The idea is based upon the subtract function Gilles Chanteau wrote. Only with a twist to make this happen for union. This way you can keep the primitives at the same time. http://gilecad.azurewebsites.net/LISP/Soustrac.lsp MY CODE SOFAR ;; based on SOUSTRAC (gile) ;; translated, please visit [url]http://gilecad.azurewebsites.net/LISP/[/url] ;; Performs union regions or 3D solids without making union ;; Proposes to delete or keep the removed items (defun c:uni (/ *error* ss1 ss2 n lst) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object))) ) ;;;(command "vscurrent" "2Dwireframe") ;;;(setvar "NAVVCUBEDISPLAY" 3) (defun *error* (msg) (and msg (/= msg "function canceled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark *acdoc*) (princ) ) (princ "\nSelect solids and regions to remove .." ) (if (setq ss1 (ssget '((0 . "REGION,3DSOLID")))) (if (and (princ "\nSelect solids and regions to subtract .." ) (setq ss2 (ssget '((0 . "REGION,3DSOLID")))) ) (progn (vla-StartUndoMark *acdoc*) (repeat (setq n (sslength ss2)) (setq lst (cons (vlax-ename->vla-object (ssname ss2 (setq n (1- n)))) lst ) ) ) (foreach o lst (and (= (vla-get-ObjectName obj) (vla-get-ObjectName o)) (vla-Boolean obj acUnion (vla-copy o)) ) ) (repeat (setq n (sslength ss1)) (setq obj (vlax-ename->vla-object (ssname ss1 (setq n (1- n)))) ) (foreach o lst (and (= (vla-get-ObjectName obj) (vla-get-ObjectName o)) ; I NEED A COPY OF BOTH SS1 AND SS2 (vla-Boolean obj acUnion (vla-copy o)) ) ) ) (initget "Yes No") (if (= "Yes" (getkword "\nDelete United objects [Yes / No] <N>: ")) (mapcar 'vla-delete lst) ) (*error* nil) ) ) ) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.