105 lines
4.6 KiB
Common Lisp
105 lines
4.6 KiB
Common Lisp
; 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) |