Stretch Coordinate Filter by Crossing Polygon

[barristann]

Hi all. This Lee Mac's code to Stretch with .y coordinate filter. Please help me modify this to select by Crossing Polygon by default (instead of having to press cp). Thank you in advance.

 

 

(defun c:yst (/ *error* vl ov ss pt1 pt2)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 (if (setq ss (ssget))
   (if (and (setq pt1 (getpoint "\nSelect Base Point: "))
            (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
       (command "_.stretch" ss "" pt1 ".y" pt2 0)))
   (princ "\n<< Nothing Selected >>"))
 (mapcar 'setvar vl ov)
 (princ))

 

https://www.cadtutor.net/forum/topic/11885-help-with-stretch-lisp/

 

Edited November 26, 2022 by barristann

[Steven P]

Would this link help?

 

http://www.lee-mac.com/ssget.html might be something in there?

[barristann]

I've tried ssget "_CP"  but it's not working

 

 

(defun c:yst (/ *error* vl ov ss pt1 pt2)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 (if (setq ss (ssget "_CP" ))
   (if (and (setq pt1 (getpoint "\nSelect Base Point: "))
            (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
       (command "_.stretch" ss "" pt1 ".y" pt2 0)))
   (princ "\n<< Nothing Selected >>"))
 (mapcar 'setvar vl ov)
 (princ))

 

 

 

[Steven P]

Would you need to define the points in the ssget, like the example? You might need to add a step in to the LISP using 'getpoint' to create this list of points

[barristann]

Thank you for your suggestion Steven, but I'm new to Lisp so I have no clue how to do this. I've spend 2 days guessing and searching other posts but I'm still failing...

[Steven P]

I'll have a look at this later - should be an easy thing to add in.

 

For now though, try putting a few coordinates into the ssget "_cp" and see how that works, use the example from Lee Mac for the formatting - once you understand that it should follow how to add your own points in there

[barristann]

I'll follow your suggestion, Steven. This will increase my work productivity significantly if successful.

[Tsuky]

Not use "CP" but simply "C" with 2 points

(defun c:yst (/ *error* vl ov ss pt1 pt2)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 (initget 1)
 (setq pt1 (getpoint "\nSelect Base Point: "))
 (initget 33)
 (setq pt2 (getcorner pt1 "\nSelect Second Point: "))
 (if (setq ss (ssget "_C" pt1 pt2))
     (progn
       (setvar "OSMODE" 0)
       (command "_.stretch" ss "" pt1 "_y" pt2 0))
   (princ "\n<< Nothing Selected >>")
 )
 (mapcar 'setvar vl ov)
 (princ))

 

[barristann]

Hi Tusky,

Thank you for your help.

 

Now, in Lee Mac's original code, when prompted to "Select objects", is there a way to automatically type "cp"?

(I just want to automatically enter Crossing Polygon selection mode, instead of having to type cp all the time).

[barristann]

Sorry I misspelled your name Tsuky

[Tsuky]

If I understood your request correctly, maybe this!

(defun c:yst (/ *error* vl ov p l_p ss pt1 pt2)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 (initget 1)
 (setq l_p (list (setq p (getpoint "\nGive first point of crossing: "))))
 (while (setq p (getpoint p "\nNext point: ")) (setq l_p (cons p l_p))
  (grdraw (cadr l_p) (car l_p) -1 1)
 )
 (if (setq ss (ssget "_CP" l_p))
   (if (and (setq pt1 (getpoint "\nSelect Base Point: "))
            (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
       (command "_.stretch" ss "" pt1 ".y" pt2 0)))
   (princ "\n<< Nothing Selected >>"))
 (mapcar 'setvar vl ov)
 (princ))

 

[barristann]

This is what I need!

 

But, I'm not sure why the selection area is not highlighted in green. Also, the selected items are not highlighted to indicate that they will be stretched.

 

Other than that, this is exactly what I need. Thank you for your help Tsuky!

[Tsuky]

Quote

But, I'm not sure why the selection area is not highlighted in green. Also, the selected items are not highlighted to indicate that they will be stretched.

For this use command "select"

Exemple:

(defun c:yst (/ *error* vl ov p l_p ss pt1 pt2)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 (command "_.select" "_cp")
 (while (not (zerop (getvar "CMDACTIVE")))
   (command pause)
 )
 (if (setq ss (ssget "_P" ))
   (if (and (setq pt1 (getpoint "\nSelect Base Point: "))
            (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
       (command "_.stretch" ss "" pt1 ".y" pt2 0)))
   (princ "\n<< Nothing Selected >>"))
 (mapcar 'setvar vl ov)
 (princ))

 

[barristann]

You're amazing! It's perfect! Thank you so much Tsuky!

[Steven P]

grdraw - was trying to remember that one last night!