[求助]如何批量修改DWG数据的图层颜色

west · 发表于 2003-3-28 12:00:00

大量的DWG R14格式数据，要把所有图层的颜色修改为白色，如何快速实现，请指教！

龙龙仔 · 发表于 2003-3-28 17:03:00

;;一个VLISP的批量处理范例
;;从这个范例可以了解VLISP如何批量处理图档
;;虽然速度慢了点,但非常实用
;;By LUCAS(龙龙仔)
;;批量修改图层颜色
;;
;;虽配合Expresstools__(acetutil.arx)
;;为加速程序执行,程序将设定系统变量ACADLSPASDOC
;;即
;;当然程序结束后,会还原系统变量ACADLSPASDOC
;;
;;For AutoCad 2000+
;;Usage: (CH_LAY_COLOR (acad_colordlg 7))
;;Usage: (CH_LAY_COLOR 7)
(arxload "acetutil.arx" NIL)
(vl-load-com)
(defun CH_LAY_COLOR (COL    /             HOLDECHO       APP       DWGNAME
                  PREFIX_DWG             NN       QQ       HOLDLSP
                  WW             ENT_LAY
                  )
  (setq HOLDECHO (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq       PREFIX_DWG
      (strcat
         (vl-string-right-trim
         "\\"
         (strcase (acet-ui-pickdir
                     "选择目录"
                     (vl-string-right-trim "\\" (getvar "dwgprefix"))
                     "移除未使用之具名参考"
                  )
         )
         )
         "\\"
      )
  )
  (setq HOLDLSP (getvar "ACADLSPASDOC"))
  (setvar "acadlspasdoc" 0)
  (setq QQ (vl-directory-files PREFIX_DWG "*.DWG"))
  (setq NN 0)
  (if (/= QQ NIL)
(progn
   (setq APP (vlax-get-acad-object))
   (repeat (length QQ)
      (setq DWGNAME (strcase (strcat PREFIX_DWG (nth NN QQ))))
      (setq WW (vla-open (vla-get-documents APP) DWGNAME))
      (vlax-for ENT_LAY (vla-get-layers WW)
      (vla-put-color ENT_LAY COL)
      )
      (vla-save WW)
      (prompt (strcat "\n" DWGNAME " !!!"))
      (vla-close WW :vlax-false)
      (setq NN (1+ NN))
   )
   (vlax-release-object WW)
   (vlax-release-object APP)
)
(prompt "\n所选目录中未有任何图档!!!")
  )
  (setvar "acadlspasdoc" HOLDLSP)
  (setvar "cmdecho" HOLDECHO)
  (princ)
)
(princ)

west · 发表于 2003-3-31 10:17:00

由于VisualLisp不熟，所以只好使用脚本了
不知道脚本的运行速度和Lisp比较，差别多大？

[求助]如何批量修改DWG数据的图层颜色

发表回复

精选推荐