trouble looping

[robbt]

I am new to this forum, looking for some help on a lisp routine been working on.

 

The routine works except. My goal is to execute the routine in a loop, allowing me to continue to pick and change until "enter" key in pressed, without any errors being printed in the command line. Right now if I press the "ECS" key it exits the routine and settings are returned, i.e. osmode reset to previous settings. If I press "ENTER" it exits with an error message. Here is the routine

 

 
(defun c:bc90 ( / se sp point snap echo olderr)
 (setq snap (getvar "osmode")
       echo (getvar "cmdecho")
olderr *error*
*error* break_error
 )
 (setvar "cmdecho" 0) 
   (progn
     (setvar "osmode" 32)
     (while
       (null
         (nentselp (setq point (getpoint "\nSelect Breaking Point (or ENTER when done): ")))
       )
     )
       (setvar "osmode" 512)
    (while
      (not se)
               (setq sp (cadr (setq se (entsel "\nSelect Line to Change to Hidden: "))))
           )
           (setvar "osmode" 0)
           (command "break" se "f" point "@")
           (command "change" sp "" "p" "c" "9" "lt" "hidden" "")
(princ)
   )
 (setvar "osmode" snap)
 (setvar "cmdecho" echo)
 (setq *error* olderr)
 (princ)
)
(defun break_error (msg)
 (princ (strcat "\nError: " msg))
 (setvar "osmode" snap)
 (setvar "cmdecho" echo)
 (princ

)

)

 

The progn line was added in early failed attempts at looping. I am trying to limit the number of keyboard inputs so I do not want "Press [Y] to continue or [Exit]" type lines in the routine. Just a simple "ENTER" to exit. If possible.

 

any help would be nice, thanks

[fixo]

Just a hint

The very first expression after WHILE

Must be a single expression

So in your case it would be:

