Jump to content

Command within Error Trap

Quest for Peace

By Quest for Peace
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Quest for Peace Contributor

Quest for Peace

Posted
Posted

I have this command, it's very old. I've edited it down to it's core and intend to attach a screencast of it being used. It connects circles to each other with arcs. When new employees come on board, the hardest thing to get them to do is not crash it with an "escape". It doesn't trim itself when it crashes. See video for what I mean.

So I've set out to fix it. I've encountered the error message "Can't call a command without *push-error-with-command*, recommend using 'Command-s'"

I've tried the command-s, I've added the *push-error-with-command*, I've tried changing it to vl-cmdf. I can't get it to work.

 

Here's the routine: 

(DEFUN C:aARR ( / SMOD X SBLOCK SBLOCKX SBLOCKY SBLOCKZ PTINFO RADX Y Z RADZ RADY olderr)

(DEFUN TRIM (POINT RAD / PT ANG POINTS)
  (IF RAD
    (PROGN
      (vl-cmdf "CIRCLE" POINT RAD)
      (vl-cmdf "TRIM" "LAST" "" POINT "")
      (ENTDEL (ENTLAST))
      )))

(DEFUN CENTERNOTALWAYSBEST (PICKPOINT / CENTERPOINT QUADPOINT RAD ENTD PT 3DWARNING)
  (IF (OSNAP PICKPOINT "CEN")
    (SETQ CENTERPOINT (OSNAP PICKPOINT "CEN")
          QUADPOINT (OSNAP PICKPOINT "QUAD")
	  RAD (DISTANCE CENTERPOINT QUADPOINT)
          );SETQ
    (IF (AND (OSNAP PICKPOINT "END") (OSNAP PICKPOINT "MID"))
      (IF (> (DISTANCE PICKPOINT (OSNAP PICKPOINT "END")) (DISTANCE PICKPOINT (OSNAP PICKPOINT "MID")))
        (SETQ CENTERPOINT (OSNAP PICKPOINT "MID")
	      );SETQ
        (SETQ CENTERPOINT (OSNAP PICKPOINT "END")
	      );SETQ
        );IF
      (COND
	((OSNAP PICKPOINT "END") (SETQ CENTERPOINT (OSNAP PICKPOINT "END")))
	((OSNAP PICKPOINT "MID") (SETQ CENTERPOINT (OSNAP PICKPOINT "MID")))
	((OSNAP PICKPOINT "NEAR") (SETQ CENTERPOINT (OSNAP PICKPOINT "NEAR")))
	);COND
      );IF SNAPS WORK
    );IF CIRCLE
  (IF CENTERPOINT
    (LIST CENTERPOINT RAD)
    (LIST PICKPOINT RAD)
    )
  );CETERNOTALWAYSBEST

  (defun arrERROR (S / ) (if (/= S "\nFunction cancelled") (princ "\nEnding aarr..."))
    (IF SBLOCKY (ENTDEL SBLOCKY))
    (IF SBLOCKZ (ENTDEL SBLOCKZ))
    (IF (NOT (NULL Z)) (PROGN (TRIM Y RADY) (TRIM Z RADZ))); Can't invoke "command" from inside *error* routine.
    (IF SBLOCKY (ENTDEL SBLOCKY))
    (IF SBLOCKZ (ENTDEL SBLOCKZ))
    (SETVAR "OSMODE" SMOD)
    (setq *ERROR* OLDERR) (princ))


  (vl-load-com)
  (SETQ OLDERR *ERROR* *ERROR* arrERROR)
      (*push-error-using-command*)
      (COMMAND "UNDO" "GROUP")
      (SETQ SMOD (GETVAR "OSMODE"))
      (IF (ZEROP (LOGAND SMOD 16384))(SETVAR "OSMODE" (+ SMOD 16384)))
      (SETQ Y (GETPOINT "Select First Point (Circle):\n"))
      (IF (SSGET Y)
	(SETQ SBLOCKY (SSNAME (SSGET Y) 0)
	      SBLOCK (CDR (ASSOC 2 (ENTGET SBLOCKY)))
	      RADY nil);SETQ
	);IF
      (SETQ PTINFO (CENTERNOTALWAYSBEST Y)
	    Y (CAR PTINFO))
      (IF (NULL RADY) (SETQ RADY (CADR PTINFO))
	(SETQ RADY (ABS (* RADY (CDR (ASSOC 41 (ENTGET SBLOCKY)))))))
      (PRINC "Select Next Point (Circle):\n")
      (WHILE (SETQ X (GETPOINT Y))
	(IF (LISTP X)
	  (PROGN
	    (IF (SSGET X)
	      (SETQ SBLOCKX (SSNAME (SSGET X) 0)
		    SBLOCK (CDR (ASSOC 2 (ENTGET SBLOCKX)))
		    RADX nil
		    );SETQ
	      (SETQ RADX NIL
		    SBLOCKX NIL)
	      );IF
	    (SETQ PTINFO (CENTERNOTALWAYSBEST X)
		  X (CAR PTINFO)
		  );SETQ
	    (IF (NULL RADX) (SETQ RADX (CADR PTINFO))
	      (SETQ RADX (ABS (* RADX (CDR (ASSOC 41 (ENTGET SBLOCKX)))))))
	    (IF SBLOCKY (ENTDEL SBLOCKY))
	    (IF SBLOCKZ (ENTDEL SBLOCKZ))
	    (IF (NOT (NULL Z)) (PROGN (TRIM Y RADY) (TRIM Z RADZ)))
	    (IF SBLOCKY (ENTDEL SBLOCKY))
	    (IF SBLOCKZ (ENTDEL SBLOCKZ))
	    (SETQ Z Y
		  RADZ RADY
		  Y X
		  RADY RADX
		  SBLOCKZ SBLOCKY
		  SBLOCKY SBLOCKX
		  );SETQ
	    (IF (NOT (NULL Z))
		(COMMAND "ARC" Z "E" Y "A" 85.0)
	      );IF
	    );PROGN
	  );IF
	(PRINC "Select Next Point:\n")
	);WHILE
      (IF SBLOCKY (ENTDEL SBLOCKY))
      (IF SBLOCKZ (ENTDEL SBLOCKZ))
      (IF (NOT (NULL Z)) (PROGN (TRIM Y RADY) (TRIM Z RADZ)))
      (IF SBLOCKY (ENTDEL SBLOCKY))
      (IF SBLOCKZ (ENTDEL SBLOCKZ))
      (COMMAND "UNDO" "END")
      (SETVAR "OSMODE" SMOD)
  (if olderr (SETQ *ERROR* OLDERR))
  (*pop-error-mode*)
  (PRINC)
  )

