Error Function

September 28, 2023

All,

Can I please get some help with putting an ERROR function I my list routine, I would like for it to stop until the boundary is selected.

Thank you,

Brian

;;;;Block Select

(defun C:BS (/ Poly SS )    
    (vl-load-com)
    (vl-cmdf "._undo" "_begin")
    (setq clayer (getvar "clayer"))
    (setvar "cmdecho" 0)
    (setvar "dimlfac" 1)
    (setvar "dimlunit" 4)
    (setvar "dimdec" 4)
    (setvar "dimtxt" 0.5)
    (vl-cmdf "-UNITS" 4 "" "" "" "" "")
    (vl-cmdf "_.ZOOM" "E" "_.zoom" ".9x")
    (vl-cmdf "-overkill" "all" "" "P" "N" "")
    (initcommandversion)
    (command "_.join" "_All" "")
(if (setq Poly (car (entsel "\nSelect Boundary: ")))
   (progn
    (vl-cmdf "-Layer" "M" "PIECE" "C" "40" "" "")
    (vla-put-layer (vlax-ename->vla-object Poly) "PIECE")
    (vla-put-color (vlax-ename->vla-object Poly) 256)))
    (setvar "clayer" clayer)
    (vl-cmdf "_.layer" "F" "PIECE" "")    
(if (setq SS (ssget "_A" (LIST '(0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC"))))
   (progn
    (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
    (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
    (vla-put-layer obj "HOLE")
    (vla-put-color obj 256))))
    (vla-Explode (vlax-ename->vla-object Poly))
    (vla-Delete (vlax-ename->vla-object Poly))
(if (setq cc (ssget "_A" (LIST '(0 . "CIRCLE") '(40 . 0.0))))
    (progn
      (and (setq d 1.00)
       (setq d (/ d 2.))       
       )
    (repeat (setq i (sslength cc))
      (setpropertyvalue (ssname cc (setq i (1- i))) "Radius" d))
       (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex cc)))) 
    (vl-cmdf "-Layer" "M" "ERROR" "C" "1" "" "")
    (vla-put-layer obj "ERROR")
    (vla-put-color obj 256))))
(and (setq s (ssget "_X" '((0 . "POINT,TEXT"))))
    (vl-cmdf "_.erase" s ""))
    (vl-cmdf "-purge" "a" "" "n")    
    (vl-cmdf "-Layer" "M" "MARKER" "C" "240" "" "")
    (vl-cmdf "-Layer" "T" "PIECE" "")
    (vl-cmdf "-Layer" "U" "HOLE" "")
    (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
    (vl-cmdf "-Layer" "M" "0" "C" "7" "" "")    
    (setvar "cmdecho" 1)
    (vl-cmdf "._undo" "_end")    
    (princ)    
 )

Edited October 3, 2023 by SLW210
Added Code Tags!

September 29, 2023

This does not make sense it will return d=0.5 everytime

(and (setq d 1.00)
(setq d (/ d 2.))       
)

Did you mean like this must be 1 or 0.5

(or (= d 1.00)
(= d 0.5)       
)

September 29, 2023

Another comment, always good practice to reset variables back to how they were afterwards, I tend to use this if there are a few changed

  (setq vars '("CMDECHO" "DIMLFAC" "DIMLUNIT" "DIMDEC" "DIMTXT"))
  (setq old (mapcar 'getvar vars)) ;;get old variables
  (mapcar 'setvar vars '(0 1 4 4 0.5)) ;;set variables to new

.... do code

  (mapcar 'setvar vars old)

September 29, 2023

Have you got a sample drawing you can post, perhaps a before and after what you want to do. I am getting an error with (command "_.join" "_all") and from your question suspect that selecting the lines to create the boundary might be the solution you want too... but not quite sure on the drawing you are working with and to create.

October 2, 2023

On 9/29/2023 at 11:16 AM, Steven P said:

Have you got a sample drawing you can post, perhaps a before and after what you want to do. I am getting an error with (command "_.join" "_all") and from your question suspect that selecting the lines to create the boundary might be the solution you want too... but not quite sure on the drawing you are working with and to create.

Here's the sample drawing, all you have to do is touch the border to make it work but if you miss the border it will mess up.

bp4.dxf

October 2, 2023

On 9/28/2023 at 8:33 PM, BIGAL said:
This does not make sense it will return d=0.5 everytime
(and (setq d 1.00)
(setq d (/ d 2.))       
)
Did you mean like this must be 1 or 0.5
(or (= d 1.00)
(= d 0.5)       
)

We have parts that come from other programs that make circles with a 0 diameter and a 0 radius, this part of the code finds them and changes them to a 1in diameter so the can be seen on the screen. This gives the detailer a chance to do whatever he what's with it.

October 2, 2023

I think this might make it clearer what Big Al was saying, adding an extra line in:

(progn
  (and
    (setq d 1.00)
    (setq d (/ d 2.)
  )
)

(progn .... ) isn't needed since there is only 1 expression for that 'if' function - but I often put (progn ..... ) in just for clarity when I am working things out, can see what it is doing easier

The (and .... ) part is saying set d = 1 AND then set d = d/2 , or 0.5.

I sometimes do similar,. put a user defined default value at the top of the code - where it can be easily found - user can look into the code and change it to suit. Later in the code to be modified as required. It would usually get a comment to say what the value is so it can be found and changed easily:

You could change the d to be r (radius) and perhaps add a comment for the user to change this value as required. Remember to change the d where used afterwards of course

I would go with this:

(setq r = 0.5) ;;Use this radius for zero radius circles

October 3, 2023

21 hours ago, Steven P said:
I think this might make it clearer what Big Al was saying, adding an extra line in:
(progn
  (and
    (setq d 1.00)
    (setq d (/ d 2.)
  )
)
(progn .... ) isn't needed since there is only 1 expression for that 'if' function - but I often put (progn ..... ) in just for clarity when I am working things out, can see what it is doing easier

The (and .... ) part is saying set d = 1 AND then set d = d/2 , or 0.5.

I sometimes do similar,. put a user defined default value at the top of the code - where it can be easily found - user can look into the code and change it to suit. Later in the code to be modified as required. It would usually get a comment to say what the value is so it can be found and changed easily:

You could change the d to be r (radius) and perhaps add a comment for the user to change this value as required. Remember to change the d where used afterwards of course

I would go with this:
(setq r = 0.5) ;;Use this radius for zero radius circles

Steven,

Did you have a chance to look at the drawing I sent you to see where I could fix the lisp to where it doesn't move forward without picking the polyline?

Thanks,

Brian

October 3, 2023

Not yet - you sound just like my colleagues at the moment - a busy 2 weeks!

October 3, 2023

1 hour ago, Steven P said:

Not yet - you sound just like my colleagues at the moment - a busy 2 weeks!

I didn't mean to sound like I was rushing you. I'm just frustrated that I can't figure it out on my own.

October 3, 2023

That's OK - good to get a reminder to look at something

October 3, 2023

There are a number of logical issues in your code. Without understanding completely what you are trying to do, here is how I would write it.

1) Localize all your variables unless you need them outside of the function.

2) Always include an error handler that can reset things if it crashes, this can be locally scoped just within the function itself.

3) The Entsel function loop I created allows you to re-select if you miss a pick or pick the wrong object.

4) Always reset variables to the way they were before the function started, unless you intended them to be permanently changed. If that is the case, just remove them from the "vars" list.

5) you can set several variables within a single setq statement, and you don't need logical operators when the value is a constant (per the conversation above).

(defun C:BS (/ *error* clayer cc d i Poly r s ss vals vars)    
   (vl-load-com)
   (vl-cmdf "._undo" "_begin")

   (defun *error* (msg)
      (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
	      (princ (strcat "\nError: " msg "\n"))
         (princ "\nProgram Aborted.\n")
      )
      (if (and vars vals)(mapcar '(lambda (x y) (setvar x y)) vars vals))
      (vl-cmdf "._undo" "_end")
      (princ)
   )
   
   (setq clayer (getvar "clayer"))

   (setq vars '("cmdecho" "dimlfac" "dimlunit" "dimdec" "dimtxt")
         vals (mapcar 'getvar vars)
   )
   (mapcar '(lambda (x y) (setvar x y)) vars '(0 1 4 4 0.5))

   (vl-cmdf "-UNITS" 4 "" "" "" "" "")
   (vl-cmdf "_.ZOOM" "E" "_.zoom" ".9x")
   (vl-cmdf "-overkill" "all" "" "P" "N" "")
   (initcommandversion)
   (command "_.join" "_All" "")

   ;; Loop Select for Boundary Polyline, allow re-select on missed pick or invalid object
   (while
      (progn
         (setvar "errno" 0)
         (setq Poly (entsel "\nSelect Boundary: "))
         (cond
            ((= 7 (getvar "errno"))(princ "\nNo Object Selected. Try Again...\n"))
            ((vl-consp Poly)
               (if (not (wcmatch (cdr (assoc 0 (entget (setq Poly (car Poly))))) "*POLYLINE"))
                  (princ "\nInvalid Object Selected. Please Select a POLYLINE Object. ")
               )
            )
         )
      )
   )
   (if Poly
      (progn
         (vl-cmdf "-Layer" "M" "PIECE" "C" "40" "" "")
         (vla-put-layer (vlax-ename->vla-object Poly) "PIECE")
         (vla-put-color (vlax-ename->vla-object Poly) 256)
         (vla-Explode (vlax-ename->vla-object Poly))
         (vla-Delete (vlax-ename->vla-object Poly))
         (vl-cmdf "_.layer" "F" "PIECE" "")
      )
   )

   (setvar "clayer" clayer)
    
   (if (setq SS (ssget "_A" (LIST '(0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC"))))
      (progn
         (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
         (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
            (vla-put-layer obj "HOLE")
            (vla-put-color obj 256)
         )
      )
   )

   (if (setq cc (ssget "_A" (LIST '(0 . "CIRCLE") '(40 . 0.0))))
      (progn
         (setq d 1.00 r (/ d 2.0))
         (repeat (setq i (sslength cc))
            (setpropertyvalue (ssname cc (setq i (1- i))) "Radius" r)
         )
         (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex cc)))) 
            (vl-cmdf "-Layer" "M" "ERROR" "C" "1" "" "")
            (vla-put-layer obj "ERROR")
            (vla-put-color obj 256)
         )
      )
   )

   (if (setq s (ssget "_X" '((0 . "POINT,TEXT"))))
        (vl-cmdf "_.erase" s "")
   )

   (vl-cmdf "-purge" "a" "" "n")    
   (vl-cmdf "-Layer" "M" "MARKER" "C" "240" "" "")
   (vl-cmdf "-Layer" "T" "PIECE" "")
   (vl-cmdf "-Layer" "U" "HOLE" "")
   (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
   (vl-cmdf "-Layer" "M" "0" "C" "7" "" "")    
   
   (mapcar '(lambda (x y) (setvar x y)) vars vals)

   (vl-cmdf "._undo" "_end")    
   (princ)    
)

Edited October 3, 2023 by pkenewell

October 3, 2023

35 minutes ago, pkenewell said:

There are a number of logical issues in your code. Without understanding completely what you are trying to do, here is how I would write it.

1) Localize all your variables unless you need them outside of the function.

2) Always include an error handler that can reset things if it crashes, this can be locally scoped just within the function itself.

3) The Entsel function loop I created allows you to re-select if you miss a pick or pick the wrong object.

4) Always reset variables to the way they were before the function started, unless you intended them to be permanently changed. If that is the case, just remove them from the "vars" list.

5) you can set several variables within a single setq statement, and you don't need logical operators when the value is a constant (per the conversation above).

(defun C:BS (/ *error* clayer cc d i Poly r s ss vals vars)    
   (vl-load-com)
   (vl-cmdf "._undo" "_begin")

   (defun *error* (msg)
      (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
	      (princ (strcat "\nError: " msg "\n"))
         (princ "\nProgram Aborted.\n")
      )
      (if (and vars vals)(mapcar '(lambda (x y) (setvar x y)) vars vals))
      (vl-cmdf "._undo" "_end")
      (princ)
   )
   
   (setq clayer (getvar "clayer"))

   (setq vars '("cmdecho" "dimlfac" "dimlunit" "dimdec" "dimtxt")
         vals (mapcar 'getvar vars)
   )
   (mapcar '(lambda (x y) (setvar x y)) vars '(0 1 4 4 0.5))

   (vl-cmdf "-UNITS" 4 "" "" "" "" "")
   (vl-cmdf "_.ZOOM" "E" "_.zoom" ".9x")
   (vl-cmdf "-overkill" "all" "" "P" "N" "")
   (initcommandversion)
   (command "_.join" "_All" "")

   ;; Loop Select for Boundary Polyline, allow re-select on missed pick or invalid object
   (while
      (progn
         (setvar "errno" 0)
         (setq Poly (entsel "\nSelect Boundary: "))
         (cond
            ((= 7 (getvar "errno"))(princ "\nNo Object Selected. Try Again...\n"))
            ((vl-consp Poly)
               (if (not (wcmatch (cdr (assoc 0 (entget (setq Poly (car Poly))))) "*POLYLINE"))
                  (princ "\nInvalid Object Selected. Please Select a POLYLINE Object. ")
               )
            )
         )
      )
   )
   (if Poly
      (progn
         (vl-cmdf "-Layer" "M" "PIECE" "C" "40" "" "")
         (vla-put-layer (vlax-ename->vla-object Poly) "PIECE")
         (vla-put-color (vlax-ename->vla-object Poly) 256)
         (vla-Explode (vlax-ename->vla-object Poly))
         (vla-Delete (vlax-ename->vla-object Poly))
         (vl-cmdf "_.layer" "F" "PIECE" "")
      )
   )

   (setvar "clayer" clayer)
    
   (if (setq SS (ssget "_A" (LIST '(0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC"))))
      (progn
         (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
         (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
            (vla-put-layer obj "HOLE")
            (vla-put-color obj 256)
         )
      )
   )

   (if (setq cc (ssget "_A" (LIST '(0 . "CIRCLE") '(40 . 0.0))))
      (progn
         (setq d 1.00 r (/ d 2.0))
         (repeat (setq i (sslength cc))
            (setpropertyvalue (ssname cc (setq i (1- i))) "Radius" r)
         )
         (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex cc)))) 
            (vl-cmdf "-Layer" "M" "ERROR" "C" "1" "" "")
            (vla-put-layer obj "ERROR")
            (vla-put-color obj 256)
         )
      )
   )

   (if (setq s (ssget "_X" '((0 . "POINT,TEXT"))))
        (vl-cmdf "_.erase" s "")
   )

   (vl-cmdf "-purge" "a" "" "n")    
   (vl-cmdf "-Layer" "M" "MARKER" "C" "240" "" "")
   (vl-cmdf "-Layer" "T" "PIECE" "")
   (vl-cmdf "-Layer" "U" "HOLE" "")
   (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
   (vl-cmdf "-Layer" "M" "0" "C" "7" "" "")    
   
   (mapcar '(lambda (x y) (setvar x y)) vars vals)

   (vl-cmdf "._undo" "_end")    
   (princ)    
)

PKENEWELL,

That work perfect!!!! Thank you so much.

Brian

October 3, 2023

Here is another way, slight difference in selecting the boundary and blatant copy of pkenewell error.

Using ssget "+.:E:S" in case you later want to add more filters than just a polyline.

Put the units type (-units command) as a variable to reset it after the LISP has run

Moved the end of an if statement (if POLY) to the end so that if no polyline is selected the LISP will just stop.

(defun C:BS ( / clayer vars old MySS Poly SS obj cc d i s ) 
  (vl-load-com)
  (defun trap (msg)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
	  (princ (strcat "\nError: " msg "\n"))
      (princ "\nProgram Aborted.\n")
    )
    (if (and vars vals)(mapcar '(lambda (x y) (setvar x y)) vars vals))
    (setq *error* temperr)
    (vl-cmdf "._undo" "_end")
    (princ)
 ) ; end defun
;; https://www.afralisp.net/visual-lisp/tutorials/error-trapping.php
  (setq temperr *error*)
  (setq *error* trap)

  (vl-cmdf "._undo" "_begin")            ;;Start Undo
  (setq clayer (getvar "clayer"))        ;;Get current Layer

(setq vars '("CMDECHO" "DIMLFAC" "DIMLUNIT" "DIMDEC" "DIMTXT" "LUNITS"))
(setq old (mapcar 'getvar vars)) ;;get old variables
(mapcar 'setvar vars '(0 1 4 4 0.5 4))    ;;set variables above according to list values
;;    (setvar "cmdecho" 0) ; see above
;;    (setvar "dimlfac" 1) ; see above
;;    (setvar "dimlunit" 4); see above
;;    (setvar "dimdec" 4)  ; see above
;;    (setvar "dimtxt" 0.5); see above
;;    (vl-cmdf "-UNITS" 4 "" "" "" "" "") ; see above

  (vl-cmdf "_.ZOOM" "E" "_.zoom" ".9x")
  (vl-cmdf "-overkill" "all" "" "P" "N" "")
  (initcommandversion)(command "_.join" "_All" "")

(while (= (setq MySS (ssget "_+.:E:S" (list (cons 0 "*POLYLINE")) )) nil) 
  (princ "\nOh No!! that is not a polyline")
) ; end while

;;  (if (setq Poly (car (entsel "\nSelect Boundary: ")))
(if (setq Poly (ssname MySS 0))
    (progn
      (vl-cmdf "-Layer" "M" "PIECE" "C" "40" "" "")
      (vla-put-layer (vlax-ename->vla-object Poly) "PIECE")
      (vla-put-color (vlax-ename->vla-object Poly) 256)
;;    ) ; end progn ; moved to end of LISP
;;  ) ; end if ; moved to end of LISP
      (setvar "clayer" clayer)
      (vl-cmdf "_.layer" "F" "PIECE" "")    
      (if (setq SS (ssget "_A" (LIST '(0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC"))))
        (progn
          (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
          (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
            (vla-put-layer obj "HOLE")
            (vla-put-color obj 256)
          ) ; end foreach
        ) ; end prog
      ) ; end if
      (vla-Explode (vlax-ename->vla-object Poly))
      (vla-Delete (vlax-ename->vla-object Poly))
      (if (setq cc (ssget "_A" (LIST '(0 . "CIRCLE") '(40 . 0.0))))
        (progn
          (setq d 0.5) ; default circle radius
;;              (and (setq d 1.00)
;;              (setq d (/ d 2.))       
;;              ) ; end and
          (repeat (setq i (sslength cc))
            (setpropertyvalue (ssname cc (setq i (1- i))) "Radius" d)
          ) ; end repeat
          (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex cc)))) 
            (vl-cmdf "-Layer" "M" "ERROR" "C" "1" "" "")
            (vla-put-layer obj "ERROR")
            (vla-put-color obj 256)
          ) ; end foreach
        ) ; end progn
      ) ; end if
      (and (setq s (ssget "_X" '((0 . "POINT,TEXT"))))
        (vl-cmdf "_.erase" s "")
      ) ; end and
      (vl-cmdf "-purge" "a" "" "n")    
      (vl-cmdf "-Layer" "M" "MARKER" "C" "240" "" "")
      (vl-cmdf "-Layer" "T" "PIECE" "")
      (vl-cmdf "-Layer" "U" "HOLE" "")
      (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "")
      (vl-cmdf "-Layer" "M" "0" "C" "7" "" "") 
    ) ; end progn
    (progn
      (princ "\nNo suitable polyline selected")
    )
  ) ; end if Poly exists

   
  (setvar "cmdecho" 1)
  (vl-cmdf "._undo" "_end") 
  (mapcar 'setvar vars old) 
  (princ)    
)

October 3, 2023

15 minutes ago, Steven P said:

Here is another way, slight difference in selecting the boundary and blatant copy of pkenewell error.

Using ssget "+.:E:S" in case you later want to add more filters than just a polyline.

@Steven P That works, but the only drawback is you are stuck in the while loop if you just want to just press ENTER to exit the selection, without selecting something. You would have to select something or hit ESC to cancel out.

Edited October 3, 2023 by pkenewell

October 3, 2023

That's a point, forgot if you want to exit (I tend to hit escape a few times to cancel a command, tend to forget about enter and space a little)

Sign In

Error Function

Recommended Posts

BTDUKE1967

BIGAL

Steven P

Steven P

BTDUKE1967

BTDUKE1967

Steven P

BTDUKE1967

Steven P

BTDUKE1967

Steven P

pkenewell

BTDUKE1967

Steven P

pkenewell

Steven P

Join the conversation

Tutorials

Forums

Activity