2023年8月18日星期五

Reduce acad file program

 (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)

)

没有评论:

发表评论