Here's the screencast link so you get a feel for what it does:

https://autode.sk/2CjF844

BIGAL Grand Master

BIGAL

Posted
Posted

Fix the code so forces trim before asking for next point you just have to remember the last centre/ last point. Then if esc does not matter. A while pick next is needed.

dlanorh Mentor

dlanorh

Posted
Posted

I've tried not to change too much, but this now works as you wanted. To be honest, the routine could probably do with a re-write.

  

(DEFUN C:aARR ( / *error* SMOD X SBLOCK SBLOCKX SBLOCKY SBLOCKZ PTINFO RADX Y Z RADZ RADY olderr)

  (vl-load-com)

  (defun *error* (S / )
    (if (/= S "\nFunction cancelled") (princ "\nEnding aarr..."))
    (SETVAR "OSMODE" SMOD)
    (princ)
  )

  (DEFUN TRIM (POINT RAD / PT ANG POINTS)
    (IF RAD
      (PROGN
        (vl-cmdf "CIRCLE" POINT RAD)
        (vl-cmdf "TRIM" "LAST" "" POINT "")
        (ENTDEL (ENTLAST))
      )
    )
  )

  (DEFUN CENTERNOTALWAYSBEST (PICKPOINT / CENTERPOINT QUADPOINT RAD ENTD PT 3DWARNING)
    (IF (OSNAP PICKPOINT "CEN")
      (SETQ CENTERPOINT (OSNAP PICKPOINT "CEN")
            QUADPOINT (OSNAP PICKPOINT "QUAD")
            RAD (DISTANCE CENTERPOINT QUADPOINT)
      );SETQ
      (IF (AND (OSNAP PICKPOINT "END") (OSNAP PICKPOINT "MID"))
        (IF (> (DISTANCE PICKPOINT (OSNAP PICKPOINT "END")) (DISTANCE PICKPOINT (OSNAP PICKPOINT "MID")))
          (SETQ CENTERPOINT (OSNAP PICKPOINT "MID"));SETQ
          (SETQ CENTERPOINT (OSNAP PICKPOINT "END"));SETQ
        );IF
        (COND ( (OSNAP PICKPOINT "END") (SETQ CENTERPOINT (OSNAP PICKPOINT "END")))
              ( (OSNAP PICKPOINT "MID") (SETQ CENTERPOINT (OSNAP PICKPOINT "MID")))
              ( (OSNAP PICKPOINT "NEAR") (SETQ CENTERPOINT (OSNAP PICKPOINT "NEAR")))
        );COND
      );IF SNAPS WORK
    );IF CIRCLE
    (IF CENTERPOINT (LIST CENTERPOINT RAD) (LIST PICKPOINT RAD))
  );CETERNOTALWAYSBEST

  (COMMAND "UNDO" "GROUP")
  (SETQ SMOD (GETVAR "OSMODE"))
  (IF (ZEROP (LOGAND SMOD 16384)) (SETVAR "OSMODE" (+ SMOD 16384)))
  (SETQ Y (GETPOINT "Select First Point (Circle):\n"))
  (IF (SSGET Y)
  (SETQ SBLOCKY (SSNAME (SSGET Y) 0) SBLOCK (CDR (ASSOC 2 (ENTGET SBLOCKY))) RADY nil))
  (SETQ PTINFO (CENTERNOTALWAYSBEST Y)
        Y (CAR PTINFO)
  )
  (IF (NULL RADY) (SETQ RADY (CADR PTINFO))
    (SETQ RADY (ABS (* RADY (CDR (ASSOC 41 (ENTGET SBLOCKY))))))
  )
  (PRINC "Select Next Point (Circle):\n")
  (WHILE (SETQ X (GETPOINT Y))
    (IF (LISTP X)
      (PROGN
        (IF (SSGET X)
          (SETQ SBLOCKX (SSNAME (SSGET X) 0)
                SBLOCK (CDR (ASSOC 2 (ENTGET SBLOCKX)))
                RADX nil
          );SETQ
          (SETQ RADX NIL
                SBLOCKX NIL
          )
        );IF
        (SETQ PTINFO (CENTERNOTALWAYSBEST X)
              X (CAR PTINFO)
        );SETQ
        (IF (NULL RADX) (SETQ RADX (CADR PTINFO)) (SETQ RADX (ABS (* RADX (CDR (ASSOC 41 (ENTGET SBLOCKX)))))))
        (SETQ Z Y
              RADZ RADY
              Y X
              RADY RADX
              SBLOCKZ SBLOCKY
              SBLOCKY SBLOCKX
        );SETQ
        (cond ( (NOT (NULL Z))
                (COMMAND "ARC" Z "E" Y "A" 85.0)
                (IF SBLOCKY (ENTDEL SBLOCKY))
                (IF SBLOCKZ (ENTDEL SBLOCKZ))
                (TRIM Y RADY)
                (TRIM Z RADZ)
                (IF SBLOCKY (ENTDEL SBLOCKY))
                (IF SBLOCKZ (ENTDEL SBLOCKZ))
              )
        );cond
      );PROGN
    );IF
    (PRINC "Select Next Point:\n")
  );WHILE
  (COMMAND "UNDO" "END")
  (SETVAR "OSMODE" SMOD)
  (PRINC)
)

 

