[LISP程序]：DWG压缩工具

guohq

(vl-load-com)

(defun  DelWrongGrp (  / doc  err grpsobj num grpobj rtn nn)  
  ;;功能:删除冗余组,返回删除的个数
  ;;冗余组：匿名组、不包括任何图形对象的组
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq err (vl-catch-all-apply 'vla-get-groups (list doc)));;错误图形
  (if (vl-catch-all-error-p err)
    (setq rtn nil)
    (progn
      (setq grpsobj (vla-get-groups doc))
      (setq num (vla-get-count grpsobj) rtn 0 nn 0)
      (repeat num
        (setq grpobj (vla-item grpsobj nn))
        (if (= (vla-get-count grpobj) 0)
          (progn
            (vla-delete grpobj)
            (setq rtn (1+ rtn))
            )
          (progn
            (if (= "*" (substr (vla-get-name grpobj) 1 1))
              (progn
                (vla-delete grpobj)
                (setq rtn (1+ rtn))
                )
              (setq nn (1+ nn))
              )
            )
          )
        )
      )
    )
  rtn
  )
(defun DelAllLayFilter(/ doc lays dicts err1 err2 rtn)
  ;;功能：删除图层过滤器
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq lays (vla-get-layers doc))
  (setq dicts (vla-GetExtensionDictionary lays))
  (vl-catch-all-apply 'vla-remove (list dicts "ACAD_LAYERFILTERS"))
  (setq err1 (vl-catch-all-apply 'vla-remove (list dicts "ACAD_LAYERFILTERS")))
  (vl-catch-all-apply 'vla-remove (list dicts "AcLyDictionary"))
  (setq err2 (vl-catch-all-apply 'vla-remove (list dicts "AcLyDictionary")))
  (if  (vl-catch-all-error-p err1)
    (setq rtn T)
    (vla-remove dicts "ACAD_LAYERFILTERS")   
    )
  (if (null (vl-catch-all-error-p err2))
    (vla-remove dicts "AcLyDictionary")
    )
  rtn
  )

(defun ImageLst ( / dicts  err imgdict num nn img rtn)
  ;;功能：获取图中插入的图像
  (setq dicts (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))))
  (setq err (vl-catch-all-apply 'vla-item (list dicts "ACAD_IMAGE_DICT")))
  (if (vl-catch-all-error-p err)
    (setq rtn nil)
    (progn
      (setq imgdict (vla-item dicts "ACAD_IMAGE_DICT"))
      (setq num (vla-get-count imgdict) rtn'() nn 0)
      (repeat num
        (setq img (vla-item imgdict nn) nn (1+ nn))
        (setq rtn (cons img rtn))
        )
      )
    )
  rtn
  )

(defun c:DelImage()
  ;;功能:清除所有图像
  (if (imagelst)
    (command "-image" "d"  "*")
    )
  (prin1)
  )

;;;压缩开始
(DelAllLayFilter)
(delwronggrp)
(c:DelImage)
(command "-purge" "all" "*" "n")

使用方法：复制上面的代码，另存为*.lsp,直接在CAD里加载(appload)即可。

啵浪鼓

有些图档其实没什么内容,但是文件却特别大,所有线段加起来也就一万来条,还有几个block图框,但是文件却显得非常大,还有些图档在cad2005里打开图层特性管理器要等待半分钟以上的时间才蹦出对话框,用楼主的程序办法管用吗?

guohq

可以用，是图层过滤器特别多导致的，程序可以解决。

fvwbg

直接用PU不行么?

xuyu

我 也想问和直接用pu有不同吗

guohq

当有多余的组信息时，文件会变得很大，所以那些要清除。还有高低版本之间转换时，会产生多余的图层过滤器，也会使文件体积膨胀，这些问题的产生，仅通过purge是清理不了的。



你可以做个测试，画几条线，然后将他们编组，将编组后的图形狂复制N份后，再删除他们，保存文件后，就会发现虽然图里没有图形要素，不过体积仍然很大，这时你用pu是没用的。这些没用的编组(我称之为冗余组)信息通过我给的方法就能很方便的删除，大大缩小文件体积。

啵浪鼓

确实如楼主所说,高低版本转换是存在多余的看不见的东东在里面,还有一个3MB的dwg转换dxf文件后有11mb以上之多,不晓得也管用不!

先谢谢楼主,收藏先!

edusa

我需要这个，谢谢

彭子敬

命令多少呀

sjj

什么压缩原理？