; XClipM.lsp allows user to select supported objects to Clip using multiple boundaries
; Current supported objects are:
; Block Insert, External Reference, Image, DGN, DWF, PDF
; Creating a donut hole clip is not supported
; written by: Paul Li - 12/02/2010
; updated on 3/19/2014 to support multiple objects to clip
; Note: circle shaped pline boundaries are not supported
(princ"\nLoading XclipM...")(princ)
(defun c:xclipm
 (/ cmdecho count count1 emax emax1 en ChkClpBnd menuecho obxr obdxr obdxrtype obxrcopy ss ss1 xclipm_err xclipm_olderr) ; declare locally
 (defun xclipm_err (msg)  ; define own error function
   (if (not (member msg '("console break" "Function cancelled" "quit / exit abort" ""))) ; if function not cancelled by user
       (princ (strcat "\nError: " msg)) ; then show error message
   ) ; if 
   (setvar "cmdecho" cmdecho)   ; restore command echo
   (setvar "menuecho" menuecho) 
   (princ) 
 ) ; defun 
;end error function  
 (defun ChkClpBnd (ename / Data Dict tempDict)
   ; Check if object has existing clipping boundry
    (if
      (and
       (setq Data (entget ename))
       (setq Dict (cdr (assoc 360 Data)))
       (setq tempDict (dictsearch Dict "ACAD_FILTER"))
       (setq tempDict (dictsearch (cdr (assoc -1 tempDict)) "SPATIAL"))
      )
      (cons '(0 . "SPATIAL_FILTER") (member (assoc 100 tempDict) tempDict)) ; return object if existing clipping boundary found
    )
 ) ; ChkClpBnd
 (setq xclipm_olderr  *error*        ; Save error routine
         *error* xclipm_err           ; Substitute ours
 )
 (setq cmdecho (getvar"cmdecho"))    ; save command echos
 (setq menuecho (getvar"menuecho"))
 (setvar"cmdecho"0)(setvar"menuecho"0) ; turn off command echos
 (princ "\nSelect Block, DGN, DWF, Image, PDF or Xref to Clip:")
 (setq ss1 (ssget '((-4  .  "<OR")(0 . "IMAGE") (0 . "DGNUNDERLAY") (0 . "DWFUNDERLAY") (0 . "PDFUNDERLAY") (0 . "INSERT")(-4  .  "OR>"))))
 (if ss1
  (progn
   (princ"\nSelect Closed Boundaries to Use for Clipping:")
   (setq ss (ssget (list '(-4 . "<AND") '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>"))))
   (if ss
    (progn
    (setq count1 0)                    ; initialize counter
    (setq emax1 (sslength ss1))         ; get length of ss1
    (while (< count1 emax1)             ; while there are still entities in ss1
      (setq obxr (ssname ss1 count1))     ; get entity's name
      (redraw obxr 3)				; highlite selected object
      (setq obdxr (entget obxr))		; retrieve objectives data
      (setq obdxrtype (cdr(assoc 0 obdxr)))	; retrieve object type
      (princ (strcat "\n" obdxrtype " Selected for Clipping..."))
      (setq count 0)                    ; initialize counter
      (setq emax (sslength ss))         ; get length of ss
      (while (< count emax)             ; while there are still entities in ss
       	(setq en (ssname ss count))     ; get entity's name
        (cond
	 ((= obdxrtype "INSERT")	; if block insert or xref
	  (command"_.COPY" obxr "" "0,0,0" "0,0,0")	; make copy of object to clip
	  (setq obxrcopy (entlast))
	  (if (ChkClpBnd obxrcopy)(command"_.XCLIP" obxrcopy "" "_D"))   ; check if there's a clipping boundary & delete
	  (command"_.XCLIP" obxrcopy "" "_New" "_S" en)			 ; clip
	 )
	 ((= obdxrtype "IMAGE")		; if image
	  (command"_.COPY" obxr "" "0,0,0" "0,0,0")
	  (setq obxrcopy (entlast))
	  (command"_.IMAGECLIP" obxrcopy "_D")
	  (command"_.IMAGECLIP" obxrcopy "_New" "_S" en)
	 )
	 ((= obdxrtype "DGNUNDERLAY")	; if dgn
	  (command"_.COPY" obxr "" "0,0,0" "0,0,0")
	  (setq obxrcopy (entlast))
	  (command"_.DGNCLIP" obxrcopy "_D")
	  (command"_.DGNCLIP" obxrcopy "_New" "_S" en)
	 )
	 ((= obdxrtype "DWFUNDERLAY")	; if dwf
	  (command"_.COPY" obxr "" "0,0,0" "0,0,0")
	  (setq obxrcopy (entlast))
	  (command"_.DWFCLIP" obxrcopy "_D")
	  (command"_.DWFCLIP" obxrcopy "_New" "_S" en)
	 )
	 ((= obdxrtype "PDFUNDERLAY")	; if pdf
	  (command"_.COPY" obxr "" "0,0,0" "0,0,0")
	  (setq obxrcopy (entlast))
	  (command"_.PDFCLIP" obxrcopy "_D")
	  (command"_.PDFCLIP" obxrcopy "_New" "_S" en)
	 )
	) ; cond
        (setq count (1+ count))	; advance to next boundary object
      ) ; while
      (princ (strcat "\n" obdxrtype " Clipped Successfully to Selected Boundaries."))
      (command"_.ERASE" obxr "") ; erase original object
      (setq count1 (1+ count1))	; advance to next boundary object
    ) ; while
   ) ; progn
   (princ"\nNo Supported Closed Boundaries Selected.")
  ) ; if
 ) ; progn
  (princ"\nNo Supported Objects Selected for Clipping.")
 ) ; if ss1
 (if xclipm_olderr (setq *error* xclipm_olderr))           ; Restore old *error* handler
 (setvar"cmdecho"cmdecho)(setvar"menuecho"menuecho)(princ) ; restore command echos
) ; defun xclipm
(princ"... Command loaded.")(princ)