另类Purge

eachy

偶尔遇到一种特别大的DWG，上百兆了，打开后看着也没有多少Entity，用Purge显示没有可清的东西，经过分析Dwg中附加的信息太多，可能包括Xdat、Dict、Xrecord等等，如果一个个处理可能要逐一分析，太麻烦，下面用简单的步骤和简单的几个语句实现另类“Purge”
1 打开Dwg，这里太大的DWG可能在32bit系统和CAD会很慢，为了最简单处理，确保CAD仅有这一个文档打开
2 文件-〉新建一个文档，用默认设置
3 打开Vlisp编辑器
4 把下面几句粘贴进去，加载，慢慢等待，Ok
5 保存图形，前后对比看看能瘦身多少
说明：
a：字体样式复制是必须的，否则可能无法显示部分字体
b:  图块复制也是必须的，否则Insert无法生成
c：图层复制非必须，复制仅是为了保持原汁原味，否则可能都是一种白色

声明：本语句处理有风险，后果自负！

[pcode=lisp,true]
(setq *acad* (vlax-get-acad-object)
      doc    (vla-item (vla-get-documents *acad*) 0)
)
;;复制另外图形图层
(vlax-for lay (vla-get-layers doc)
  (entmake (entget (vlax-vla-object->ename lay)))
)
;;复制另外图形字体
(vlax-for sty (vla-get-textstyles doc)
  (entmake (entget (vlax-vla-object->ename sty)))
)
;;构造另外图块定义
(vlax-for obj (vla-get-blocks doc)
  (if (not (wcmatch (strcase (vla-get-name obj)) "*SPACE*"))
    (setq bl (cons obj bl))
  )
)
;;拷贝另外图块定义
(vla-CopyObjects
  doc
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbObject
      (cons 0 (1- (length bl)))
    )
    bl
  )
  (vla-get-blocks (vla-get-activedocument *acad*))
)
;;复制另外图形实体
(vlax-for obj (vla-get-modelspace doc)
  ;;如果保留扩展数据用下面这句
  ;;(entmake (entget (vlax-vla-object->ename obj) '("*")))
  ;;不保留扩展数据
  (entmake (entget (vlax-vla-object->ename obj)))
)
;;回收变量
(vlax-release-object *acad*)
(vlax-release-object doc)
(setq bl nil
      *acad* nil
      doc nil
)[/pcode]

牢固

使用Wblock可以干净的提取出图形实体，缺点是没有对象的图层、字体、图块丢失了！
另外楼主的复制最好都采用CopyObjects方法，修改如下:
[pcode=lisp,true](setq *acad* (vlax-get-acad-object)
      doc    (vla-item (vla-get-documents *acad*) 0)
)
(defun itemsall (coll / l)
  (vlax-for a coll (setq l (cons a l)))
  (reverse l)
  )
;;复制图层、
(vlax-invoke doc  'CopyObjects (itemsall (vla-get-layers doc)) (vla-get-layers (vla-get-ActiveDocument *acad*)))
;;复制另外图形字体
(vlax-invoke doc  'CopyObjects (itemsall (vla-get-textstyles doc)) (vla-get-textstyles (vla-get-ActiveDocument *acad*)))
(setq l nil)
;;复制块定义
(vlax-invoke
  Doc
  'CopyObjects
  (vlax-for blk (vla-get-blocks Doc)
    (if (/= :vlax-true (vla-get-islayout blk))
      (setq l (cons blk l))
      l
      )
    )
  (vla-get-blocks (vla-get-ActiveDocument *acad*))
)
;;复制线型
(vlax-invoke doc  'CopyObjects (itemsall (vla-get-Linetypes doc)) (vla-get-Linetypes (vla-get-ActiveDocument *acad*)))
;;复制实体
(vlax-invoke doc  'CopyObjects (itemsall (vla-get-ModelSpace doc)) (vla-get-ModelSpace (vla-get-ActiveDocument *acad*)))
[/pcode]
还可以采用ObjectDBX方法，根本无需打开源文件，直接复制实体、图层、块等等！
[pcode=lisp,true]
(setq *acad* (vlax-get-acad-object)
      DBXDoc (vla-GetInterfaceObject
               *acad*
               (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
                 "ObjectDBX.AxDbDocument"
                 (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
                 )
               )

      )
(defun itemsall (coll / l)
  (vlax-for a coll (setq l (cons a l)))
  (reverse l)
  )
(vla-open DBXDoc (getfiled "" "" "dwg" 4))
;;复制图层、
(vlax-invoke DBXDoc  'CopyObjects (itemsall (vla-get-layers DBXDoc)) (vla-get-layers (vla-get-ActiveDocument *acad*)))
;;复制另外图形字体
(vlax-invoke DBXDoc  'CopyObjects (itemsall (vla-get-textstyles DBXDoc)) (vla-get-textstyles (vla-get-ActiveDocument *acad*)))
(setq l nil)
;;复制块定义
(vlax-invoke
  DBXDoc
  'CopyObjects
  (vlax-for blk (vla-get-blocks DBXDoc)
    (if (/= :vlax-true (vla-get-islayout blk))
      (setq l (cons blk l))
      l
      )
    )
  (vla-get-blocks (vla-get-ActiveDocument *acad*))
)

;;复制线型
(vlax-invoke DBXDoc  'CopyObjects (itemsall (vla-get-Linetypes DBXDoc)) (vla-get-Linetypes (vla-get-ActiveDocument *acad*)))
;;复制实体
(vlax-invoke DBXDoc  'CopyObjects (itemsall (vla-get-ModelSpace DBXDoc)) (vla-get-ModelSpace (vla-get-ActiveDocument *acad*)))[/pcode]

zhuquanmao

楼主好人 感谢！

eachy

上面的三个顺序应该是：图层-〉字体-〉图块-〉实体

牢固

牢固 发表于 2013-4-26 09:31

                               
登录/注册后可看大图

使用Wblock可以干净的提取出图形实体，缺点是没有对象的图层、字体、图块丢失了！
另外楼主的复制最好都采 ...

*acad* 和函数itemsall 没写在代码里，自己就不会补上后再试么？

SmartStar

牢固 发表于 2013-4-26 13:55

                               
登录/注册后可看大图

*acad* 和函数itemsall 没写在代码里，自己就不会补上后再试么？

换了另一张图可以了。但是新的文档比原来的文档体积还要大。没有起到“Purge”的作用！

牢固

SmartStar 发表于 2013-4-26 16:19

                               
登录/注册后可看大图

换了另一张图可以了。但是新的文档比原来的文档体积还要大。没有起到“Purge”的作用！

问题出在复制块定义！楼上代码已改好！

eachy

有时候遇到无法复制到其他图的dwg，也可以参照这个方法来自: Android客户端

wowan1314

eachy 发表于 2013-4-26 18:41
有时候遇到无法复制到其他图的dwg，也可以参照这个方法

对哦！记得几年前遇到一个总图！无法使用复制粘贴命令ctrl+v。在其他图纸中命令都没问题！请问何解？

cy956

wowan1314 发表于 2013-5-19 21:02
对哦！记得几年前遇到一个总图！无法使用复制粘贴命令ctrl+v。在其他图纸中命令都没问题！请问何解？

一般的理解是块名重复，尤其是父子同名；二班的理解是图纸有问题，某张图，可能没几根线条，但^c^v失灵了,这种情况也碰到过.

wowan1314

cy956 发表于 2013-5-20 00:53
一般的理解是块名重复，尤其是父子同名；二班的理解是图纸有问题，某张图，可能没几根线条，但^c^v失灵了 ...

受教了！请问如何破？

pimgu999

谢谢，楼主

cable2004

不错的源码！

laibinwu

学习学习源码，感谢分享

yangist

好的idea~~~~~~~