Jump to content

Stretch Coordinate Filter by Crossing Polygon


barristann
 Share

Recommended Posts

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

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

 

 

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

  • Like 1
Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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

 

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

×
×
  • Create New...