Topic: getpoint <hopped-up>

[Kerry]

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.

Code: [Select]

(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 :

Code: [Select]

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;| #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)
    )
  )
)

[CAB]

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>

[MP]

Ditto what Alan said, I've some thoughts on boolean short circuiting etc.

[Kerry]

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 ..
 

[Kerry]

Incorporating something like this may help, I think :

Code: [Select]

(defun validPoint-p (TestPoint)
  (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point TestPoint)))
)

Code: [Select]

(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

[Kerry]

Interesting ....

Code: [Select]

(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)
  )
)

Code: [Select]

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>

[MP]

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 --

Code: [Select]

(defun IsPoint ( point )
    (and
        (listp point)
        (< 1 (length point) 4)
        (vl-every 'numberp point)
    )
)

[MP]

Also, it might be interesting to test the performance (just for gits and shiggles) with invalid data.

[Kerry]

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

[MP]

Then I am chagrined for having mentioned it sir.

[CAB]

Kerry on the escape prevention, perhaps

Code: [Select]

  ;;  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)))
    )
  )

[MP]

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.

[Kerry]

.. chagrined for having mentioned it sir.

no hassles, silly 

[Kerry]

Like this Michael ?

Code: [Select]

(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)
            )
)

Code: [Select]

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]

Kerry on the escape prevention, perhaps

Code: [Select]

  ;;  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 :

Code: [Select]

 
......

  (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
    )
  )