Jump to content

Error Function

BTDUKE1967

By BTDUKE1967
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

BTDUKE1967 Rookie

BTDUKE1967

Posted
Posted (edited)

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 by SLW210
Added Code Tags!
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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)

 

 

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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.

  • Like 1
Link to comment
Share on other sites
BTDUKE1967 Rookie

BTDUKE1967

Posted
  • Author
Posted
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

Link to comment
Share on other sites
BTDUKE1967 Rookie

BTDUKE1967

Posted
  • Author
Posted
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. 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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

 

Link to comment
Share on other sites
BTDUKE1967 Rookie

BTDUKE1967

Posted
  • Author
Posted
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

Link to comment
Share on other sites
BTDUKE1967 Rookie

BTDUKE1967

Posted
  • Author
Posted
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.

  • Like 1
Link to comment
Share on other sites
pkenewell Proficient

pkenewell

Posted
Posted (edited)

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 by pkenewell
Link to comment
Share on other sites
BTDUKE1967 Rookie

BTDUKE1967

Posted
  • Author
Posted
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

  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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

 

 

 

 

 

  • Like 1
Link to comment
Share on other sites
pkenewell Proficient

pkenewell

Posted
Posted (edited)
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 by pkenewell
  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

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)

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...