[LISP 源码] 关闭并保存文档

carrot1983

[php]
(defun C:CJW_CLOSE (/ ACADOBJ DOC DOCS KW TORF)
  (princ "\n关闭图形 By carrot1983 CAD_LISP_结构群: 82109567")
  (if (= "SDI" 1)
    (alert "\n只有一个文档!大懒虫!自己动手关闭!")
    (progn
      (initget "A F E")
      (setq KW
             (CJW-GETKWORD
               "*_CJW-OTHER-CLOSE:KWORD"
               "\n关闭选项: [全部保存(A)/全部不保存(F)/全部保存并退出CAD(E)] "
               "A"
             )
      )
      (setq ACADOBJ (vlax-get-acad-object))
      (setq DOCS (vla-get-documents ACADOBJ))
      (setq DOC (vla-get-activedocument ACADOBJ))

      (if (or (= KW "A") (= KW "F"))
        (progn
          (cond        ((= KW "A") (setq TORF :vlax-false)) ;_:vlax-false表示不保存直接关闭
                ((= KW "F") (setq TORF :vlax-true)) ;_:vlax-true表示保存后关闭
          )
          (vlax-for D DOCS
            (if        (not (equal DOC D)) ;_不为当前文档
              ;;全部关闭并只保留当前文档
              (if (= (vla-get-saved DOC) :vlax-true)
                (vla-close D) ;_可直接关闭
                (vla-close D TORF)
              )
            )
          )
          ;;关闭当前
          (cond
            ((= KW "A")
             (command "._vbastmt" "Thisdrawing.close false ")
            ) ;_:vlax-false表示不保存直接关闭
            ((= KW "F")
             (command "._vbastmt" "Thisdrawing.close true ")
            ) ;_:vlax-true表示保存后关闭
          )
        )
      )
      ;;全部保存并退出CAD
      (if (= KW "E")
        (progn
          ;;全部保存
          (vlax-for D DOCS
            (vla-save D)
          )
          ;;退出CAD
          (command "._vbastmt" "AcadApplication.quit ")
        )
      )
    )
  )
  (princ)
)


;;;Command: (initget "Yes No")
;;;nil
;;;Command: (CJW-GETKWORD "*MY:KWORD" "\nHave you stopped beating your spouse?" "No")
;;;Have you stopped beating your spouse? <No>: y
;;;"Yes"
(defun CJW-GETKWORD (VAR MSG DEFAULT / RETURN)
  (if (eval (read VAR))
    t
    (set (read VAR) DEFAULT)
  )
  (if DEFAULT
    (setq MSG (strcat "\n" MSG "<" (eval (read VAR)) ">"))
    (setq MSG (strcat "\n" MSG))
  )
  (setq RETURN (getkword MSG))
  (if RETURN
    (set (read VAR) RETURN)
    (setq RETURN (eval (read VAR)))
  )
)
[/php]

保存关闭文档.LSP
http://carrot1983.blog.sohu.com/112559077.html

黄河之水

呵呵,有创意