Quest for Peace Contributor

Quest for Peace

Posted
  • Author
Posted

"I've edited it down to it's core"

It does more than what I pasted here. I replaced global variables with actual values to make it work. It's a small part of a suite of drafting tools (+120 commands - some took a day to write, others took a year) that all work together.

 

One of the things the full version does is it presents an option to stretch the arc before moving on. This is in case there's an obstacle on the plan, like another light fixture symbol that's on another circuit. (We rarely draw our circuits with arcs. But when we do use arcs, this is the command we use.) So if the arc is stretched after the trim, then the arc is no longer pointed at the center. It's an aesthetics thing. I know what you're thinking, SO not a big deal. And if we were drawing it manually, it wouldn't be a consideration. But, since it's automated, why not do it right? My attitude is always to invest the time up front to make the lisp fully correct, then in theory it's done forever. So the arc remaining to the center is the way that's possible.

 

I also take the attitude that if something is possible, I should learn how to do it. This improves my skills. I've got some pretty cool stuff now. (This thing was written +15 years ago. And yes, I find myself doing rewrites often. The comment gave me a chuckle.) The error message about *push-error-with-command* and "command-s" imply it's possible to call a command from within an error trap. I'd like to know how.

 

I thought one possible solution, avoiding the question of "how do you do that", would be to remove the "command" calls. I can entmake a circle easily. I wonder if there's a way to trim (easily) without a command call.

 

Another solution that has occurred to me in reading your comments, is go ahead and do the trim first. But when someone triggers a stretch, go ahead and extend it back before the stretch. Then trim it back again after stretched. That might also work. So I do appreciate the input, I hadn't really thought of that. Perhaps I was being stubborn.

 

For 15 years I tried to get kids to not hover their hands over the escape button. They just roll their eyes and call me a dinosaur. My hand hovers over the space bar. That's what I was taught.

 

Thanks for your feedback.

ronjonp Grand Master

ronjonp

Posted
Posted

Do you trim these circles purely for aesthetics? If so, consider using wipeouts or hatched 255,255,255 color blocks maybe?

Quest for Peace Contributor

Quest for Peace

Posted
  • Author
Posted

Solved. Not the way I was expecting, but effective. Still didn't learn to call a command from within an error trap. But learned about vl-catch-all-apply. Which is another topic I've wanted to learn.

 

Here's a link to what led me to a solution:

https://hyperpics.blogs.com/beyond_the_ui/2012/04/getting-user-input-with-autolisp-and-handling-esc.html

Did I do that right? Am I allowed to post a link like that?

 

Thanks for your help, those that read it, and those that replied. You all are so helpful. If you know the original solution, that would be cool too. But this definitely worked.

ronjonp Grand Master

ronjonp

Posted
Posted (edited)
26 minutes ago, Quest for Peace said:

Solved. Not the way I was expecting, but effective. Still didn't learn to call a command from within an error trap. But learned about vl-catch-all-apply. Which is another topic I've wanted to learn.

 

Here's a link to what led me to a solution:

https://hyperpics.blogs.com/beyond_the_ui/2012/04/getting-user-input-with-autolisp-and-handling-esc.html

Did I do that right? Am I allowed to post a link like that?

 

Thanks for your help, those that read it, and those that replied. You all are so helpful. If you know the original solution, that would be cool too. But this definitely worked.

@Quest for Peace Here's a quick example using lines that does not rely on using osnaps .. maybe food for thought :) 

(defun c:foo (/ _srt p1 p2 s)
  (defun _srt (p l) (car (vl-sort l '(lambda (r j) (< (distance p r) (distance p j))))))
  (if (and (setq s (ssget "_A" '((0 . "circle"))))
	   (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) (mapcar 'cadr (ssnamex s))))
      )
    (while (and	(or p1 (setq p1 (getpoint "\nSpecify start point: ")))
		(setq p2 (getpoint p1 "\nSpecify next point: "))
	   )
      (entmakex	(list '(0 . "line") (cons 10 (setq p1 (_srt p1 s))) (cons 11 (setq p2 (_srt p2 s))))
      )
      (setq p1 p2)
    )
  )
  (princ)
)

 

2020-08-11_13-02-12.gif

Edited by ronjonp
  • Like 1

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