(while

(setq point (getpoint "\nSelect Breaking Point (or ENTER when done): "))

 

then all the rest will be go after

[Arin9916]

(defun c:aa( / pt oo_)
   (PTE:subload-111211)
   (setq oo_(PTE:start '("osmode" "cmdecho")))
   (if (not(tblsearch "ltype" "hidden")) (alert "please load linetype : hidden"))
   (setvar "osmode" 32)
   (setvar "cmdecho" 0)
   (while (setq pt (getpoint "\nSelect Breaking Point (or ENTER when done): "))
       (foreach obj (PTE:ptset_ pt)
           (or (PTE:flag_ pt (vlax-curve-getStartPoint obj))
               (PTE:flag_ pt (vlax-curve-getendPoint obj))
               (not (setq ent (vlax-vla-object->ename obj)))
               (command "_.break" ent pt pt)
           )
       )
       (foreach obj (PTE:ss->obj (ssget '((0 . "*line,arc"))))
           (vla-put-linetype obj "hidden")
           (vla-put-color obj 9)
       )
   )(PTE:end)
   (princ)
)(vl-load-com)

(defun PTE:subload-111211 nil

   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 01            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:start( lst /)
       (setq _doc(vla-get-ActiveDocument (vlax-get-acad-object)))
       (if (= 8 (logand 8 (getvar 'UNDOCTL)))
           (vla-endundomark _doc)
       )
       (setq #vlst lst #slst (mapcar 'getvar #vlst))
       (vla-startundomark _doc) t
   )

   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 02            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:end nil
       (if (and #vlst #slst) 
           (mapcar 'setvar #vlst #slst)
       )
       (setq #vlst nil #slst nil *error* nil)
       (vla-endundomark _doc)
   )

   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 03            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:flag_ ( p1 p2 / flag )
       (setq flag t)
       (mapcar
           '(lambda ( a b )
               (if (/= a b) (setq flag nil))
           ) p1 p2
       ) flag
   )


   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 04            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:ptset_( pt / acdoc lst lst2 )
       (setq acdoc (vla-get-ActiveDocument(vlax-get-acad-object))
             lst nil lst2 nil
       )
       (while (setq ss(ssget pt))
           (foreach obj (PTE:ss->obj ss)
               (if (or (wcmatch (vla-get-objectname obj) "*Line")
                       (wcmatch (vla-get-objectname obj) "*Arc")
                   )
                   (setq lst (cons obj lst))
                   (setq lst2 (cons obj lst2))
               )
               (vla-put-Visible obj 0)
               (vla-Regen acdoc acActiveViewport)
           )
       )
       (foreach obj (append lst2 lst)
           (vla-put-visible obj -1)
       ) lst
   )

   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   ;;             Sub Function - 05            ;;
   ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
   (defun PTE:ss->obj ( ss / i re )
       (if ss
           (repeat (setq i (sslength ss))
               (setq re (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) re))
           )
       )
   )

   (defun *error* (s) (and oo_ (PTE:end)))

)

[pBe]

From what i understand from the way the OP' code is written right now. unless this is true, stay on the loop and dont ask to select object.

 

 (nentselp (setq point (getpoint "\nSelect Breaking Point (or ENTER when done): ")))

 

but the problem with this is when you pressed enter you will get s bad argument type error mesage since point variable is nil. If you do it this way

 

 (while (cond ((and
           (setvar "osmode" 32)
        (setq point
              (getpoint
                "\nSelect Breaking Point (or ENTER when done): ")
                )
               (nentselp point))
            )
          ),.....)

 

You can presss Enter without error and it will step out of the loop. But even with a nil value for getpoint and nentselp it will do the same

 

So...

 

 (defun c:bc90 (/ se sp point snap echo olderr)
(defun break_error (msg)
 (princ (strcat "\nError: " msg))
 (setvar "osmode" snap)
 (setvar "cmdecho" echo)
 (princ)
)
[color=blue](if (not (tblsearch "ltype" "HIDDEN"))[/color]
[color=blue](vl-cmdf "linetype" "load" "HIDDEN" "acad.lin" "")[/color]
[color=blue])  [/color]
 (setq  snap (getvar "osmode")
   echo (getvar "cmdecho")
   olderr *error*
   *error* break_error
   )
 (setvar "cmdecho" 0)
 (while [color=blue](progn[/color]
[color=blue]     (setvar "osmode" 32)[/color]
[color=blue]  (setq point (getpoint[/color]
[color=blue]          "\nSelect Breaking Point (or ENTER when done): ")[/color]
[color=blue]          )[/color]
[color=blue]         )[/color]
   [color=blue](if (nentselp point)(progn [/color]
   (setvar "osmode" 512)
   (if (setq se (entsel "\nSelect Line to Change to Hidden: "))
(command "break" se "f" [color=blue]"_non"[/color] point "@" "_change"  [color=blue](car (nentselp (cadr se)))[/color] "" "p" "c" "9" "lt"
       "hidden" "" )
       )
    [color=blue])[/color]
[color=blue])[/color]
   )
 (setvar "osmode" snap)
 (setvar "cmdecho" echo)
 (setq *error* olderr)
 (princ)
 )

 

By evaluating nentselp outside of the while testexpr, a none T value wont give you an error since point variable is valid and it will just loop back to getpoint prompt.

 

Also a test for "Hidden" linetype would be helpful as suggested by Arin9916

 

Hope this helps

Edited December 11, 2011 by pBe

[robbt]

Let me give this a try. Looks good. The purpose of the (while (null was to test to make sure an entity was picked and not just some point. But now I see how this was creating some of the problem. Let you know how it goes. Thanks all.

[robbt]

pBe, thanks for your help. Works great. And Arin, good idea for the linetype test. Did not even think of that since my templates all have "hidden" already loaded, but other peoples drawings may not.

 

One more question on the topic. Is there a way to test to ensure a point is picked on intersecting lines and not just a point on a line.

[BIGAL]

I would suggest you would not pick a point but rather objects using a small pick window then sort through them

 

Find two lines do they intersect is intersection equal to point found as well? if Yes then found

[robbt]

hummmm, going to have to scratch my head on that idea. could work, if I can figure out how.

[pBe]

pBe, thanks for your help. Works great. And Arin, good idea for the linetype test. Did not even think of that since my templates all have "hidden" already loaded, but other peoples drawings may not.

 

One more question on the topic. Is there a way to test to ensure a point is picked on intersecting lines and not just a point on a line.

 

You're welcome robbt

 

Like what Bigal' suggested, instead of getpoint, use a selection function (entsel/nentsel/nentselp) then use vlax-curve-getclosestpointto to obtain and ensure the break point

 

or

 

you can change the test condtion

from this

(nentselp point)

to

(and (setq tst (ssget "c" point point))

(> (sslength tst ) 1))

 

Problems i see with this appoach, there are cases where the enitites linetype is other than continuous and gap between segments are too large wherein the point hits a "gap" and it wont be selected

 

You can add a fuzz value to increase the size of the crossing box.

(setq fuz 1.0)

 

 
(ssget "C" (polar point (* pi 0.25) (* [color=blue]fuz[/color] (sqrt 2)))
(polar point (* pi 1.25) (* [color=blue]fuz[/color] (sqrt 2))))

 

The bigger the fuz the larger the crossing selection, Also, the current osmode may affect the selection so better set it to 0 like you had before.

 

HTH

[BIGAL]

Thanks Pbe the pick box could still be a single point but the size of selection box is calculated from the pick point saves a pick and can be very small like your fuzz factor.

[pBe]

Thanks Pbe the pick box could still be a single point but the size of selection box is calculated from the pick point saves a pick and can be very small like your fuzz factor.

 

Cool beans Bigal

 

Cheers