“拆开”XREF文件

marting · 发表于 2017-3-22 08:18:50

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun C:Detachall (/ *error*
mip:layer-status-restore mip:layer-status-save
delete-xref-img-underlay delete-all-dict
)
(vl-load-com)
(defun *error* (msg)
(mip:layer-status-restore)
(princ msg)
(princ)
) ;_ end of defun
(defun mip:layer-status-restore ()
(foreach item *PD_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze
(car item)
(cdr (assoc "freeze" (cdr item)))
) ;_ end of vla-put-freeze
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun
(defun mip:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-layers
(setq *PD_LAYER_LST*
(cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply
'(lambda () (vla-put-freeze item :vlax-false))
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun delete-xref-img-underlay (/ count txt)
(mip:layer-status-save)
(vlax-for Blk (vla-get-Blocks
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-Blocks
(if (and (= (vla-get-IsXref Blk) :vlax-false)
(not (wcmatch (vla-get-name Blk) "*|*"))
) ;_ end of and
(progn
(setq count 0
txt (strcat " Erase Xref and Underlay in "
(vla-get-name Blk)
) ;_ end of strcat
) ;_ end of setq
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop (rem count 10))
(grtext -1 (strcat txt " : " (itoa count)))
) ;_ end of if
(if
(and (vlax-write-enabled-p Obj)
(or
(and ;_ XREF
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-property-available-p Obj "Path")
) ;_ end of and
(and ;_ UNDERLAY
(wcmatch (vla-get-ObjectName obj) "*Reference")
(vlax-property-available-p Obj "UnderlayName")
) ;_ end of and
(= (vla-get-ObjectName obj) "AcDbRasterImage") ;_ IMAGE
) ;_ end of or
) ;_ end of and
(VL-CATCH-ALL-APPLY 'vla-Delete (list Obj))
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
(mip:layer-status-restore)
) ;_ end of defun
(defun delete-all-dict (dict)
;;; dict - dict name (like "ACAD_IMAGE_DICT", "ACAD_PDFDEFINITIONS" ... )
(vl-catch-all-apply
'(lambda ()
(vlax-map-Collection
(vla-item
(vla-get-dictionaries
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-dictionaries
dict ;_ "ACAD_IMAGE_DICT"
) ;_ end of vla-Item
'vla-delete
) ;_ end of vlax-map-Collection
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of defun
(vl-load-com)
(delete-xref-img-underlay)
(command "_-xref" "_d" "*")
(while (> (getvar "CMDACTIVE") 0) (command))
(mapcar 'delete-all-dict
(list "ACAD_IMAGE_DICT"
"ACAD_PDFDEFINITIONS"
"ACAD_DWFDEFINITIONS"
"ACAD_DGNDEFINITIONS"
) ;_ end of list
) ;_ end of mapcar
(command "_.regenall")
(command "_.externalreferences")
(princ)
) ;_ end of defun

(defun C:Detachall (/                              *error* 
                    mip:layer-status-restore  mip:layer-status-save 
                    delete-xref-img-underlay  delete-all-dict 
                   ) 
  (vl-load-com) 
  (defun *error* (msg) 
    (mip:layer-status-restore) 
    (princ msg) 
    (princ) 
  ) ;_ end of defun 
  (defun mip:layer-status-restore () 
    (foreach item *PD_LAYER_LST* 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) 
             (vla-put-freeze 
               (car item) 
               (cdr (assoc "freeze" (cdr item))) 
             ) ;_ end of vla-put-freeze 
           ) ;_ end of lambda 
        ) ;_ end of vl-catch-all-apply 
      ) ;_ end of if 
    ) ;_ end of foreach 
    (setq *PD_LAYER_LST* nil) 
  ) ;_ end of defun 
  (defun mip:layer-status-save () 
    (setq *PD_LAYER_LST* nil) 
    (vlax-for item (vla-get-layers 
                     (vla-get-activedocument (vlax-get-acad-object)) 
                   ) ;_ end of vla-get-layers 
      (setq *PD_LAYER_LST* 
             (cons (list item 
                         (cons "freeze" (vla-get-freeze item)) 
                         (cons "lock" (vla-get-lock item)) 
                   ) ;_ end of cons 
                   *PD_LAYER_LST* 
             ) ;_ end of cons 
      ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (if (= (vla-get-freeze item) :vlax-true) 
        (vl-catch-all-apply 
          '(lambda () (vla-put-freeze item :vlax-false)) 
        ) ;_ end of vl-catch-all-apply 
      ) ;_ end of if 
    ) ;_ end of vlax-for 
  ) ;_ end of defun 
  (defun delete-xref-img-underlay (/ count txt) 
    (mip:layer-status-save) 
    (vlax-for Blk (vla-get-Blocks 
                    (vla-get-activedocument (vlax-get-acad-object)) 
                  ) ;_ end of vla-get-Blocks 
      (if (and (= (vla-get-IsXref Blk) :vlax-false) 
               (not (wcmatch (vla-get-name Blk) "*|*")) 
          ) ;_ end of and 
        (progn 
          (setq        count 0 
                txt   (strcat " Erase Xref and Underlay in " 
                              (vla-get-name Blk) 
                      ) ;_ end of strcat 
          ) ;_ end of setq 
          (grtext -1 txt) 
          (vlax-for Obj        Blk 
            (setq count (1+ count)) 
            (if        (zerop (rem count 10)) 
              (grtext -1 (strcat txt " : " (itoa count))) 
            ) ;_ end of if 
            (if 
              (and (vlax-write-enabled-p Obj) 
                   (or 
                     (and ;_ XREF 
                       (= (vla-get-ObjectName obj) "AcDbBlockReference") 
                       (vlax-property-available-p Obj "Path") 
                     ) ;_ end of and 
                     (and ;_ UNDERLAY 
                       (wcmatch (vla-get-ObjectName obj) "*Reference") 
                       (vlax-property-available-p Obj "UnderlayName") 
                     ) ;_ end of and 
                     (= (vla-get-ObjectName obj) "AcDbRasterImage") ;_ IMAGE 
                   ) ;_ end of or 
              ) ;_ end of and 
               (VL-CATCH-ALL-APPLY 'vla-Delete (list Obj)) 
            ) ;_ end of if 
          ) ;_ end of vlax-for 
        ) ;_ end of progn 
      ) ;_ end of if 
    ) ;_ end of vlax-for 
    (mip:layer-status-restore) 
  ) ;_ end of defun 
  (defun delete-all-dict (dict) 
;;; dict - dict name (like "ACAD_IMAGE_DICT", "ACAD_PDFDEFINITIONS" ... ) 
    (vl-catch-all-apply 
      '(lambda () 
         (vlax-map-Collection 
           (vla-item 
             (vla-get-dictionaries 
               (vla-get-activedocument (vlax-get-acad-object)) 
             ) ;_ end of vla-get-dictionaries 
             dict ;_ "ACAD_IMAGE_DICT" 
           ) ;_ end of vla-Item 
           'vla-delete 
         ) ;_ end of vlax-map-Collection 
       ) ;_ end of lambda 
    ) ;_ end of vl-catch-all-apply 
  ) ;_ end of defun 
  (vl-load-com) 
  (delete-xref-img-underlay) 
  (command "_-xref" "_d" "*") 
  (while (> (getvar "CMDACTIVE") 0) (command)) 
  (mapcar 'delete-all-dict 
          (list        "ACAD_IMAGE_DICT" 
                "ACAD_PDFDEFINITIONS" 
                "ACAD_DWFDEFINITIONS" 
                "ACAD_DGNDEFINITIONS" 
          ) ;_ end of list 
  ) ;_ end of mapcar 
  (command "_.regenall") 
  (command "_.externalreferences") 
  (princ) 
) ;_ end of defun

命令 c:detachxrefs

游客，如果您要查看本帖隐藏内容请回复

HLCAD · 发表于 2017-3-22 08:39:14

感谢大师提供程序！

819534890 · 发表于 2017-3-22 12:40:19

回复学习，good

Michael527 · 发表于 2017-3-22 17:47:24

试一试看看效果怎么样，谢谢

429014673 · 发表于 2017-3-22 18:11:03

正需要，支持楼主大人了！

向嘟嘟 · 发表于 2017-3-22 20:45:55

看看效果如何。。。。。

cq_qg68 · 发表于 2017-3-24 12:22:29

用一下，看看怎么样

桥云山 · 发表于 2017-3-24 12:42:09

学习一下大师经典之作

q3_2006 · 发表于 2017-3-30 05:59:35

收了大师不好东西呀..非常感谢

xinxirong · 发表于 2017-3-31 09:11:09

tgttttttttttttttttttttttttttt

defun · 发表于 2017-5-15 12:26:59

感谢大师提供程序！

小菜 · 发表于 2017-5-15 12:44:26

谢谢提供，查看隐藏

qq1254582201 · 发表于 2017-6-3 10:07:09

看看效果如何

a3595655 · 发表于 2017-6-4 10:18:09

感谢大师提供程序！

fangmin723 · 发表于 2017-8-2 16:33:56

感谢大师提供程序！

账号		自动登录	找回密码
密码			立即注册

[每日一码] “拆开”XREF文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分