(DEFUN c:xref ( / block-lst xref-lst nxt-blk n)
(PROGN
(SETQ block-lst (LIST (TBLNEXT "BLOCK" T)))
(SETQ xref-lst NIL)
(WHILE (SETQ nxt-blk (TBLNEXT "BLOCK"))
(SETQ block-lst (APPEND block-lst (LIST nxt-blk)))
) ;_ end of WHILE
(FOREACH n block-lst
(IF (AND (ASSOC 70 n) (EQ (BOOLE 1 4 (CDR (ASSOC 70 n))) 4))
(SETQ xref-lst
(APPEND
xref-lst
(LIST (LIST (CDR (ASSOC 2 n)) (CDR (ASSOC 1 n)))
) ;_ end of LIST
) ;_ end of APPEND
) ;_ end of SETQ
) ;_ end of IF
) ;_ end of FOREACH
(IF xref-lst
(c:detachall)
(PROGN
(PRINC "\nNo References to Detach... ")
(PRINC)
)
) ;_ end of IF
(PRINC)
) ;_ end of PROGN
) ;_ end of defun
;**********************************************************
(defun c:xref1 (/ acdoc ss)
;; Tharwat 01. 07. 2011
(vl-load-com)
(setq acdoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (setq ss (ssget "_x" '((0 . "OLE2FRAME,IMAGE,INSERT"))))
(
(lambda (i / sset vl e)
(while
(setq sset (ssname ss (setq i (1+ i))))
(setq vl (vlax-ename->vla-object sset))
(setq e (entget sset))
(cond
(
(eq (cdr (assoc 0 e)) "OLE2FRAME")
(vla-delete vl)
)
(
(eq (cdr (assoc 0 e)) "IMAGE")
(vl-cmdf "_.-image" "_detach" (vla-get-name vl) "")
)
(
(and (eq (cdr (assoc 0 e)) "INSERT")
(vlax-property-available-p vl 'Path)
)
(vl-cmdf "_.-xref" "_detach" (vla-get-name vl) "")
)
)
)
)
-1
)
(alert
"No Xref file(s) or Image(s) or even OLE found to detach !!"
)
)
(vla-regen acdoc acAllViewports)
(princ)
)
没有评论:
发表评论