CAD分图程序（改良加强版）
本帖最后由 nyistjz 于 2021-11-18 13:26 编辑CAD分图程序，几经波折，终于修改好了，分享出来，给有需要的朋友使用。
特点：
1、默认保存路径可修改可保存
2、文件夹名称按日期分类
3、文件名自动编号
4、分图完成后自动打开文件夹
=====================================================
2021年11月17日更新
又做了更新改良，自动记忆设置更改路径
[*]
[*](defun C:DwgSplit (/ *avzzts-reg-key* *avzzts-reg-root* filename folder getsystime i name path root ss ss1 winshell)
[*](princ "-->图纸拆分导出")
[*](setvar "cmdecho" 0)
[*];定义时间查询函数
[*](defun getsystime (format)(menucmd (strcat "M=$(edtime,$(getvar,date)," format ")")))
[*];确定文件保存位置
[*](setq winshell (vlax-create-object "Shell.Application"))
[*](setq *avzzts-reg-root* "HKEY_CURRENT_USER\\Software\\Autodesk\\avzztls")
[*](setq *avzzts-reg-key* (strcat*avzzts-reg-root* "\\R"(vl-princ-to-string(atof(getvar "acadver")))))
[*](setq path (vl-registry-read *avzzts-reg-key* "dwgsplitpath"))
[*](if (or(null path)(null(findfile path)))
[*] (progn
[*] (setq folder (strcat "分图" (getsystime "m-d")))
[*] (setq path (getenv "UserProfile"))
[*] (setq root (vlax-invoke winshell 'namespace path))
[*] (vlax-invoke root 'newfolder folder)
[*] (setq path (strcat path "\\" folder))
[*] )
[*])
[*](setq path (strcat path "\\"))
[*](setq filename (getfiled "请输入文件名" path "dwg" 1))
[*](setq name (VL-FILENAME-BASE filename))
[*](setq path (VL-STRING-RIGHT-TRIM "\\" (VL-FILENAME-DIRECTORY filename)))
[*](vl-registry-write *avzzts-reg-key* "dwgsplitpath" path)
[*](setq path (strcat path "\\"))
[*];开始选择保存内容
[*](princ "\n请选择需要分图的内容:")
[*](setq i 0)
[*](while (setq ss (ssget))
[*] (vl-cmdf "wblock"
[*] (strcat path name (getsystime " hh-mm-ss-") (itoa (setq i (1+ i))) ".dwg")
[*] "" "0,0" ss ""
[*] )
[*] (vl-cmdf "oops")
[*] (princ "\n请继续选择<右键结束>:")
[*] (setq ss1 ss);确认是否打开文件夹
[*])
[*];打开相应文件夹
[*](if ss1 (vlax-invoke-method WinShell 'Open path))
[*](setvar "cmdecho" 1)
[*](princ)
[*])
[*](princ)
附件为旧版！
聽起來感覺不錯…似乎滿需要的
不過，還是會希望有功能的演示，這樣子才知道是不是自己要的
如果檔案太大的話，建議可以分享到「網路上的視頻」然後PO上鍵結讓人去看就好了！ guosheyang 发表于 2021-11-18 12:43
(setq path (vl-registry-read *avzzts-reg-key* "dwgsplitpath")) 这句为何执行出错？ 谢谢！
改过了，再试试！ bai2000 发表于 2020-4-30 12:24
文件名按图框中的块属性编号就好了
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=178244&highlight=%C5%FA%C1%BF
这个可以满足你的要求 来个功能演示就完美了 来个功能演示就完美了
来个功能演示就完美了 路径修改命令，需要注意看命令行中文本提示！ 演示GIF安排一下，谢谢了
演示GIF安排一下，谢谢了 文件名按图框中的块属性编号就好了 不太会搞这个，录屏了一个gif，文件太大，没有办法上传。
程序中，两个命令，一个分图，一个设定默认保存路径。 没演示图还收币，好意思