This was prompted by a thread elsewhere on the forum.
Would anyone like to try to break this. ESC does not count.
I won't comment on or explain the code just yet.
A good exercise for anyone learning VLisp would be to disect the code and write some documentation.
Please post documentation seperate from the body of code.
Note the Menu option when Right Clicking when the command is active when prompting for Pt4 {keywords option}.
Here is a couple of test statements.
(setq Pt1 (kb:getpoint nil nil nil nil nil)
Pt2 (kb:getpoint "NextPoint" '(10 10 10) (+ 1 8) nil nil)
Pt3 (kb:getpoint "Specify WorkPoint"
'(0 0 0)
(+ 1 32)
'("BasePoint" "Apex")
Pt1
)
Pt4 (kb:getpoint "Specify Another Point"
Pt3
(+ 1 8 32)
'("BasePoint" "Apex")
'(0 0 0)
)
)
This is the main routine and a helper :
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;| #lib.
kb:getpoint (Promptmsg Default InitBit KeyList BasePoint ...
Revised Library : kwb 20051031
|;
(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
)
(setq PromptMessage (strcat "\n"
(cond (Promptmsg)
("Specify Point")
)
)
)
(if KeyList
(setq InitString (substr
(apply
'strcat
(mapcar '(lambda (item) (strcat " " item)) KeyList)
)
2
)
KeyWordString (vl-string-translate " " "/" InitString)
)
;; else,
(setq InitString "")
)
(or InitBit (setq InitBit 0))
(setq PromptMessage
(strcat
PromptMessage
(if KeyWordString
(strcat PromptMessage " [" 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 (setq ReturnValue (if BasePoint
(getpoint PromptMessage BasePoint)
(getpoint PromptMessage)
)
)
ReturnValue
Default
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;| #lib.
kb:ptos (pt xmode xprec
Revised Library kwb 20021103
Arguments :
pt : point list
xmode : Units to use , can be nil
xprec : display precision to use , can be nil
Return : A point formatted as a string
|;
(defun kb:ptos (pt xmode xprec)
(or xmode (setq xmode (getvar "LUNITS")))
(or xprec (setq xprec (getvar "LUPREC")))
(if pt
(strcat (rtos (car pt) xmode xprec)
","
(rtos (cadr pt) xmode xprec)
","
(rtos (caddr pt) xmode xprec)
)
)
)