明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1268|回复: 4

[讨论] 高手帮助,来个自动炸尺寸的程序

[复制链接]
发表于 2011-6-23 09:22:53 | 显示全部楼层 |阅读模式
本人有很多小CAD文件,现在需要一个个打开后,把里面的尺寸炸开,然后合并到一个CAD。
现想,1 能否有批量炸图的程序,能选择所有文件炸
2. 文件打开后,自动选择所有尺寸,炸开后保存关闭。
以上2种方法,哪位高手会折腾个LISP下来,将非常感谢!!
发表于 2011-6-23 14:29:58 | 显示全部楼层
本帖最后由 Gu_xl 于 2011-6-23 22:58 编辑

  1. ;;;批处理函数框架
  2. (defun batchCommand (path fun / files doc)
  3.   (setq files (vl-directory-files path "*.dwg" 1))
  4.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  5.   (foreach dwgname files
  6.    (setq dwgname (strcat path "\\" dwgname))
  7.     (if (/= (strcase dwgname) (strcase (strcat (getvar "dwgprefix") dwgname)))
  8.       (progn
  9.     (if (= 8 (logand 8 (getvar 'UNDOCTL)))
  10.       (vla-EndUndoMark doc)
  11.     )
  12.     (vla-StartUndoMark doc)
  13.     (setvar "clayer" "0")
  14.     (command "-layer" "u" "*" "t" "*" "")
  15.     (command "insert" dwgname '(0 0 0) 1 1 0)
  16.     (command "explode" (entlast))
  17.     (command "-layer" "u" "*" "t" "*" "")
  18.     ;;;处理动作
  19.     (VL-CATCH-ALL-APPLY (FUNCTION fun))
  20.     ;;;回写文件
  21.     (command "wblock" dwgname "*")

  22.     (if (= 8 (logand 8 (getvar 'UNDOCTL)))
  23.       (vla-EndUndoMark doc)
  24.     )
  25.     (command  "_u")
  26.     )
  27.       )
  28.     )
  29.   )
  30. ;;;炸DIM
  31. (defun burstdim (/ qa ss)
  32.   (setq qa (getvar "QAFLAGS"))
  33.   (setvar "QAFLAGS" 1)
  34.   (setq ss (ssget "x" '((0 . "*DIMENSION"))))
  35.   (if ss (command "explode" ss ""))
  36.   (setvar "QAFLAGS" qa)
  37.   )
  38. ;;;取文件夹
  39. (defun getFolder (msg / WinShell shFolder path catchit)
  40.   (setq winshell (vlax-create-object "Shell.Application"))
  41.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  42.   (setq
  43.     catchit (vl-catch-all-apply
  44.               '(lambda ()
  45.                  (setq shFolder (vlax-get-property shFolder 'self))
  46.                  (setq path (vlax-get-property shFolder 'path))
  47.                )
  48.             )
  49.   )
  50.   (if (vl-catch-all-error-p catchit)
  51.     nil
  52.     path
  53.   )
  54. )
  55. ;;;打开空白图形加载后使用
  56. (defun c:tt()
  57.   (setq path (getFolder "\n选择文件夹"))
  58.   (if path
  59.     (gxl-batchCommand path burstdim)
  60.     )
  61.    
  62.   )
发表于 2011-6-24 10:30:59 | 显示全部楼层
感谢Gu_xl 分享程序,学习了!
 楼主| 发表于 2011-7-13 14:18:59 | 显示全部楼层
非常感谢Gu_xl 的详细解答,只是运行后发现命令行提示; error: no function definition: GXL-BATCHCOMMAND,我新建空白图形加载也一样提示,请问是什么原因或我操作有误?
发表于 2011-7-13 14:28:50 | 显示全部楼层
(gxl-batchCommand path burstdim)
试试======>
(batchCommand path burstdim)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-6-11 06:22 , Processed in 0.170759 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表