[编程交流] 是否消息

(defun IS_YES_PRESSED? (title message / vlaobj result)
 (vl-load-com)
 (vl-catch-all-apply
   (function
     (lambda ()
       (setq vlaobj (vlax-create-object "WScript.Shell"))
       (setq result (vlax-invoke-method vlaobj 'popup message 0 title 4132))
     )
   )
 )
 (if vlaobj (vlax-release-object vlaobj))
 (= result 6) 
)
;(IS_YES_PRESSED? "My dialogue" "Please choose ....")

;calling code plus return answer
(setq title "Please enter dwg number")
(setq width "   edit_width = 15;")
(setq limit "     edit_limit = 12;")
(ah:getval title)
(setq dwgname item)
;; Input  Dialog box with variable title
;; By Ah June 2012 thanks to AlanJT for source idea
;; code (ah:getval title)
(defun AH:Getval (title width limit / fo)
(setq fname "C://acadtemp//getval.dcl")
(setq fo (open fname "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "sizze" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
;(write-line "     edit_width = 18;" fo) 
;(write-line "     edit_limit = 15;" fo)
(write-line width fo) 
(write-line limit fo)
(write-line "   is_enabled = true;" fo)        
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_cancel;}" fo)
(close fo)
(setq dcl_id (load_dialog  "c:\\acadtemp\\getval"))
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(action_tile "sizze" "(setq item  $value)(done_dialog)")
(mode_tile "sizze" 3)
(start_dialog)
; returns the value of item
)

;; YesNo.lsp CAB 04.260.2008
;;  Creates a DCL file on the fly for Yes/No Prompt
;; Arguments:
;;   BoxTitle = Dialog Box Title
;;   Question = Question to be displayed
;; Sample Call (YesNo " My Yes No" "Do you like creating programs in AutoLISP?")
;;  Returns "Yes" or "No" from user or nil if the DCL failed
(defun YesNo (BoxTitle Question / Dcl_Id% Result acadfn fn fid)
 (if
   (and (or (setq fn (findfile "YesNo.dcl"))
            (setq acadfn (findfile "ACAD.PAT")
                  fn     (strcat (substr acadfn 1 (- (strlen acadfn) ) "YesNo.dcl")))
        (setq fid (open fn "w"))
   )
    ;; create dcl file in same directory as ACAD.PAT  
    (progn
      (foreach x
               (list
                 "YesNo : dialog { key = "Title";"
                 "  spacer;"
                 (strcat "  : text { key = "Question" ; width = "
                         (itoa (+ (strlen Question) 4))
                         " ; alignment = centered; }")
                 "  spacer;"
                 "  : row { fixed_width = true; alignment = centered;"
                 "    : button { key = "Yes"; label = "&Yes"; is_default = true;}"
                 "    : button { key = "No"; label = "&No"; is_cancel = true;}"
                 "  }"
                 "}"
               )
        (princ x fid)
        (write-line "" fid)
      )
      (close fid)
    )
 )
 (cond
   ((setq Dcl_Id% (load_dialog fn))
    (new_dialog "YesNo" Dcl_Id%)
    (set_tile "Title" BoxTitle)
    (set_tile "Question" Question)
    (action_tile "Yes" "(done_dialog 1)")
    (action_tile "No" "(done_dialog 0)")
    (setq Result (start_dialog))
    (unload_dialog Dcl_Id%) ; Unload Dialog
    (if (and Result (= Result 1)) "Yes" "No")
   )
   (t nil)
 )
)
(IF (yesno "Purg audit""message goes here") = yes)
(command "line")
(command "circle")
)

(setq reply (yesno "Purg audit""message goes here"))
(IF (= reply  yes)
(command "line")
(command "circle")
)

(if (= reply "Yes")
  (command "line" pause pause "")
  (command "Circle" Pause Pause)
)

;; YesNo.lsp CAB 04.260.2008
;;  Creates a DCL file on the fly for Yes/No Prompt
;; Arguments:
;;   BoxTitle = Dialog Box Title
;;   Question = Question to be displayed
;; Sample Call (YesNo " My Yes No" "Do you like creating programs in AutoLISP?")
;;  Returns "Yes" or "No" from user or nil if the DCL failed
(defun YesNo (BoxTitle Question / Dcl_Id% Result acadfn fn fid)
 (if
   (and (or (setq fn (findfile "YesNo.dcl"))
            (setq acadfn (findfile "ACAD.PAT")
                  fn     (strcat (substr acadfn 1 (- (strlen acadfn) ) "YesNo.dcl")))
        (setq fid (open fn "w"))
   )
    ;; create dcl file in same directory as ACAD.PAT  
    (progn
      (foreach x
               (list
                 "YesNo : dialog { key = "Title";"
                 "  spacer;"
                 (strcat "  : text { key = "Question" ; width = "
                         (itoa (+ (strlen Question) 4))
                         " ; alignment = centered; }")
                 "  spacer;"
                 "  : row { fixed_width = true; alignment = centered;"
                 "    : button { key = "Yes"; label = "&Yes"; is_default = true;}"
                 "    : button { key = "No"; label = "&No"; is_cancel = true;}"
                 "  }"
                 "}"
               )
        (princ x fid)
        (write-line "" fid)
      )
      (close fid)
    )
 )
 (cond
   ((setq Dcl_Id% (load_dialog fn))
    (new_dialog "YesNo" Dcl_Id%)
    (set_tile "Title" BoxTitle)
    (set_tile "Question" Question)
    (action_tile "Yes" "(done_dialog 1)")
    (action_tile "No" "(done_dialog 0)")
    (setq Result (start_dialog))
    (unload_dialog Dcl_Id%) ; Unload Dialog
    (if (and Result (= Result 1)) "Yes" "No")
   )
   (t nil)
 )
)
(vl-load-com)
(defun Create_Close_Reactor()
 (if(not close:reactor)
   (setq close:reactor
  (vlr-editor-reactor nil
    '((:vlr-beginClose . CloseReaction))))
   ); end if
 (princ)
 ); end of Create_Close_Reactor
(defun CloseReaction(args reac / actDoc)
(if (zerop (getvar 'dwgtitled))
   (null)
(progn  
(setq reply (yesno "Closing" "Would you like to Audit and Purge your Drawing"))
 (IF (= reply "Yes")
   (progn
   (setq actDoc(vla-get-ActiveDocument
   (vlax-get-acad-object)))
   (vla-ZoomExtents(vlax-get-acad-object))
   (vla-AuditInfo (vla-get-ActiveDocument (vlax-get-object "AutoCAD.Application")) :Vlax-True)
   (repeat 3(vla-PurgeAll actDoc))
   (vla-Save actDoc)
   )
  (progon
  (setq actDoc(vla-get-ActiveDocument
  (vlax-get-acad-object)))
  (vla-ZoomExtents(vlax-get-acad-object))
  (vla-Save actDoc)
  ) 
 )
)
)
(princ)
); end of CloseReaction
(Create_Close_Reactor)