linyangmjtd 发表于 2020-9-23 01:24:14

Lisp关闭文件所有文件并退出CAD

;□□□□□□□□□□□□□□□□□□□□□□
;关闭文件代码开始
;□□□□□□□□□□□□□□□□□□□□□□

(defun C:yd-quit-alldoc-save(/ AcadApp docs cdoc);保存所有文档退出

(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
;缩放视口(比例为1)使文件处于未保存状态,如果图层未改动VLA-CLOSE的第二第三个参数会被忽略。
(vla-zoomscaled AcadApp 1.0 acZoomScaledRelative)
(vlax-for doc docs
    (if (not (equal cdoc doc))
      (if (= (Vlax-Get doc 'fullname) "")
      (vla-Close doc :vlax-false )
      (vla-close doc :vlax-true)
      )
    )
)
;由于不能关闭当前活动文档,此处用Command关闭
(if (= (Vlax-Get cdoc 'fullname) "")
    (command "quit" "y");y代表不保存
    (command "quit" "n");n代表保存
)
(prin1)
)


(defun C:yd-close-alldoc-save(/ AcadApp docs cdoc);保存关闭所有文档
(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
(vla-zoomscaled AcadApp 1.0 acZoomScaledRelative)
(vlax-for doc docs
    (if (not (equal cdoc doc))
      (if (= (vla-get-FullName doc) "")
      (progn (vla-Close doc :vlax-false) (alert (vla-get-FullName doc)))
      (vla-close doc)
      )
    )
)
;由于不能关闭当前活动文档,此处用Command关闭
(if (= (Vlax-Get cdoc 'fullname) "")
    (command "close" "y");y代表不保存
    (command "close" "n");n代表保存
)
(prin1)
)

(defun C:yd-close-otherdoc-save(/ AcadApp docs cdoc);保存关闭其他文档
(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
(vla-zoomscaled AcadApp 1.0 acZoomScaledRelative)
(vlax-for doc docs
    (print (vla-get-FullName doc))
    (if (not (equal cdoc doc))
      (if (= (Vlax-Get doc 'fullname) "")
      (vla-Close doc :vlax-false )
      (vla-close doc :vlax-true)
      )
    )
)
(princ "关闭其他文档成功!")
(prin1)
)

(defun C:yd-quit-alldoc-withoutsave(/ AcadApp docs cdoc);不保存所有文档退出
(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
(vlax-for doc docs
    (if (not (equal cdoc doc))
      (vla-close doc :vlax-false)
    )
)
;由于不能关闭当前活动文档,此处用Command关闭
(command "quit" "y");y代表不保存
(prin1)
)

(defun C:yd-close-alldoc-withoutsave(/ AcadApp docs cdoc);不保存关闭所有文档
(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
(vlax-for doc docs
    (if (not (equal cdoc doc))
      (vla-close doc :vlax-false)
    )
)
;由于不能关闭当前活动文档,此处用Command关闭
(command "close" "y");y代表不保存
(prin1)
)
(defun C:yd-close-otherdoc-withoutsave(/ AcadApp docs cdoc);不保存关闭其他文档
(setq AcadApp (vlax-get-acad-object))
(setq docs (vla-get-documents AcadApp))
(setq cdoc (vla-get-ActiveDocument AcadApp))
(vlax-for doc docs
    (if (not (equal cdoc doc))
      (vla-close doc :vlax-false)
    )
)
(princ "关闭其他文档成功!")
(prin1)
)


(defun C:gb( / mod)
(initget "1 2 3 4 5 6")
(setq mod (getkword "\n请选择关闭选项[保存所有文档退出(1) /保存关闭所有文档(2) /保存关闭其他文档(3) /不保存所有文档退出(4) /不保存关闭所有文档(5) /不保存关闭其他文档(6)]:"))
(cond
    ((= mod "1") (C:yd-quit-alldoc-save))
    ((= mod "2") (C:yd-close-alldoc-save))
    ((= mod "3") (C:yd-close-otherdoc-save))
    ((= mod "4") (C:yd-quit-alldoc-withoutsave))
    ((= mod "5") (C:yd-close-alldoc-withoutsave))
    ((= mod "6") (C:yd-close-otherdoc-withoutsave))
)
(princ)
)
;■■■■■■■■■■■■■■■■■■■■■■
;关闭文件代码结束
;■■■■■■■■■■■■■■■■■■■■■■

江南十笑 发表于 2020-9-23 22:17:17

谢谢分享                        

yu960312 发表于 2022-5-28 06:53:30

遇到打开的有只读文件不会自动关闭并退出,希望优化一下遇到只读文件直接关闭

chimugua 发表于 2020-9-30 12:27:49

我cad2021用的倒是挺好的 但是用cad2020的话会出现乱码 4操作不了

999999 发表于 2020-9-23 08:06:17

谢谢大神的分享,学习一波,优秀优秀,,一大早上就看到了分享,谢谢啦

xj6019 发表于 2020-9-23 22:35:43

谢谢分享   

香远益清 发表于 2020-9-25 11:19:39

经测试,很好用,收藏了,谢谢分享

tumu8420 发表于 2020-9-28 09:06:38

不错,蛮好用的

ZMB7211 发表于 2020-10-25 23:12:53

Aries 发表于 2020-11-4 19:50:50

经测试,很好用,收藏了,谢谢分享

juliana207 发表于 2020-12-3 22:43:30

error: bad function: 1
请问怎么回事?
页: [1] 2 3
查看完整版本: Lisp关闭文件所有文件并退出CAD