;; SOUSTRAC (gile)
;; Effectue une soustraction de régions ou solides 3d sans faire d'union
;; La variable DELSUB détermine si les objets soustraits sont conservés ou supprimés
;; 0 : les objets sont conservés
;; 1 : les objets sont supprimés

(defun c:soustrac (/ ss1 ss2 n lst)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object)))
  )
  (or (getenv "DelSubtracted") (setenv "DelSubtracted" "1"))
  (princ (strcat "\nParamètre courant : DELSUB = "
		 (getenv "DelSubtracted")
		 "\n"
	 )
  )
  (princ
    " Sélectionnez les solides et les régions à enlever de .."
  )
  (if
    (setq ss1 (ssget '((0 . "REGION,3DSOLID"))))
     (if (and
	   (princ
	     "Sélectionnez les solides et les régions à soustraire .."
	   )
	   (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
	      )
	   )
	 )
	 (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))
		  (vla-Boolean obj acSubtraction (vla-copy o))
	     )
	   )
	 )
	 (and (= "1" (getenv "DelSubtracted"))
	      (mapcar 'vla-delete lst)
	 )
	 (vla-EndUndoMark *acdoc*)
       )
     )
  )
  (princ)
)

(defun c:delsub	(/ r)
  (or (getenv "DelSubtracted") (setenv "DelSubtracted" "1"))
  (while
    (not
      (member
	(setq r	(getstring
		  (strcat "\nEntrez une nouvelle valeur pour DELSUB <"
			  (getenv "DelSubtracted")
			  ">: "
		  )
		)
	)
	'("" "0" "1")
      )
    )
     (princ "\nNécessite seulement 1 ou 0")
  )
  (or (= r "") (setenv "DelSubtracted" r))
  (princ)
)