See the top rated post in this thread. Click here

Results 1 to 4 of 4

Thread: SpeedStretch.lsp not behaving

  1. #1
    AUGI Addict madcadder's Avatar
    Join Date
    2000-11
    Location
    Too far from the beach
    Posts
    1,054
    Login to Give a bone
    0

    Default SpeedStretch.lsp not behaving

    I've had this for years and I don't remember it acting like this until the last few versions and never had time to fix it. (currently on A2k19)
    Still don't...
    Can someone take a look at it for me, fix it, and possibly improve if there's a better madness to the method?

    SS - sets the stretch distance
    SA, SW, SX, and SD stretches that direction the set distance.

    It appears there is an error in the error handling.
    When I ESC it doesn't set back the snaps. (probably the other variables too)

    Right now, the OSMODE is rem'd out

    Code:
    ;;; SpeedStretch.lsp version 1.0
    ;;; Copyright 01/29/01 by Tod Winn
    ;;; Fixed bug when no distance originally set. - 08/01/01
    
    (defun |speedstretcherror| (|msg|)
      (if (or (= |msg| "Function cancelled")
    	  (= |msg| "quit / exit abort")
          )
        (princ (strcat "\nError: " |msg|))
      )
      (setvar "cmdecho" |cmdecho|)
    ;;;  (setvar "osmode" |osmode|)
      (setvar "polarmode" |polarmode|)
      (setq *error* |olderror|)
      (princ)
    )
    
    (defun c:ss (/ |cmdecho| |currentdist|)
      (setq |cmdecho| (getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (if (= |stretchdist| nil)
        (setq |currentdist| 0.0)
        (setq |currentdist| |stretchdist|)
      )
      (setq	|stretchdist|
    	 (getreal (strcat "\nSet Distance to Stretch: <"
    			  (rtos |currentdist| 2 8)
    			  ">: "
    		  )
    	 )
      )
      (if (= |stretchdist| nil)
        (setq |stretchdist| |currentdist|)
      )
      (if (= |stretchdist| 0.0)
        (progn
          (alert
    	(strcat
    	  "\nStretch Distance currently set to 0.0\nPlease set a valid distance"
    	)
          )
          (setq |stretchdist|
    	     (getreal (strcat "\nSet Distance to Stretch: <"
    			      (rtos |currentdist| 2 8)
    			      ">: "
    		      )
    	     )
          )
        )
      )
      (princ)
    )
    
    (defun c:sa (/		  |ang|	       |currentdist|
    	     |cmdecho|	  |olderror|   |osmode|	    |ent|
    	     |pt1|	  |pt2|	       |polarmode|
    	    )
      (setq |olderror| *error*)
      (setq *error* |speedstretcherror|)
      (setq |cmdecho| (getvar "cmdecho"))
      (setq |osmode| (getvar "osmode"))
      (setq |polarmode| (getvar "polarmode"))
      (setvar "cmdecho" 0)
    ;;;  (setvar "osmode" 0)
      (setvar "polarmode" 0)
      (princ "\nSelect objects to stretch: ")
      (setq |pt1| (getpoint "\nSpecify first corner: "))
      (initget 33)
      (setq |pt2| (getcorner |pt1| "\nSpecify opposite corner: "))
      (setq |ang| 180.0)
      (if (= |stretchdist| nil)
        (progn
          (setq |currentdist| 0.0)
          (setq |stretchdist|
    	     (getreal (strcat "\nSet Distance to Stretch: <"
    			      (rtos |currentdist| 2 8)
    			      ">: "
    		      )
    	     )
          )
          (if (= |stretchdist| nil)
    	(setq |stretchdist| |currentdist|)
          )
        )
      )
      (if (= |stretchdist| 0.0)
        (alert
          (strcat
    	"\nStretch Distance currently set to 0.0\nPlease use 'SS' to set a distance"
          )
        )
        (command ".stretch"
    	     "c"
    	     |pt1|
    	     |pt2|
    	     ""
    	     "0,0"
    	     (strcat "@"
    		     (rtos |stretchdist| 2 8)
    		     "<"
    		     (rtos |ang| 2 8)
    	     )
        )
      )
      (setvar "cmdecho" |cmdecho|)
    ;;;  (setvar "osmode" |osmode|)
      (setvar "polarmode" |polarmode|)
      (setq *error* |olderror|)
      (princ)
    )
    
    (defun c:sd (/		  |ang|	       |currentdist|
    	     |cmdecho|	  |olderror|   |osmode|	    |ent|
    	     |pt1|	  |pt2|	       |polarmode|
    	    )
      (setq |olderror| *error*)
      (setq *error* |speedstretcherror|)
      (setq |cmdecho| (getvar "cmdecho"))
      (setq |osmode| (getvar "osmode"))
      (setq |polarmode| (getvar "polarmode"))
      (setvar "cmdecho" 0)
    ;;;  (setvar "osmode" 0)
      (setvar "polarmode" 0)
      (princ "\nSelect objects to stretch: ")
      (setq |pt1| (getpoint "\nSpecify first corner: "))
      (initget 33)
      (setq |pt2| (getcorner |pt1| "\nSpecify opposite corner: "))
      (setq |ang| 0.0)
      (if (= |stretchdist| nil)
        (progn
          (setq |currentdist| 0.0)
          (setq |stretchdist|
    	     (getreal (strcat "\nSet Distance to Stretch: <"
    			      (rtos |currentdist| 2 8)
    			      ">: "
    		      )
    	     )
          )
          (if (= |stretchdist| nil)
    	(setq |stretchdist| |currentdist|)
          )
        )
      )
      (if (= |stretchdist| 0.0)
        (alert
          (strcat
    	"\nStretch Distance currently set to 0.0\nPlease use 'SS' to set a distance"
          )
        )
        (command ".stretch"
    	     "c"
    	     |pt1|
    	     |pt2|
    	     ""
    	     "0,0"
    	     (strcat "@"
    		     (rtos |stretchdist| 2 8)
    		     "<"
    		     (rtos |ang| 2 8)
    	     )
        )
      )
      (setvar "cmdecho" |cmdecho|)
    ;;;  (setvar "osmode" |osmode|)
      (setvar "polarmode" |polarmode|)
      (setq *error* |olderror|)
      (princ)
    )
    
    (defun c:sw (/		  |ang|	       |currentdist|
    	     |cmdecho|	  |olderror|   |osmode|	    |ent|
    	     |pt1|	  |pt2|	       |polarmode|
    	    )
      (setq |olderror| *error*)
      (setq *error* |speedstretcherror|)
      (setq |cmdecho| (getvar "cmdecho"))
      (setq |osmode| (getvar "osmode"))
      (setq |polarmode| (getvar "polarmode"))
      (setvar "cmdecho" 0)
    ;;;  (setvar "osmode" 0)
      (setvar "polarmode" 0)
      (princ "\nSelect objects to stretch: ")
      (setq |pt1| (getpoint "\nSpecify first corner: "))
      (initget 33)
      (setq |pt2| (getcorner |pt1| "\nSpecify opposite corner: "))
      (setq |ang| 90.0)
      (if (= |stretchdist| nil)
        (progn
          (setq |currentdist| 0.0)
          (setq |stretchdist|
    	     (getreal (strcat "\nSet Distance to Stretch: <"
    			      (rtos |currentdist| 2 8)
    			      ">: "
    		      )
    	     )
          )
          (if (= |stretchdist| nil)
    	(setq |stretchdist| |currentdist|)
          )
        )
      )
      (if (= |stretchdist| 0.0)
        (alert
          (strcat
    	"\nStretch Distance currently set to 0.0\nPlease use 'SS' to set a distance"
          )
        )
        (command ".stretch"
    	     "c"
    	     |pt1|
    	     |pt2|
    	     ""
    	     "0,0"
    	     (strcat "@"
    		     (rtos |stretchdist| 2 8)
    		     "<"
    		     (rtos |ang| 2 8)
    	     )
        )
      )
      (setvar "cmdecho" |cmdecho|)
    ;;;  (setvar "osmode" |osmode|)
      (setvar "polarmode" |polarmode|)
      (setq *error* |olderror|)
      (princ)
    )
    
    (defun c:sx (/		  |ang|	       |currentdist|
    	     |cmdecho|	  |olderror|   |osmode|	    |ent|
    	     |pt1|	  |pt2|	       |polarmode|
    	    )
      (setq |olderror| *error*)
      (setq *error* |speedstretcherror|)
      (setq |cmdecho| (getvar "cmdecho"))
      (setq |osmode| (getvar "osmode"))
      (setq |polarmode| (getvar "polarmode"))
      (setvar "cmdecho" 0)
    ;;;  (setvar "osmode" 0)
      (setvar "polarmode" 0)
      (princ "\nSelect objects to stretch: ")
      (setq |pt1| (getpoint "\nSpecify first corner: "))
      (initget 33)
      (setq |pt2| (getcorner |pt1| "\nSpecify opposite corner: "))
      (setq |ang| 270.0)
      (if (= |stretchdist| nil)
        (progn
          (setq |currentdist| 0.0)
          (setq |stretchdist|
    	     (getreal (strcat "\nSet Distance to Stretch: <"
    			      (rtos |currentdist| 2 8)
    			      ">: "
    		      )
    	     )
          )
          (if (= |stretchdist| nil)
    	(setq |stretchdist| |currentdist|)
          )
        )
      )
      (if (= |stretchdist| 0.0)
        (alert
          (strcat
    	"\nStretch Distance currently set to 0.0\nPlease use 'SS' to set a distance"
          )
        )
        (command ".stretch"
    	     "c"
    	     |pt1|
    	     |pt2|
    	     ""
    	     "0,0"
    	     (strcat "@"
    		     (rtos |stretchdist| 2 8)
    		     "<"
    		     (rtos |ang| 2 8)
    	     )
        )
      )
      (setvar "cmdecho" |cmdecho|)
    ;;;  (setvar "osmode" |osmode|)
      (setvar "polarmode" |polarmode|)
      (setq *error* |olderror|)
      (princ)
    )
    
    (prompt
      "\nSpeedStretch.lsp loaded... \nSD=0, SW=90, SA=180, SX=270 degrees \nSS to set distance"
    )

  2. #2
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,713
    Login to Give a bone
    1

    Default Re: SpeedStretch.lsp not behaving

    Code:
    (defun c:SD () (QuickStretch 0.0))
    (defun c:SW () (QuickStretch 90.0))
    (defun c:SA () (QuickStretch 180.0))
    (defun c:SX () (QuickStretch 270.0))
    
    (defun QuickStretch (ang / *error* stretch cmdecho)
      (princ
        (strcat
          "\rQuickStretch Angle="
          (rtos ang 2 2)
          " degrees "
        )
      )
    
      (defun *error* (msg)
        (if cmdecho
          (setvar 'cmdecho cmdecho)
        )
        (cond ((not msg))                                                   ; Normal exit
              ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
              ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
        )
        (princ)
      )
    
      (if
        (and
          (or *stretch* (setq *stretch* 10.0))                              ;<-- default stretch increment
          (or
            (setq stretch
                   (getreal
                     (strcat "\nEnter Stretch distance <"
                             (rtos *stretch* 2 2)
                             ">: "
                     )
                   )
            )
            (setq stretch *stretch*)
          )
          (setq *stretch* stretch)
          (setq cmdecho (getvar 'cmdecho))
          (setvar 'cmdecho 0)
        )
         (progn
           (command "._stretch"
                    "_c"
                    "_non"                                                  ;<-- comment out to use osnaps
                    pause
                    "_non"                                                  ;<-- comment out to use osnaps
                    pause
                    ""
                    "0,0"
                    (strcat "@"
                            (rtos stretch 2 8)
                            "<"
                            (rtos ang 2 8)
                    )
           )
         )
      )
    
      (*error* nil)
    )
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  3. #3
    AUGI Addict madcadder's Avatar
    Join Date
    2000-11
    Location
    Too far from the beach
    Posts
    1,054
    Login to Give a bone
    0

    Default Re: SpeedStretch.lsp not behaving

    I looked at that and just shook my head, "freakin _non. What in the world was I NOT thinking."
    But the code is also much cleaner too. That's great.
    I wrote that when I had, maybe, a year's worth of programming experience and haven't had time to think LISP in the last 3 years.
    Thank you very much...

  4. #4
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,713
    Login to Give a bone
    0

    Default Re: SpeedStretch.lsp not behaving

    Quote Originally Posted by madcadder View Post
    Thank you very much...
    You're welcome.
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

Similar Threads

  1. Microstation export isn't behaving
    By dwescott in forum AutoCAD General
    Replies: 4
    Last Post: 2010-08-31, 06:39 PM
  2. References not behaving
    By barrie.sharp in forum Revit Architecture - Families
    Replies: 2
    Last Post: 2010-06-18, 08:39 AM
  3. Arcs Behaving Badly
    By fgiorlando in forum ACA General
    Replies: 2
    Last Post: 2007-08-27, 08:04 PM
  4. Walls Behaving Badly
    By rcroke in forum ACA General
    Replies: 10
    Last Post: 2007-03-30, 02:28 PM
  5. Linetypes between DWG's not behaving themselves
    By r_soula in forum AutoCAD General
    Replies: 2
    Last Post: 2007-03-22, 07:38 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •