Stretch command with preview of pt2

[3dwannab]

The below test code doesn't show the new location of pt2 where the cursor is.

 

Anyone know how to get it to work. DRAGMODE varaible is set to ON.

 

(defun c:test (/ rec1 rec2)

 (setq rec1 (getpoint "select first "))
 (setq rec2 (getcorner rec1 "select second"))

 (setq pt1 (getpoint "\nSelect Base Point : "))
 (setq pt2 (getpoint pt1 "\nSelect Second Point : "))


 (command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pt2)

 )

[OMEGA-ThundeR]

Why would it show anything? You're just setting some coordinates and then the command runs 'instantly'. So the 'preview' part you would normaly see when performing the STRETCH command is not shown.

 

I wonder what the purpose of this lisp is, it does nothing extra that the STRETCH command itself doesn't do allready.

 

The way i use the stretch command is enter 'S' for stretch. Then i select what i want to stretch and click a start and end point. No need for the R(ectangle) action.

[3dwannab]

It's a stripped down version of the code I'm having trouble with. I'm not trying to reinvent the stretch command, all I need to know is. Is it possible to modify that code to show where pt2 is.

[OMEGA-ThundeR]

(command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pause)

?

 

And remove the SETQ part for PT2

 

E: Tested and seem to work . 'pause' in a lisp code means manual input, in case you need to know what it does.

[3dwannab]

(command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pause)

?

 

And remove the SETQ part for PT2

 

E: Tested and seem to work . 'pause' in a lisp code means manual input, in case you need to know what it does.

 

Unfortunately, I cannot use the pause here. it needs to retain the pt2 and setvar pt2.

 

See full code here:

(defun c:BS ( /
*error*
ans
doc
grid
joint
pt1
pt2
ss
vars
)
(defun *error* (msg)
(if vars (SetVars vars))
(vla-endundomark doc)
(if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
	(princ (strcat "\n<< Error : " msg " >>"))
	)
(princ)
)
(setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
(vla-endundomark doc)
(vla-startundomark doc)
(if
(and
	(setq ss (ssget))
	(progn
		(SF:redraw_sset ss :vlax-true)
		(initget "Minus Stand Plus Custom None")
		(setq ans (getkword "\nCO Size ? (Stand Brick=112.5mm / Joint=10mm)[Minus ( co - )/Stand ( co )/Plus ( co + )/Custom interval/None] <Stand>: "))
		(cond
			((or (not ans) (= "Stand" ans))
				(setq grid 112.5)
				(setq joint 0.0)
				)
			((= "Minus" ans)
				(setq grid 112.5)
				(setq joint -10.0)
				)
			((= "Plus" ans)
				(setq grid 112.5)
				(setq joint 10.0)
				)
			((= "Custom" ans)
				(setq grid (getreal "\nCustom interval size : "))
				(setq joint 0.0)
				)
			)
		T
		)
	(setq pt1 (getpoint "\nSelect Base Point : "))
	(setq vars
		(SetVars
			(if (= "None" ans)
				'((cmdecho 0))
				(list
					'(cmdecho 0)
					(list 'snapbase (list (car pt1) (cadr pt1)))
					'(griddisplay 0)
					'(gridmode 1)
					'(snapmode 1)
					'(dragmode 2)
					'(osmode 0)
					'(orthomode 1)
					(list 'gridunit (list grid grid))
					(list 'snapunit (list grid grid))
					)
				)
			)
		)
	(setq pt2 (getpoint pt1 "\nSelect Second Point : "))
	)
(progn
	(if grid
		(setq pt2 (ModularizePoint pt2 pt1 grid joint))
		)
 		; (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt2)))
 		(command "stretch" ss "" "_non" pt1 "_non" pt2)
 		(SF:redraw_sset ss :vlax-false)
 		(princ
 			(strcat
 				"\nModular dimension : " (if grid "ON " "OFF ")
 				"\nStretched : " (rtos (distance pt1 pt2)) " "
 				)
 			)
 		)
)
(if vars (SetVars vars))
(vla-endundomark doc)
(princ)
)
;; by 3dwannab
;; Usage:
;; (SF:redraw_sset ss :vlax-true)
;; (SF:redraw_sset ss :vlax-false)
(defun SF:redraw_sset (ent boolean / ent)
(repeat (setq in (sslength ent))
	(vla-highlight (vlax-ename->vla-object (ssname ent (setq in (1- in)))) boolean)
	)
)
;; Round half towards pos. or neg. infinity.
(defun Round (num)
(fix ((if (minusp num) - +) num 0.5))
)
;; Recalculate pt so that the X, Y and Z distance to base are n times module plus joint.
;; Written by Roy_043 - http://www.cadtutor.net/forum/showthread.php?99652-Stretch-in-X-axis-with-choosen-value-in-those-increments&p=678315&viewfull=1#post678315
(defun ModularizePoint (pt base module joint)
(mapcar
	'(lambda (coordPt coordBase / delta)
		(setq delta (* module (Round (/ (- coordPt coordBase) (float module)))))
		(cond
			((zerop delta)  coordBase)
			((minusp delta) (+ coordBase delta (- joint)))
			(T              (+ coordBase delta joint))
			)
		)
	pt
	base
	)
)
;; setvars
(defun SetVars (lst)
(mapcar
	'(lambda (sub / old)
		(setq old (getvar (car sub)))
		(if (cadr sub) (setvar (car sub) (cadr sub)))
		(list (car sub) old)
		)
	lst
	)
)
(vl-load-com)
(princ)