TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Kerry on October 31, 2005, 01:39:20 AM
-
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)
)
)
)
-
Kerry,
I would like to check it out but work calls.
Maybe tonight.
What happens if the user enters an invalid point like
8 <enter>
-
Ditto what Alan said, I've some thoughts on boolean short circuiting etc.
-
Alan, yes It's a problem
There are a few things I'm not too happy about.
The changing initBIT when a default is provided
Trapping for ESC
I'd be interested in hearing those thoughts Michael ..
-
Incorporating something like this may help, I think :
(defun validPoint-p (TestPoint)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point TestPoint)))
)
(validPoint-p '(1 1 1)) ; => T
(validPoint-p '(1 1)) ; => T
(validPoint-p nil) ; => nil
(validPoint-p 2) ; => nil
(validPoint-p (mapcar '+ '(1 1 1) '(2 2 0))) ; => T
-
Interesting ....
(defun validPoint-p (TestPoint)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point TestPoint))
)
)
(defun validPoint-px (TestPoint)
(and (listp TestPoint)
(eq 3 (length TestPoint))
(vl-every 'numberp TestPoint)
)
)
Benchmarking [M.P. 2005] .................Elapsed milliseconds for 16384 iteration(s)/ relative Timing :
(VALIDPOINT-P (QUOTE (1 1 1)))......2283 / 1.3646 <slowest>
(VALIDPOINT-PX (QUOTE (1 1 1))).....1673 / 1.0000 <fastest>
-
I think the speed is pretty irrelevant in a case like this, unless (unlikely) one were going to validate points in the thousands. But to play along --
(defun IsPoint ( point )
(and
(listp point)
(< 1 (length point) 4)
(vl-every 'numberp point)
)
)
:)
-
Also, it might be interesting to test the performance (just for gits and shiggles) with invalid data.
-
Speed : Agreed,
(< 1 (length point) 4) :VS: (eq 3 (length Point))
yeah, I noticed this potential in the other thread, but didn't want to spoil the ambience :)
-
Then I am chagrined for having mentioned it sir.
:oops:
-
Kerry on the escape prevention, perhaps
;; prevent the user from escaping
(setq msg "Select a point")
(while
(vl-catch-all-error-p
(setq pt (vl-catch-all-apply 'getpoint (list msg)))
)
)
-
Real close Alan, I believe if the user hit escape you'd want to gracefully exit. It's the right ide, you just need an exit condition for the loop.
-
.. chagrined for having mentioned it sir.
:oops:
no hassles, silly :)
-
Like this Michael ?
(BenchMark '((validPoint-p '(1 1 1))
(validPoint-px '(1 1 1))
(validPoint-p '(x y z))
(validPoint-px '(x y z))
(validPoint-p nil)
(validPoint-px nil)
)
)Benchmarking [M.P. 2005] .................Elapsed milliseconds for 16384 iteration(s)/ relative Timing :
(VALIDPOINT-P (QUOTE (X Y Z)))......2304 / 1.5759 <slowest>
(VALIDPOINT-P (QUOTE (1 1 1)))......2223 / 1.5205
(VALIDPOINT-P nil)..................2183 / 1.4932
(VALIDPOINT-PX (QUOTE (1 1 1))).....1602 / 1.0958
(VALIDPOINT-PX (QUOTE (X Y Z))).....1602 / 1.0958
(VALIDPOINT-PX nil).................1462 / 1.0000 <fastest>
; 1 form loaded from #<editor "K:/FunStuff/Swamp/getpoint-003.LSP">
-
Kerry on the escape prevention, perhaps
;; prevent the user from escaping
(setq msg "Select a point")
(while
(vl-catch-all-error-p
(setq pt (vl-catch-all-apply 'getpoint (list msg)))
)
)
I was looking at something like this :
......
(initget InitBit InitString)
(setq parameterList (if BasePoint
(list PromptMessage BasePoint)
(list PromptMessage)
)
ReturnValue (vl-catch-all-apply 'getpoint parameterList)
)
(if (vl-catch-all-error-p ReturnValue)
(progn (setq ReturnValue nil)
(alert "\nESC was pressed. \nBut tell someone who cares \n< replace with suitable message > ...")
)
(if ReturnValue
ReturnValue
Default
)
)
-
Shoot, I just worked this out.
(setq promptmessage "Select a point"
default '(0.0 0.0 0.0))
;(initget InitBit InitString)
(setq
returnvalue (if basepoint
(vl-catch-all-apply 'getpoint (list promptmessage basepoint))
(vl-catch-all-apply 'getpoint (list promptmessage))
)
)
(cond
((vl-catch-all-error-p returnvalue)
nil
)
(returnvalue)
(t
default
)
)
-
Real close Alan, I believe if the user hit escape you'd want to gracefully exit. It's the right ide, you just need an exit condition for the loop.
(defun c:test ( / message point )
;; as long as the user picks points and doesn't
;; press escape stay keep prompting for points ...
(setq message "Select a point: ")
(while
(and
(null
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ( )
(setq point
(getpoint message)
)
)
)
)
)
point
)
;; stay the course
)
(princ "Done.")
(princ)
)
-
Like this Michael ? <snip>
Ermmm, yeah, that.
-
I think the speed is pretty irrelevant in a case like this, unless (unlikely) one were going to validate points in the thousands. But to play along --
Further to this point. I am curbing any obsessive inclination I had to wring the last clock click out of procedures.
My priority has shifted to maintainability as a primary .. something to do with my deteriorating memory cells perhaps.
-
<nodding.gif> Diminishing returns et. al. </nodding.gif>
-
Real close Alan, I believe if the user hit escape you'd want to gracefully exit. It's the right ide, you just need an exit condition for the loop.
Did i misunderstand your reply?
That will exit on anything but an error.
-
Nope ; There's a null in there applied to the return
So the good nil is changed to .. (and ( T .....
Determines whether an argument is an error object returned from vl-catch-all-apply
(vl-catch-all-error-p arg)
Arguments : arg
Any argument.
Return Values
T, if the supplied argument is an error object returned from vl-catch-all-apply; otherwise nil
-
Sorry Alan, my mistake. I didn't realize you wanted to eliminate the user's ability to escape out of the loop. I had wrongly applied the rationale that if the user hit escape we should gracefully exit, and while that seems a good idea to me, that isn't what you coded for. Somehow I didn't see your preface text or comment. Duh. I'm blaming it on last night's lousy sleep, which, Scout's honour is true, but also completely LAME.
:whistle:
-
I had wrongly applied the rationale that if the user hit escape we should gracefully exit,
:oops: Oooops .. Me too
-
OK, How about this?
(setq promptmessage "Select a point"
default '(0.0 0.0 0.0)
)
(while
(and
;(not (initget initbit initstring))
(vl-catch-all-error-p
(setq returnvalue (if basepoint
(vl-catch-all-apply 'getpoint (list promptmessage basepoint))
(vl-catch-all-apply 'getpoint (list promptmessage))
)
)
)
(or
(initget "Yes No")
(/= (vl-catch-all-apply
'getkword
(list "Are you sure you want to abort?[Yes/No] <No>")
)
"Yes"
)
(exit)
)
)
)
(if returnvalue
returnvalue
default
)
)
-
Thats pretty close Alan
:)
This scares me a little :
(exit)
This whole topic is really interesting to me ..
-
I supose the question needs to be raised.
What is the users expectation for termination of a routine ?
Should we discourage bashing the ESC key ?
Should we provide a "Quit" keyword ...
.. I think the decision to terminate operation should be made in the main code body .. so we perhaps just pass back a Symbol to reflect the users option .. ?
-
Included only for ideas ... I wrote this long ago, like < 1999, and abused it by adding escape code (should be completely rewritten but other stuff demands attention). Anyway, run and and observe the behavior if you wish, this is how I'd expect a function to behave when hitting escape.
(defun GetPoints ( / GetPointAux i point result cancelled )
(defun GetPointAux ( from message / result )
(setq cancelled ;; note, local global
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ( )
(initget 32)
(setq result
(if from
(getpoint from message)
(getpoint message)
)
)
)
)
)
)
result
)
(cond
( (car
(setq result
(list
(GetPointAux
nil
"\nPick start point: "
)
)
)
)
(while
(setq point
(GetPointAux
(car result)
"Next point: "
)
)
(grdraw point
(cadr
(setq result
(cons point result)
)
)
-7
)
)
(setq i 0)
(while (< i (1- (length result)))
(grdraw
(nth i result)
(nth (setq i (1+ i)) result)
-7
)
)
(if (null cancelled) ;; the local global
(reverse result)
)
)
)
)
-
So, perhaps you need to pass an Exit flag
Allow Escape
Prompt for Escape
Return a flag to calling routine on escape
Return nil on Escape
No Escape allowed
Oops, MP snuck in there.
-
........ What happens if the user enters an invalid point like
8 <enter>
I'vecome back to this ...
8 <enter> could be considered valid because of
the AutoCAD direct distance entry mechanism.
ie : return a point 8 units in the direction of the cursor
You were trying to trick me Alan, yes ?
-
Command: (setq Pt2 (kb:getpoint nil nil (+ 1 8 ) nil nil))
Specify Point: 200
(3158.65 2069.37 0.0)
Command:
Command: (distance (getvar "lastpoint") pt2)
200.0
Command:
Command: (setq Pt3 (kb:getpoint nil nil (+ 1 8) nil '(0 0 0)))
Specify Point: <Ortho on> 300
(300.0 0.0 0.0)
-
No, I'm not that smart. 8-)
I always considered that type of entry a missed key operation and tried to filter it out.
Here is my feeble attempt at that http://www.theswamp.org/forum/index.php?topic=5494.msg68365#msg68365
-
coincidence .. I was looking at that when you posted.
-
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
)
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
-
Very nice Kerry. :-)
-
........ What happens if the user enters an invalid point like
8 <enter>
I'vecome back to this ...
8 <enter> could be considered valid because of
the AutoCAD direct distance entry mechanism.
ie : return a point 8 units in the direction of the cursor
You were trying to trick me Alan, yes ?
Kerry,
As you problably already know if you are going to allow for the 'Dynamic Distance Entry Method' then you are going to have to test for AutoCAD version info. Which adds even more to your prog.
just my 2c.