改自他人程序，我只是进行再加工而已~~~
  2. ;程序执行：TT
  3. ;制作图库幻灯片
  4. ;将目标文件夹下的每个文件执行“清理-缩放-写出幻灯片-保存关闭”；
  5. (vl-load-com)
  6. (defun getFolder (str_title str_prompt /)
  7.     (strcat (vl-string-right-trim "\" (strcase (acet-ui-pickdir str_prompt (vl-string-right-trim "\" "") str_title))) "\")
  8. )
  9. (defun makeDirectory (dir / )
  10.     (vl-mkdir dir)
  11. )

  13. (defun userundo()
  14.     (setq *error* errtmp)
  15.     (setvar "cmdecho" old_cmdecho)
  16.     (setvar "acadlspasdoc" old_acadlspasdoc)
  17.     (princ)
  18. )

  20. (defun err (msg)
  21.   (userundo)
  22. )
  23. ;主程序开始
  24. (defun c:TT ( / app doc docs err errtmp file files newpath old_acadlspasdoc old_cmdecho path sset)
  25.   (setq errtmp *error*)
  26.   (setq *error* err)
  27.     (setq old_cmdecho (getvar "cmdecho"))
  28.     (setvar "cmdecho" 0)
  29.     (setq old_acadlspasdoc (getvar "acadlspasdoc"))
  30.     (setvar "acadlspasdoc" 0)
  31.   (setq path (getFolder "请选择目录..." "请选择目录："))
  32.   (setq files (vl-directory-files path "*.dwg" 1))
  33.   (if files
  34.         (progn
  35.                 (setq scrfile (strcat path "batpurge.scr"))
  36.                 (setq fn (open scrfile "w"))
  37.                 (foreach file files
  38.                     (setq str (strcat "open " "path file "" purge all * no Zoom E mslide " "path (vl-string-right-trim ".dwg" file)".sld" "" qsave close"))
  39.                     (write-line str fn)
  40.                     (princ)
  41.                 )
  42.                 (close fn)
  43.         )
  44.     (alert "所选目录无 .dwg 文件！请重新选择：")
  45.   )
  46.     (command "script" scrfile)
  47.     (userundo)
  48.   (setq *error* errtmp)
  49.   (princ)
  50. )


网友答: 本帖最后由 YuHB 于 2025-9-14 10:22 编辑
spp_wall 发表于 2025-9-14 00:27
no function definition: ACET-UI-PICKDIR

在代码中加入这一句试试：(arxload "acetutil.arx")

网友答: 本帖最后由 YuHB 于 2025-8-21 13:29 编辑

楼主的代码稍微修改了下，好像能用了。
  • ;程序执行：TT
  • ;制作图库幻灯片
  • ;将目标文件夹下的每个文件执行“清理-缩放-写出幻灯片-保存关闭”；
  • (vl-load-com)
  • (defun getFolder (str_title str_prompt /)
  •   (strcat (vl-string-right-trim "\\" (strcase (acet-ui-pickdir str_prompt (vl-string-right-trim "\\" "") str_title))) "\\")
  • )
  • (defun makeDirectory (dir / )
  •   (vl-mkdir dir)
  • )
  • (defun userundo()
  •   (setq *error* errtmp)
  •   (setvar "cmdecho" old_cmdecho)
  •   (setvar "acadlspasdoc" old_acadlspasdoc)
  •   (princ)
  • )
  • (defun err (msg)
  •   (userundo)
  • )
  • ;主程序开始
  • (defun c:TT ( / app doc docs err errtmp file files newpath old_acadlspasdoc old_cmdecho path sset)
  •   (setq errtmp *error*)
  •   (setq *error* err)
  •   (setq old_cmdecho (getvar "cmdecho"))
  •   (setvar "cmdecho" 0)
  •   (setq old_acadlspasdoc (getvar "acadlspasdoc"))
  •   (setvar "acadlspasdoc" 0)
  •   (setq path (getFolder "请选择目录..." "请选择目录："))
  •   (setq files (vl-directory-files path "*.dwg" 1))
  •   (if files
  •     (progn
  •       (setq scrfile (strcat path "batpurge.scr"))
  •       (setq fn (open scrfile "w"))
  •       (foreach file files
  •         (setq str (strcat "open " path file "  purge all * no Zoom E mslide " path (vl-string-right-trim ".dwg" file) ".sld" " qsave close"))
  •         (write-line str fn)
  •         (princ)
  •       )
  •       (close fn)
  •     )
  •     (alert "所选目录无 .dwg 文件！请重新选择：")
  •   )
  •   (command "script" scrfile)
  •   (userundo)
  •   (setq *error* errtmp)
  •   (princ)
  • )

复制代码



网友答:
  2. (vl-load-com)
  3. ;将CAD图形DWG文件批量转成幻灯片
  4. (defun C:DWG2SLD (/ ACADOBJ DOC DWG_DIR DWG_LST NAME SDI)
  5.   (defun CJW-FILE-GET (MSG / WINSHELL SHFOLDER PATH CATCHIT)
  6.     (setq WINSHELL (vlax-create-object "Shell.Application"))
  7.     (setq
  8.       SHFOLDER (vlax-invoke-method WINSHELL 'BROWSEFORFOLDER 0 MSG 1)
  9.     )
  10.     (setq
  11.       CATCHIT (vl-catch-all-apply
  12.                 '(lambda ()
  13.                    (setq SHFOLDER (vlax-get-property SHFOLDER 'SELF))
  14.                    (setq PATH (vlax-get-property SHFOLDER 'PATH))
  15.                  )
  16.               )
  17.     )
  18.     (if        (vl-catch-all-error-p CATCHIT)
  19.       NIL
  20.       PATH
  21.     )
  22.   )
  23.   (princ
  24.     "\n将CAD图形DWG文件批量转成幻灯片(DWGTOSLD) By carrot1983 2009-05-10"
  25.   )
  26.   (setvar "CMDECHO" 0)
  27.   (alert "\n注意: 备份原图!!!")
  28.   (if (and (setq DWG_DIR (CJW-FILE-GET "选择DWG文件夹"))
  29.            (setq DWG_LST (vl-directory-files DWG_DIR "*.DWG" 1))
  30.       )
  31.     (progn
  32.       (foreach DWG DWG_LST
  33.         (if (setq SS (ssget "x"))
  34.           (command "._ERASE" SS "")
  35.         )
  36.         (setq DWG (strcat DWG_DIR "\" DWG))
  37.         (setq SLD (strcat DWG_DIR "\" (vl-filename-base DWG) ".sld"))
  38.         (command ".-INSERT" DWG "_NON" '(0. 0. 0.) "1" "1" "0")
  39.         (command "._ZOOM" "_E")
  40.         (command "._MSLIDE" SLD)
  41.         (print SLD)
  42.       )
  43.       (alert "程序完毕 <DWG2SLD>")
  44.     )
  45.   )
  46.   (princ)
  47. )再来个萝卜的~~


网友答: 谢谢分享，赞一个


网友答: 谢谢,正是所需.

网友答: 太好了谢谢楼主这个好用........

网友答: 非常好用，建议加精

网友答: 谢谢。这个程序不错

网友答: 有类似的需求，拿来借鉴一下。谢谢分享。

网友答: 过来看看 没明白怎么用。。。

网友答:
WCEO 发表于 2016-6-2 22:49
过来看看 没明白怎么用。。。

文件在那里，怎么没看见，有的朋友能发一下吗？
  • 上一篇：暖通风管绘制，变径连接，弯头连接，三通连接
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025