Initial commit

downloaded/XClipM.lsp

@@ -0,0 +1,105 @@
+; 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)