Build 2.0 :
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:getpoint (Promptmsg Default InitBit KeyList BasePoint ...
Revised Library : kwb 20051031
20051101 kwb : ESC test added.
Build 2.0 :
(kb:getpoint "WorkPoint" '(200 100 0) (+ 1 8) '("BasePoint" "Apex") '(0 0 0))
|;
(defun kb:getpoint (Promptmsg ; The prompt string.
Default ; Value to return if response is <enter>
InitBit ; Initget bit
KeyList ; Initget keywords List of strings
BasePoint ; Base point < or nil >
;
/ PromptMessage
InitString KeyWordString
ReturnValue ParameterList
)
;;------------------------------
(or InitBit (setq InitBit 0))
;;------------------------------
(if KeyList
(setq InitString (substr
(apply
'strcat
(mapcar '(lambda (item) (strcat " " item)) KeyList)
)
2
)
KeyWordString (strcat " ["
(vl-string-translate " " "/" InitString)
"]"
)
)
(setq InitString ""
KeyWordString ""
)
)
;;------------------------------
(setq PromptMessage
(strcat
"\n"
(cond (Promptmsg)
("Specify Point")
)
KeyWordString
(if Default
(progn (setq InitBit (logand InitBit (~ 1)))
(if (= (type Default) 'str)
(strcat " <<" Default ">>")
;; else, assume it is a point .. user beware
(strcat " <<" (kb:ptos Default nil nil) ">>")
)
)
""
)
": "
)
)
;;------------------------------
(initget InitBit InitString)
(if (vl-catch-all-error-p
(setq
ReturnValue (vl-catch-all-apply 'getpoint
(if BasePoint
(list PromptMessage BasePoint)
(list PromptMessage)
)
)
)
) ; ESC was pressed.
(setq ReturnValue nil
Default nil
)
)
(if ReturnValue
ReturnValue
Default
)
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------